TABLE OF CONTENTS


ABINIT/m_yaml [ Modules ]

[ Top ] [ Modules ]

NAME

  m_yaml

FUNCTION

  This module defines low-level routines to format data into YAML documents.
  Supported data include numeric arrays of one and two dimensions,
  strings, numbers, dictionaries from m_pair_list and 1D arrays of dictionaries.

COPYRIGHT

 Copyright (C) 2009-2022 ABINIT group (TC, MG)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

18 #if defined HAVE_CONFIG_H
19 #include "config.h"
20 #endif
21 
22 #include "abi_common.h"
23 
24 module m_yaml
25 
26  use defs_basis
27 #ifdef HAVE_FC_IEEE_ARITHMETIC
28  use ieee_arithmetic
29 #endif
30  use m_errors
31  use m_pair_list
32  use m_stream_string
33 
34  use m_fstrings, only : sjoin, char_count, itoa, sjoin
35  use m_io_tools, only : is_open
36 
37  implicit none
38 
39  private

m_yaml/yaml_iterstart [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yaml_iterstart

FUNCTION

  Mark the start of an iteration named by label and numbered by file

INPUTS

  label=key name
  val=value
  [newline] = set to false to prevent adding newlines after fields

SOURCE

187 subroutine yaml_iterstart(label, val, unit, use_yaml, newline)
188 
189 !Arguments ------------------------------------
190  integer,intent(in) :: val, unit, use_yaml
191  character(len=*),intent(in) :: label
192  logical,intent(in),optional :: newline
193 
194 !Local variables-------------------------------
195  character(len=6) :: tmp_i
196  logical :: nl
197  type(stream_string) :: stream
198 ! *************************************************************************
199 
200  select case (label)
201  case ("dtset")
202    DTSET_IDX = val
203    TIMIMAGE_IDX = -1
204    IMAGE_IDX = -1
205    ITIME_IDX = -1
206    ICYCLE_IDX = -1
207  case ("timimage")
208    TIMIMAGE_IDX = val
209  case ("image")
210    IMAGE_IDX = val
211  case ("itime")
212    ITIME_IDX = val
213  case ("icycle")
214    ICYCLE_IDX = val
215  case default
216    ABI_ERROR(sjoin("Invalid value for label:", label))
217  end select
218 
219  if (use_yaml == 1) then
220    if (unit == dev_null .or. .not. is_open(unit)) return
221    ABI_DEFAULT(nl, newline, .true.)
222    write(tmp_i, '(I6)') val
223    call stream%push('--- !IterStart'//eol//label//':'//tmp_i//eol//'...')
224    if (nl) call stream%push(eol)
225    call stream%flush(unit)
226  end if
227 
228 end subroutine yaml_iterstart

m_yaml/yaml_single_dict [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yaml_single_dict

FUNCTION

  Create a full document from a single dictionary

INPUTS

  unit
  tag <character(len=*)>=
  comment <character(len=*)>=
  pl <type(pair_list)>=
  key_size <integer>=maximum storage size for the keys of pl
  string_size <integer>=maximum storage size for the strings found in pl
  tag <character(len=*)>=optional  add a tag to the field
  int_fmt <character(len=*)>=optional  override the default formatting
  real_fmt <character(len=*)>=optional  override the default formatting
  string_fmt <character(len=*)>=optional  override the default formatting
  width <integer>=optional impose a minimum width of the field name side of the column (padding with spaces)
  newline <logical>=optional  set to false to prevent adding newlines after fields

OUTPUT

  pl <type(pair_list)>=

SOURCE

1316 subroutine yaml_single_dict(unit, tag, comment, pl, key_size, string_size, &
1317                             int_fmt, real_fmt, string_fmt, newline, width)
1318 
1319 !Arguments ------------------------------------
1320  integer,intent(in) :: unit
1321  type(pair_list),intent(inout) :: pl
1322  character(len=*),intent(in) :: tag
1323  character(len=*),intent(in) :: comment
1324  integer,intent(in) :: key_size, string_size
1325  character(len=*),intent(in),optional :: int_fmt, real_fmt, string_fmt
1326  integer,intent(in), optional :: width
1327  logical,intent(in),optional :: newline
1328 
1329 !Local variables-------------------------------
1330  type(yamldoc_t) :: doc
1331  character(len=30) :: ifmt, rfmt, sfmt
1332  character(len=string_size) :: vs, tmp_s
1333  character(len=key_size) :: key
1334  integer :: vi, k, type_code, w
1335  character(len=50) :: tmp_i, tmp_r
1336  real(dp) :: vr
1337  logical :: nl
1338 ! *************************************************************************
1339 
1340  ABI_DEFAULT(nl, newline, .true.)
1341  ABI_DEFAULT(rfmt, real_fmt, doc%default_rfmt)
1342  ABI_DEFAULT(ifmt, int_fmt, doc%default_ifmt)
1343  ABI_DEFAULT(sfmt, string_fmt, doc%default_sfmt)
1344  ABI_DEFAULT(w, width, doc%default_width)
1345 
1346  call doc%stream%push('--- !'//tag)
1347 
1348  if (comment /= '') then
1349    call doc%stream%push(eol)
1350    call yaml_start_field(doc%stream, 'comment', width=w)
1351    call yaml_print_string(doc%stream, comment)
1352  end if
1353  call doc%stream%push(eol)
1354 
1355  call pl%restart()
1356  do k=1,pl%length()
1357    call string_clear(key)
1358    call string_clear(vs)
1359    call pl%iter(key, type_code, vi, vr, vs)
1360 
1361    call yaml_start_field(doc%stream, trim(key), width=w)
1362    call doc%stream%push(' ')
1363    if (type_code == TC_INT) then
1364      call string_clear(tmp_i)
1365      write(tmp_i, ifmt) vi
1366      call doc%stream%push(trim(tmp_i))
1367    else if (type_code == TC_REAL) then
1368      call string_clear(tmp_r)
1369      call format_real(vr, tmp_r, rfmt)
1370      call doc%stream%push(trim(tmp_r))
1371    else if (type_code == TC_STRING) then
1372      call string_clear(tmp_s)
1373      write(tmp_s, sfmt) vs
1374      call yaml_print_string(doc%stream, trim(tmp_s))
1375    end if
1376    call doc%stream%push(eol)
1377  end do
1378 
1379  call doc%write_and_free(unit, newline=nl)
1380 
1381 end subroutine yaml_single_dict

m_yaml/yaml_write_dict [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yaml_write_dict

FUNCTION

  Write a dictionary in a Yaml document.

INPUTS

  tag: Yaml tag
  dict_name: Dictionary name
  dict: Dictionary
  unit: Unit numver
  [with_iter_state]: True if dict with iteration state should be added. Default: False

SOURCE

1400 subroutine yaml_write_dict(tag, dict_name, dict, unit, with_iter_state)
1401 
1402 !Arguments ------------------------------------
1403  character(len=*),intent(in) :: tag, dict_name
1404  type(pair_list),intent(inout) :: dict
1405  integer,intent(in) :: unit
1406  logical,optional,intent(in) :: with_iter_state
1407 
1408 !Local variables-------------------------------
1409  type(yamldoc_t) :: ydoc
1410  logical :: with_iter_state_
1411 ! *************************************************************************
1412 
1413  with_iter_state_ = .False.; if (present(with_iter_state)) with_iter_state_ = with_iter_state
1414 
1415  ydoc = yamldoc_open(tag, with_iter_state=with_iter_state_)
1416  call ydoc%add_dict(dict_name, dict)
1417  call ydoc%write_and_free(unit)
1418 
1419 end subroutine yaml_write_dict

m_yaml/yamldoc_add_dict [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_dict

FUNCTION

  Add a field containing a dictionary/pair_list

INPUTS

  label <character(len=*)>=
  pl <type(pair_list)>=
  string_size <integer>=optional maximum storage size for strings found in a pair_list
  key_size <integer>=optional maximum storage size for keys of a pair_list
  multiline_trig <integer>=optional minimum number of elements before switching to multiline representation
  tag <character(len=*)>=optional  add a tag to the field
  key_fmt <character(len=*)>=optional  override the default formatting
  int_fmt <character(len=*)>=optional  override the default formatting
  real_fmt <character(len=*)>=optional  override the default formatting
  string_fmt <character(len=*)>=optional  override the default formatting
  newline <logical>=optional  set to false to prevent adding newlines after fields
  width <integer>=optional impose a minimum width of the field name side of the column (padding with spaces)
  [comment]: optional Yaml comment added after the value

OUTPUT

  pl <type(pair_list)>=

SOURCE

765 subroutine yamldoc_add_dict(self, label, pl, tag, key_size, string_size, key_fmt, &
766                             int_fmt, real_fmt, string_fmt, multiline_trig, newline, width, comment)
767 
768 !Arguments ------------------------------------
769  class(yamldoc_t),intent(inout) :: self
770  type(pair_list),intent(inout) :: pl
771  character(len=*),intent(in) :: label
772  integer,intent(in),optional :: string_size, key_size, multiline_trig
773  character(len=*),intent(in),optional :: tag, key_fmt, int_fmt, real_fmt, string_fmt
774  logical,intent(in),optional :: newline
775  integer,intent(in),optional :: width
776  character(len=*),intent(in),optional :: comment
777 
778 !Local variables-------------------------------
779  integer :: w, vmax, ks, ss
780  character(len=30) :: kfmt, ifmt, rfmt, sfmt
781  logical :: nl
782 ! *************************************************************************
783 
784  ABI_DEFAULT(nl, newline, .true.)
785  ABI_DEFAULT(w, width, self%default_width)
786  ABI_DEFAULT(ks, key_size, self%default_keysize)
787  ABI_DEFAULT(ss, string_size, self%default_stringsize)
788  ABI_DEFAULT(kfmt, key_fmt, self%default_kfmt)
789  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
790  ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
791  ABI_DEFAULT(sfmt, string_fmt, self%default_sfmt)
792  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
793 
794  if (present(tag)) then
795    call yaml_start_field(self%stream, label, width=w, tag=tag)
796  else
797    call yaml_start_field(self%stream, label, width=w)
798  end if
799 
800  call yaml_print_dict(self%stream, pl, ks, ss, trim(kfmt), trim(ifmt), trim(rfmt), trim(sfmt), vmax)
801  if (present(comment)) call self%stream%push(' # '//trim(comment))
802  if (nl) call self%stream%push(eol)
803 
804 end subroutine yamldoc_add_dict

m_yaml/yamldoc_add_dictlist [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_dictlist

FUNCTION

  Add a field containing a list of dictionaries/array of pair_list

INPUTS

  label = key name
  n <integer>=
  plarr(n) <type(pair_list)>=
  key_size <integer>=optional maximum storage size for keys of a pair_list
  string_size <integer>=optional maximum storage size for strings of a pair_list
  multiline_trig <integer>=optional minimum number of elements before switching to multiline representation
  [tag]= add a tag to the field
  key_fmt <character(len=*)>=optional  override the default formatting
  int_fmt <character(len=*)>=optional  override the default formatting
  real_fmt <character(len=*)>=optional  override the default formatting
  string_fmt <character(len=*)>=optional  override the default formatting
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)

SOURCE

1108 subroutine yamldoc_add_dictlist(self, label, n, plarr, tag, key_size, string_size, key_fmt, int_fmt, &
1109                                 real_fmt, string_fmt, multiline_trig, newline, width)
1110 
1111 !Arguments ------------------------------------
1112  class(yamldoc_t),intent(inout) :: self
1113  integer,intent(in) :: n
1114  type(pair_list),intent(inout) :: plarr(n)
1115  character(len=*),intent(in) :: label
1116  integer,intent(in),optional :: key_size, string_size
1117  integer,intent(in),optional :: multiline_trig
1118  character(len=*),intent(in),optional :: tag, key_fmt, int_fmt, real_fmt, string_fmt
1119  logical,intent(in),optional :: newline
1120  integer,intent(in),optional :: width
1121 
1122 !Local variables-------------------------------
1123  integer :: w
1124  character(len=30) :: kfmt, ifmt, rfmt, sfmt
1125  integer :: vmax, ks, i, ss
1126  logical :: nl
1127 ! *************************************************************************
1128 
1129  ABI_DEFAULT(nl, newline, .true.)
1130  ABI_DEFAULT(w, width, self%default_width)
1131  ABI_DEFAULT(kfmt, key_fmt, self%default_kfmt)
1132  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
1133  ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
1134  ABI_DEFAULT(sfmt, string_fmt, self%default_sfmt)
1135  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1136  ABI_DEFAULT(ks, key_size, self%default_keysize)
1137  ABI_DEFAULT(ss, string_size, self%default_keysize)
1138 
1139  if (present(tag)) then
1140    call yaml_start_field(self%stream, label, width=w, tag=tag)
1141  else
1142    call yaml_start_field(self%stream, label, width=w)
1143  end if
1144  call self%stream%push(eol)
1145 
1146  do i=1,n
1147    call self%stream%push('- ')
1148    call yaml_print_dict(self%stream, plarr(i), ks, ss, trim(kfmt), trim(ifmt), trim(rfmt), trim(sfmt), vmax)
1149    if (nl .or. i /= n) call self%stream%push(eol)
1150  end do
1151 
1152 end subroutine yamldoc_add_dictlist

m_yaml/yamldoc_add_int [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_int

FUNCTION

  Add an integer field to a document

INPUTS

  label = key name
  val = value
  [tag] = optional, add a tag to the field
  [int_fmt] = optional  override the default formatting
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [comment]: optional Yaml comment added after the value
  [ignore]= If present, ignore entrie if values is equal to ignore.

SOURCE

458 subroutine yamldoc_add_int(self, label, val, tag, int_fmt, newline, width, comment, ignore)
459 
460 !Arguments ------------------------------------
461  class(yamldoc_t),intent(inout) :: self
462  integer,intent(in) :: val
463  character(len=*),intent(in) :: label
464  character(len=*),intent(in),optional :: tag, int_fmt
465  logical,intent(in),optional :: newline
466  integer,intent(in),optional :: width
467  character(len=*),intent(in),optional :: comment
468  integer,intent(in),optional :: ignore
469 
470 !Local variables-------------------------------
471  integer :: w
472  character(50) :: tmp_i
473  character(len=30) :: ifmt
474  logical :: nl
475 ! *************************************************************************
476 
477  if (present(ignore)) then
478    if (val == ignore) return
479  end if
480 
481  ABI_DEFAULT(nl, newline, .true.)
482  ABI_DEFAULT(w, width, self%default_width)
483  ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
484 
485  if (present(tag)) then
486    call yaml_start_field(self%stream, label, width=w, tag=tag)
487  else
488    call yaml_start_field(self%stream, label, width=w)
489  end if
490 
491  call self%stream%push(' ')
492  write(tmp_i, trim(ifmt)) val
493  call self%stream%push(trim(tmp_i))
494 
495  if (present(comment)) call self%stream%push(' # '//trim(comment))
496  if (nl) call self%stream%push(eol)
497 
498 end subroutine yamldoc_add_int

m_yaml/yamldoc_add_int1d [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_int1d

FUNCTION

  Add a field containing a 1D integer array

INPUTS

  label = key name
  arr(:) <integer>=
  [multiline_trig] = optional minimum number of elements before switching to multiline representation
  [tag] : add a tag to the field
  int_fmt <character(len=*)>=optional override the default formatting
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [comment]: optional Yaml comment added after the value

SOURCE

701 subroutine yamldoc_add_int1d(self, label, arr, tag, int_fmt, multiline_trig, newline, width, comment)
702 
703 !Arguments ------------------------------------
704  class(yamldoc_t),intent(inout) :: self
705  integer,intent(in),optional :: multiline_trig
706  integer,intent(in) :: arr(:)
707  character(len=*),intent(in) :: label
708  character(len=*),intent(in),optional :: tag, int_fmt
709  logical,intent(in),optional :: newline
710  integer,intent(in),optional :: width
711  character(len=*),intent(in),optional :: comment
712 
713 !Local variables-------------------------------
714  character(len=30) :: ifmt
715  integer :: w, length, vmax
716  logical :: nl
717 ! *************************************************************************
718 
719  ABI_DEFAULT(nl, newline, .true.)
720  ABI_DEFAULT(w, width, self%default_width)
721  ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
722  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
723  length = size(arr)
724 
725  if (present(tag)) then
726    call yaml_start_field(self%stream, label, width=w, tag=tag)
727  else
728    call yaml_start_field(self%stream, label, width=w)
729  end if
730 
731  call yaml_print_int1d(self%stream, length, arr, trim(ifmt), vmax)
732  if (present(comment)) call self%stream%push(' # '//trim(comment))
733  if (nl) call self%stream%push(eol)
734 
735 end subroutine yamldoc_add_int1d

m_yaml/yamldoc_add_int2d [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_int2d

FUNCTION

  Add a field containing a 2D integer array

INPUTS

  label = key name
  arr(:, :) <integer>=
  [slist(:)]= List of strings (same length as the first dim or second dime of arr, depending on mode).
    If present, the string will be included in the the row.
  [tag]= add a tag to the field
  [int_fmt]: override the default formatting
  multiline_trig <integer>=optional minimum number of elements before switching to multiline representation
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [mode] = "T" to write the transpose of arr i.e columns become rows in output (DEFAULT), "N" for normal order
  [comment]: optional Yaml comment added after the key.

SOURCE

1019 subroutine yamldoc_add_int2d(self, label, arr, slist, tag, int_fmt, multiline_trig, newline, width, mode, comment)
1020 
1021 !Arguments ------------------------------------
1022  class(yamldoc_t),intent(inout) :: self
1023  integer,intent(in) :: arr(:, :)
1024  character(len=*),intent(in) :: label
1025  character(len=*),optional,intent(in) :: slist(:)
1026  character(len=*),intent(in),optional :: tag, int_fmt
1027  integer,intent(in),optional :: multiline_trig
1028  logical,intent(in),optional :: newline
1029  integer,intent(in),optional :: width
1030  character(len=1),intent(in),optional :: mode
1031  character(len=*),intent(in),optional :: comment
1032 
1033 !Local variables-------------------------------
1034  integer :: m, n, w, i, vmax
1035  integer :: line(max(size(arr, dim=1), size(arr, dim=2)))
1036  character(len=30) :: ifmt
1037  character(len=1) :: my_mode
1038  logical :: nl
1039 ! *************************************************************************
1040 
1041  m = size(arr, dim=1)
1042  n = size(arr, dim=2)
1043 
1044  ABI_DEFAULT(nl, newline, .true.)
1045  ABI_DEFAULT(w, width, self%default_width)
1046  ABI_DEFAULT(my_mode, mode, "T")
1047  ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
1048  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1049 
1050  if (present(tag)) then
1051    call yaml_start_field(self%stream, label, width=w, tag=tag)
1052  else
1053    call yaml_start_field(self%stream, label, width=w)
1054  end if
1055  if (present(comment)) call self%stream%push(' # '//trim(comment))
1056 
1057  if (my_mode == "T") then
1058    do i=1,n
1059      call self%stream%push(eol//'-')
1060      line(1:m) = arr(:,i)
1061      if (.not. present(slist)) then
1062        call yaml_print_int1d(self%stream, m, line, ifmt, vmax)
1063      else
1064        call yaml_print_int1d(self%stream, m, line, ifmt, vmax, string=slist(i))
1065      end if
1066    end do
1067  else
1068    do i=1,m
1069      call self%stream%push(eol//'-')
1070      line(1:n) = arr(i,:)
1071      if (.not. present(slist)) then
1072        call yaml_print_int1d(self%stream, n, line, ifmt, vmax)
1073      else
1074        call yaml_print_int1d(self%stream, n, line, ifmt, vmax, string=slist(i))
1075      end if
1076    end do
1077  end if
1078 
1079  if (nl) call self%stream%push(eol)
1080 
1081 end subroutine yamldoc_add_int2d

m_yaml/yamldoc_add_ints [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_ints

FUNCTION

  Add a list of integer numbers to the document

INPUTS

  keylist = List of comma-separated keywords e.g. "foo, bar"
  values = List of integer values
  [int_fmt] = override the default formatting
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [dict_key]=If present, a dictionary with key `dict_key` is created instead of a list.
  [multiline_trig] = minimum number of elements before switching to multiline representation
  [ignore]= If present, ignore entrie if values is equal to ignore.

SOURCE

519 subroutine yamldoc_add_ints(self, keylist, values, int_fmt, width, dict_key, multiline_trig, ignore)
520 
521 !Arguments ------------------------------------
522  class(yamldoc_t),intent(inout) :: self
523  character(len=*),intent(in) :: keylist
524  integer,intent(in) :: values(:)
525  character(len=*),intent(in),optional :: int_fmt, dict_key
526  integer,intent(in),optional :: width, multiline_trig
527  integer,intent(in),optional :: ignore
528 
529 !Local variables-------------------------------
530  integer :: i, n, w, start, stp, vmax, my_ignore
531  character(len=30) :: ifmt
532  type(pair_list) :: dict
533 ! *************************************************************************
534 
535  ABI_DEFAULT(w, width, self%default_width)
536  ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
537  ABI_DEFAULT(my_ignore, ignore, MAGIC_IGNORE_INT)
538 
539  n = char_count(keylist, ",") + 1
540  ABI_CHECK(size(values) == n, sjoin("size of values:", itoa(size(values)), " != len(tokens):", keylist))
541 
542  start = 1
543 
544  if (.not. present(dict_key)) then
545    ! one line per entry.
546    do i=1,n
547      stp = index(keylist(start:), ",")
548      if (stp == 0) then
549        call self%add_int(adjustl(keylist(start:)), values(i), int_fmt=ifmt, width=w, ignore=my_ignore)
550      else
551        call self%add_int(adjustl(keylist(start: start + stp - 2)), values(i), int_fmt=ifmt, width=w, ignore=my_ignore)
552        start = start + stp
553        ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
554      end if
555    end do
556 
557  else
558    ! Create and insert dictionary.
559    do i=1,n
560      stp = index(keylist(start:), ",")
561      if (stp == 0) then
562        if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start:)), i=values(i))
563      else
564        if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start: start + stp - 2)), i=values(i))
565        start = start + stp
566        ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
567      end if
568    end do
569 
570    ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
571    call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, int_fmt=ifmt, width=w)
572    call dict%free()
573  end if
574 
575 end subroutine yamldoc_add_ints

m_yaml/yamldoc_add_paired_real2d [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_paired_real2d

FUNCTION

  Add a field containing two 2D real arrays with the same shape.

  Example:
    cartesian_forces_and_xred:
    - [ [ -0.0000E+00,  -0.0000E+00,  -0.0000E+00, ], [  0.0000E+00,   0.0000E+00,   0.0000E+00, ] ]
    - [ [ -0.0000E+00,  -0.0000E+00,  -0.0000E+00, ], [  2.5000E-01,   2.5000E-01,   2.5000E-01, ] ]

INPUTS

  label = key name
  arr1(:,:), arr2(:,:) = input arrays.
  [slist(:)]= List of strings (same length as the first dim or second dime of arr, depending on mode).
    If present, the string will be included in the the row.
  [tag]= add a tag to the field
  [real_fmt]= override the default formatting
  [multiline_trig]: optional minimum number of elements before switching to multiline representation
  [newline]: set to false to prevent adding newlines after fields
  [width]: impose a minimum width of the field name side of the column (padding with spaces)
  [mode]: "T" to write the transpose of arr i.e columns become rows in output (DEFAULT), "N" for normal order
  [comment]: optional Yaml comment added after the key

SOURCE

921 subroutine yamldoc_add_paired_real2d(self, label, arr1, arr2, slist, tag, real_fmt, &
922         multiline_trig, newline, width, mode, comment)
923 
924 !Arguments ------------------------------------
925  class(yamldoc_t),intent(inout) :: self
926  real(dp),intent(in) :: arr1(:, :), arr2(:,:)
927  character(len=*),intent(in) :: label
928  character(len=*),intent(in),optional :: tag, real_fmt
929  integer,intent(in),optional :: multiline_trig
930  logical,intent(in),optional :: newline
931  integer,intent(in),optional :: width
932  character(len=1),intent(in),optional :: mode
933  character(len=*),optional,intent(in) :: slist(:)
934  character(len=*),intent(in),optional :: comment
935 
936 !Local variables-------------------------------
937  integer :: m, n, w, i, vmax
938  real(dp) :: line(2 * max(size(arr1, dim=1), size(arr1, dim=2)))
939  character(len=30) :: rfmt
940  character(len=1) :: my_mode
941  logical :: nl
942 ! *************************************************************************
943 
944  m = size(arr1, dim=1)
945  n = size(arr1, dim=2)
946 
947  ABI_CHECK(all(shape(arr1) == shape(arr2)), "arr1 and arr2 must have same shape")
948 
949  ABI_DEFAULT(nl, newline, .true.)
950  ABI_DEFAULT(w, width, self%default_width)
951  ABI_DEFAULT(my_mode, mode, "T")
952  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
953  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
954 
955  if (present(tag)) then
956    call yaml_start_field(self%stream, label, width=w, tag=tag)
957  else
958    call yaml_start_field(self%stream, label, width=w)
959  end if
960  if (present(comment)) call self%stream%push(' # '//trim(comment))
961 
962  if (my_mode == "T") then
963    if (present(slist)) then
964      ABI_CHECK(size(slist) == n, "size(slist) != n")
965    end if
966    do i=1,n
967      call self%stream%push(eol//'- [')
968      line(1:m) = arr1(:,i)
969      call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
970      call self%stream%push(',')
971      line(1:m) = arr2(:,i)
972      call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
973      if (present(slist)) call self%stream%push(', '//trim(slist(i)))
974      call self%stream%push(' ]')
975    end do
976  else
977    if (present(slist)) then
978      ABI_CHECK(size(slist) == n, "size(slist) != m")
979    end if
980    do i=1,m
981      call self%stream%push(eol//'- [')
982      line(1:n) = arr1(i,:)
983      call yaml_print_real1d(self%stream, n, line, rfmt, vmax)
984      call self%stream%push(',')
985      line(1:n) = arr2(i,:)
986      call yaml_print_real1d(self%stream, n, line, rfmt, vmax)
987      if (present(slist)) call self%stream%push(', '//trim(slist(i)))
988      call self%stream%push(']')
989    end do
990  end if
991 
992  if (nl) call self%stream%push(eol)
993 
994 end subroutine yamldoc_add_paired_real2d

m_yaml/yamldoc_add_real [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_real

FUNCTION

  Add a real number field to a document

INPUTS

  label = key name
  val = value
  [tag] = optional, add a tag to the field
  [real_fmt] = override the default formatting
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [comment]: optional Yaml comment added after the value
  [ignore]= If present, ignore entry if value is equal to ignore.

SOURCE

319 subroutine yamldoc_add_real(self, label, val, tag, real_fmt, newline, width, comment, ignore)
320 
321 !Arguments ------------------------------------
322  class(yamldoc_t),intent(inout) :: self
323  character(len=*),intent(in) :: label
324  real(dp),intent(in) :: val
325  character(len=*),intent(in),optional :: tag, real_fmt
326  logical,intent(in),optional :: newline
327  integer,intent(in),optional :: width
328  character(len=*),intent(in),optional :: comment
329  real(dp),optional,intent(in) :: ignore
330 
331 !Local variables-------------------------------
332  integer :: w
333  character(len=50) :: tmp_r
334  character(len=30) :: rfmt
335  logical :: nl
336 ! *************************************************************************
337 
338  if (present(ignore)) then
339    if (val == ignore) return
340  end if
341 
342  ABI_DEFAULT(nl, newline, .true.)
343  ABI_DEFAULT(w, width, self%default_width)
344  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
345 
346  if (present(tag)) then
347    call yaml_start_field(self%stream, label, width=w, tag=tag)
348  else
349    call yaml_start_field(self%stream, label, width=w)
350  end if
351 
352  call self%stream%push(' ')
353  call format_real(val, tmp_r, trim(rfmt))
354  call self%stream%push(trim(tmp_r))
355 
356  if (present(comment)) call self%stream%push(' # '//trim(comment))
357  if (nl) call self%stream%push(eol)
358 
359 end subroutine yamldoc_add_real

m_yaml/yamldoc_add_real1d [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_real1d

FUNCTION

  Add a field containing a 1D array of real numbers

INPUTS

  label = key name
  arr(:)
  [multiline_trig] = optional minimum number of elements before switching to multiline representation
  [tag] = optional, add a tag to the field
  [real_fmt] = override the default formatting
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [comment]: optional Yaml comment added after the value

SOURCE

644 subroutine yamldoc_add_real1d(self, label, arr, tag, real_fmt, multiline_trig, newline, width, comment)
645 
646 !Arguments ------------------------------------
647  class(yamldoc_t),intent(inout) :: self
648  integer,intent(in),optional :: multiline_trig
649  real(dp),intent(in) :: arr(:)
650  character(len=*),intent(in) :: label
651  character(len=*),intent(in),optional :: tag, real_fmt
652  logical,intent(in),optional :: newline
653  integer,intent(in),optional :: width
654  character(len=*),intent(in),optional :: comment
655 
656 !Local variables-------------------------------
657  integer :: w, length, vmax
658  character(len=30) :: rfmt
659  logical :: nl
660 ! *************************************************************************
661 
662  length = size(arr)
663 
664  ABI_DEFAULT(nl, newline, .true.)
665  ABI_DEFAULT(w, width, self%default_width)
666  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
667  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
668 
669  if (present(tag)) then
670    call yaml_start_field(self%stream, label, width=w, tag=tag)
671  else
672    call yaml_start_field(self%stream, label, width=w)
673  end if
674 
675  call yaml_print_real1d(self%stream, length, arr, trim(rfmt), vmax)
676  if (present(comment)) call self%stream%push(' # '//trim(comment))
677  if (nl) call self%stream%push(eol)
678 
679 end subroutine yamldoc_add_real1d

m_yaml/yamldoc_add_real2d [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_real2d

FUNCTION

  Add a field containing a 2D array of real numbers

INPUTS

  label = key name
  arr(:, :) = input array.
  [slist(:)]= List of strings (same length as the first dim or second dime of arr, depending on mode).
    If present, the string will be included in the the row.
  [tag]= add a tag to the field
  [real_fmt]= override the default formatting
  [multiline_trig]: optional minimum number of elements before switching to multiline representation
  [newline]: set to false to prevent adding newlines after fields
  [width]: impose a minimum width of the field name side of the column (padding with spaces)
  [mode]: "T" to write the transpose of arr i.e columns become rows in output (DEFAULT), "N" for normal order
  [comment]: optional Yaml comment added after the key.

SOURCE

829 subroutine yamldoc_add_real2d(self, label, arr, slist, tag, real_fmt, multiline_trig, newline, width, mode, comment)
830 
831 !Arguments ------------------------------------
832  class(yamldoc_t),intent(inout) :: self
833  real(dp),intent(in) :: arr(:, :)
834  character(len=*),intent(in) :: label
835  character(len=*),optional,intent(in) :: slist(:)
836  character(len=*),intent(in),optional :: tag, real_fmt
837  integer,intent(in),optional :: multiline_trig
838  logical,intent(in),optional :: newline
839  integer,intent(in),optional :: width
840  character(len=1),intent(in),optional :: mode
841  character(len=*),intent(in),optional :: comment
842 
843 !Local variables-------------------------------
844  integer :: m, n, w, i, vmax
845  real(dp) :: line(max(size(arr, dim=1), size(arr, dim=2)))
846  character(len=30) :: rfmt
847  character(len=1) :: my_mode
848  logical :: nl
849 ! *************************************************************************
850 
851  m = size(arr, dim=1)
852  n = size(arr, dim=2)
853 
854  ABI_DEFAULT(nl, newline, .true.)
855  ABI_DEFAULT(w, width, self%default_width)
856  ABI_DEFAULT(my_mode, mode, "T")
857  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
858  ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
859 
860  if (present(tag)) then
861    call yaml_start_field(self%stream, label, width=w, tag=tag)
862  else
863    call yaml_start_field(self%stream, label, width=w)
864  end if
865  if (present(comment)) call self%stream%push(' # '//trim(comment))
866 
867  if (my_mode == "T") then
868    do i=1,n
869      call self%stream%push(eol//'-')
870      line(1:m) = arr(:,i)
871      if (.not. present(slist)) then
872        call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
873      else
874        call yaml_print_real1d(self%stream, m, line, rfmt, vmax, string=trim(slist(i)))
875      end if
876    end do
877  else
878    do i=1,m
879      call self%stream%push(eol//'-')
880      line(1:n) = arr(i,:)
881      if (.not. present(slist)) then
882        call yaml_print_real1d(self%stream, n, line, rfmt, vmax)
883      else
884        call yaml_print_real1d(self%stream, n, line, rfmt, vmax, string=trim(slist(i)))
885      end if
886    end do
887  end if
888 
889  if (nl) call self%stream%push(eol)
890 
891 end subroutine yamldoc_add_real2d

m_yaml/yamldoc_add_reals [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_reals

FUNCTION

  Add a list of real numbers to the document

INPUTS

  keylist = List of comma-separated keywords
  values = List of values
  [real_fmt] = override the default formatting
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [dict_key]=If present, a dictionary with key `dict_key` is created instead of a list.
  [multiline_trig] = optional minimum number of elements before switching to multiline representation
  [ignore]= If present, ignore entries whose values is equal to ignore.

SOURCE

380 subroutine yamldoc_add_reals(self, keylist, values, real_fmt, width, dict_key, multiline_trig, ignore)
381 
382 !Arguments ------------------------------------
383  class(yamldoc_t),intent(inout) :: self
384  character(len=*),intent(in) :: keylist
385  real(dp),intent(in) :: values(:)
386  character(len=*),intent(in),optional :: real_fmt, dict_key
387  integer,intent(in),optional :: width, multiline_trig
388  real(dp),optional,intent(in) :: ignore
389 
390 !Local variables-------------------------------
391  integer :: i, n, w, start, stp, vmax
392  character(len=30) :: rfmt
393  real(dp) :: my_ignore
394  type(pair_list) :: dict
395 ! *************************************************************************
396 
397  ABI_DEFAULT(w, width, self%default_width)
398  ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
399  ABI_DEFAULT(my_ignore, ignore, MAGIC_IGNORE_REAL)
400 
401  n = char_count(keylist, ",") + 1
402  ABI_CHECK(size(values) == n, sjoin("size of values:", itoa(size(values)), " != len(tokens):", keylist))
403 
404  start = 1
405 
406  if (.not. present(dict_key)) then
407    do i=1,n
408      stp = index(keylist(start:), ",")
409      if (stp == 0) then
410        call self%add_real(adjustl(keylist(start:)), values(i), real_fmt=rfmt, width=w, ignore=my_ignore)
411      else
412        call self%add_real(adjustl(keylist(start: start + stp - 2)), values(i), real_fmt=rfmt, width=w, ignore=my_ignore)
413        start = start + stp
414        ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
415      end if
416    end do
417 
418  else
419 
420    ! Create and insert dictionary.
421    do i=1,n
422      stp = index(keylist(start:), ",")
423      if (stp == 0) then
424        if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start:)), r=values(i))
425      else
426        if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start: start + stp - 2)), r=values(i))
427        start = start + stp
428        ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
429      end if
430    end do
431    ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
432    call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, real_fmt=rfmt, width=w)
433    call dict%free()
434  end if
435 
436 end subroutine yamldoc_add_reals

m_yaml/yamldoc_add_string [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_string

FUNCTION

  Add a string field to a document

INPUTS

  label = key name
  val = value
  [tag] = optional, add a tag to the field
  [newline] = set to false to prevent adding newlines after fields
  [width] = impose a minimum width of the field name side of the column (padding with spaces)

SOURCE

594 subroutine yamldoc_add_string(self, label, val, tag, newline, width)
595 
596 !Arguments ------------------------------------
597  class(yamldoc_t),intent(inout) :: self
598  character(len=*),intent(in) :: val
599  character(len=*),intent(in) :: label
600  character(len=*),intent(in),optional :: tag
601  logical,intent(in),optional :: newline
602  integer,intent(in),optional :: width
603 
604 !Local variables-------------------------------
605  integer :: w
606  logical :: nl
607 ! *************************************************************************
608 
609  ABI_DEFAULT(nl, newline, .true.)
610  ABI_DEFAULT(w, width, self%default_width)
611 
612  if (present(tag)) then
613    call yaml_start_field(self%stream, label, width=w, tag=tag)
614  else
615    call yaml_start_field(self%stream, label, width=w)
616  end if
617 
618  call self%stream%push(' ')
619  call yaml_print_string(self%stream, trim(val))
620  if (nl) call self%stream%push(eol)
621 
622 end subroutine yamldoc_add_string

m_yaml/yamldoc_add_tabular [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_tabular

FUNCTION

  Add a field with a complete table data

INPUTS

  label <character(len=*)>=
  input <type(stream_string)>=stream containing an already built table
  tag <character(len=*)>=optional  add a tag to the field
  newline <logical>=optional  set to false to prevent adding newlines after fields
  indent <integer>=optional number of spaces to add to each line

SOURCE

1260 !subroutine yamldoc_add_tabular(self, label, input, tag, newline, indent)
1261 !
1262 !!Arguments ------------------------------------
1263 ! class(yamldoc_t),intent(inout) :: self
1264 ! character(len=*),intent(in) :: label
1265 ! type(stream_string),intent(inout) :: input
1266 ! character(len=*),intent(in),optional :: tag
1267 ! logical,intent(in),optional :: newline
1268 ! integer,intent(in),optional :: indent
1269 !
1270 !!Local variables-------------------------------
1271 ! integer :: n
1272 ! character(len=100) :: t
1273 ! logical :: nl
1274 !! *************************************************************************
1275 !
1276 ! ABI_DEFAULT(nl, newline, .true.)
1277 ! ABI_DEFAULT(n, indent, 4)
1278 ! ABI_DEFAULT(t, tag, 'Tabular')
1279 !
1280 ! call yaml_open_tabular(label, tag=t, stream=self%stream, newline=nl)
1281 !
1282 ! if (n > 4) call self%stream%push(repeat(' ', n - 4))
1283 !
1284 ! call write_indent(input, self%stream, n)
1285 ! if (nl) call self%stream%push(eol)
1286 !
1287 !end subroutine yamldoc_add_tabular

m_yaml/yamldoc_add_tabular_line [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_add_tabular_line

FUNCTION

  Add a line of tabular data in an already opened table field

INPUTS

  line <character(len=*)>=
  [newline] = set to false to prevent adding newlines after fields
  [indent] = optional number of spaces to add to the header

SOURCE

1222 subroutine yamldoc_add_tabular_line(self, line, newline, indent)
1223 
1224 !Arguments ------------------------------------
1225  class(yamldoc_t),intent(inout) :: self
1226  character(len=*),intent(in) :: line
1227  logical,intent(in),optional :: newline
1228  integer,intent(in),optional :: indent
1229 
1230 !Local variables-------------------------------
1231  integer :: n
1232  logical :: nl
1233 ! *************************************************************************
1234 
1235  ABI_DEFAULT(nl, newline, .true.)
1236  ABI_DEFAULT(n, indent, 4)
1237 
1238  call self%stream%push(repeat(' ', n)//trim(line))
1239  if (nl) call self%stream%push(eol)
1240 
1241 end subroutine yamldoc_add_tabular_line

m_yaml/yamldoc_open [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_open

FUNCTION

  Open a yaml document

INPUTS

  tag: add a tag to the field
  [info]: info about document.
  [newline]: optional, set to false to prevent adding newlines after fields
  [width]: optional, impose a minimum width of the field name side of the column (padding with spaces)
  [int_fmt]: Default format for integers.
  [real_fmt]: Default format for real.
  [with_iter_state]: True if dict with iteration state should be added. Default: True

SOURCE

249 type(yamldoc_t) function yamldoc_open(tag, info, newline, width, int_fmt, real_fmt, with_iter_state) result(new)
250 
251 !Arguments ------------------------------------
252  character(len=*),intent(in) :: tag
253  character(len=*),optional,intent(in) :: info
254  logical,intent(in),optional :: newline
255  integer,intent(in),optional :: width
256  character(len=*),optional,intent(in) :: int_fmt, real_fmt
257  logical,optional,intent(in) :: with_iter_state
258 
259 !Local variables-------------------------------
260  logical :: nl, with_iter_state_
261  type(pair_list) :: dict
262 ! *************************************************************************
263 
264  ABI_DEFAULT(nl, newline, .False.)
265 
266  if (present(width)) new%default_width = width
267  if (present(int_fmt)) new%default_ifmt = int_fmt
268  if (present(real_fmt)) new%default_rfmt = real_fmt
269 
270  call new%stream%push(ch10//'---'//' !'//trim(tag)//ch10)
271 
272  with_iter_state_ = .True.; if (present(with_iter_state)) with_iter_state_ = with_iter_state
273  if (with_iter_state_ .and. DTSET_IDX /= -1) then
274    ! Write dictionary with iteration state.
275    call dict%set('dtset', i=DTSET_IDX)
276    if (TIMIMAGE_IDX /= -1) call dict%set("timimage", i=TIMIMAGE_IDX)
277    if (IMAGE_IDX /= -1) call dict%set("image", i=IMAGE_IDX)
278    if (ITIME_IDX /= -1) call dict%set("itime", i=ITIME_IDX)
279    if (ICYCLE_IDX /= -1) call dict%set("icycle", i=ICYCLE_IDX)
280    call new%add_dict('iteration_state', dict, int_fmt="(i0)")
281    call dict%free()
282  end if
283 
284  if (present(info)) then
285    if (len_trim(info) /= 0) then
286      ! TODO: Replace comment with info
287      call new%stream%push('comment')
288      if (new%default_width > 7) call new%stream%push(repeat(' ', new%default_width - 7))
289      call new%stream%push(': ')
290      call yaml_print_string(new%stream, info)
291      call new%stream%push(eol)
292    end if
293  end if
294 
295  if (nl) call new%stream%push(eol)
296 
297 end function yamldoc_open

m_yaml/yamldoc_open_tabular [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_open_tabular

FUNCTION

  Open a field for tabular data

INPUTS

  label = key name
  [tag] <character(len=*)>=optional add a tag to the field
  [newline] = set to false to prevent adding newlines after fields
  [indent] = optional number of spaces to add to the header
  [comment]: optional Yaml comment added after the value

SOURCE

1171 subroutine yamldoc_open_tabular(self, label, tag, indent, newline, comment)
1172 
1173 !Arguments ------------------------------------
1174  class(yamldoc_t),intent(inout) :: self
1175  character(len=*),intent(in) :: label
1176  character(len=*),intent(in),optional :: tag
1177  logical,intent(in),optional :: newline
1178  integer,intent(in),optional :: indent
1179  character(len=*),intent(in),optional :: comment
1180 
1181 !Local variables-------------------------------
1182  integer :: n
1183  logical :: nl
1184 ! *************************************************************************
1185 
1186  ABI_DEFAULT(nl, newline, .true.)
1187  ABI_DEFAULT(n, indent, 4)
1188 
1189  if (n > 4) then
1190    call self%stream%push(repeat(' ', n-4))
1191  end if
1192 
1193  if (present(tag)) then
1194    call yaml_start_field(self%stream, label, tag=tag)
1195  else
1196    call yaml_start_field(self%stream, label, tag='Tabular')
1197  end if
1198 
1199  if (present(comment)) then
1200    call self%stream%push(' | # '//trim(comment)//eol)
1201  else
1202    call self%stream%push(' |'//eol)
1203  end if
1204 
1205 end subroutine yamldoc_open_tabular

m_yaml/yamldoc_set_keys_to_string [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_set_keys_to_string

FUNCTION

 Set all keys to a common (string) value

INPUTS

  keylist = List of comma-separated keywords
  svalue = String Value
  [width] = impose a minimum width of the field name side of the column (padding with spaces)
  [dict_key]=If present, a dictionary with key `dict_key` is created instead of a list.
  [multiline_trig] = optional minimum number of elements before switching to multiline representation

SOURCE

1531 subroutine yamldoc_set_keys_to_string(self, keylist, svalue, dict_key, width, multiline_trig)
1532 
1533 !Arguments ------------------------------------
1534  class(yamldoc_t),intent(inout) :: self
1535  character(len=*),intent(in) :: keylist, svalue
1536  character(len=*),intent(in),optional :: dict_key
1537  integer,intent(in),optional :: width, multiline_trig
1538 
1539 !Local variables-------------------------------
1540  integer :: i, n, w, start, stp, vmax
1541  type(pair_list) :: dict
1542 
1543 ! *************************************************************************
1544 
1545  ABI_DEFAULT(w, width, self%default_width)
1546 
1547  n = char_count(keylist, ",") + 1
1548  start = 1
1549 
1550  if (.not. present(dict_key)) then
1551    do i=1,n
1552      stp = index(keylist(start:), ",")
1553      if (stp == 0) then
1554        call self%add_string(adjustl(keylist(start:)), svalue, width=w)
1555      else
1556        call self%add_string(adjustl(keylist(start: start + stp - 2)), svalue, width=w)
1557        start = start + stp
1558        ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
1559      end if
1560    end do
1561 
1562  else
1563    ! Create and insert dictionary.
1564    do i=1,n
1565      stp = index(keylist(start:), ",")
1566      if (stp == 0) then
1567        call dict%set(adjustl(keylist(start:)), s=svalue)
1568      else
1569        call dict%set(adjustl(keylist(start: start + stp - 2)), s=svalue)
1570        start = start + stp
1571        ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
1572      end if
1573    end do
1574    ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1575    call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, width=w)
1576    call dict%free()
1577  end if
1578 
1579 end subroutine yamldoc_set_keys_to_string

m_yaml/yamldoc_t [ Types ]

[ Top ] [ m_yaml ] [ Types ]

NAME

 yamldoc_t

FUNCTION

 High-level API to write (simple) Yaml documents.

SOURCE

 53  type,public :: yamldoc_t
 54 
 55    integer :: default_keysize = 30
 56    ! Default key size
 57 
 58    integer :: default_stringsize = 500
 59    ! Default string size
 60 
 61    integer :: default_width = 0
 62    ! impose a minimum width of the field name side of the column (padding with spaces)
 63 
 64    integer :: default_multiline_trig = 8
 65    ! minimum number of elements before switching to multiline representation.
 66 
 67    character(len=20) :: default_ifmt = '(I0)'
 68    ! Default format for integer
 69 
 70    character(len=20) :: default_rfmt = '(ES16.8)'
 71    ! Default format for real
 72 
 73    character(len=20) :: default_kfmt = "(A)"
 74    ! Default format for keys
 75 
 76    character(len=20) :: default_sfmt = "(A)"
 77    ! Default format for strings
 78 
 79    type(stream_string) :: stream
 80    ! Stream object used to build yaml string.
 81 
 82  contains
 83 
 84    procedure :: write_and_free => yamldoc_write_unit_and_free
 85     ! Write Yaml document to unit and free memory.
 86 
 87    procedure :: write_units_and_free => yamldoc_write_units_and_free
 88     ! Write Yaml document to a list of units and free memory.
 89 
 90    procedure :: add_real => yamldoc_add_real
 91      ! Add a real number field to a document
 92 
 93    procedure :: add_reals => yamldoc_add_reals
 94      ! Add a list of real number fields to a document
 95 
 96    procedure :: add_paired_real2d => yamldoc_add_paired_real2d
 97      ! Add a field containing two 2D array of real numbers with the same shape.
 98 
 99    procedure :: add_int => yamldoc_add_int
100      ! Add an integer field to a document
101 
102    procedure :: add_ints => yamldoc_add_ints
103      ! Add a list of integers to a document
104 
105    procedure :: add_string => yamldoc_add_string
106      ! Add a string field to a document
107 
108    procedure :: add_real1d => yamldoc_add_real1d
109      ! Add a field containing a 1D array of real numbers
110 
111    procedure :: add_real2d => yamldoc_add_real2d
112      ! Add a field containing a 2D real number array
113 
114    procedure :: add_int1d => yamldoc_add_int1d
115      ! Add a field containing a 1D integer array
116 
117    procedure :: add_int2d => yamldoc_add_int2d
118      ! Add a field containing a 2D integer array
119 
120    !procedure :: add_tabular => yamldoc_add_tabular
121      ! Add a field with a complete table data
122 
123    procedure :: open_tabular => yamldoc_open_tabular
124      ! Open a field for tabular data
125 
126    procedure :: add_tabular_line => yamldoc_add_tabular_line
127      ! Add a line of tabular data in an already opened table field
128 
129    procedure :: add_dict => yamldoc_add_dict
130      ! Add a field containing a dictionary/pair_list
131 
132    procedure :: add_dictlist => yamldoc_add_dictlist
133      ! Add a field containing a list of dictionaries/array of pair_list
134 
135    procedure :: set_keys_to_string => yamldoc_set_keys_to_string
136      ! Set all keys to a common (string) value
137 
138  end type yamldoc_t

m_yaml/yamldoc_write_unit_and_free [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_write_unit_and_free

FUNCTION

  Write Yaml document to unit and free memory.

INPUTS

  [newline]= set to False to prevent adding newlines after fields. Default: True
  [firstchar]= Add first char to each line. Useful if the Yaml document must be added after shell comments
    with firstchar="#".

SOURCE

1436 subroutine yamldoc_write_unit_and_free(self, unit, newline, firstchar)
1437 
1438 !Arguments ------------------------------------
1439  class(yamldoc_t),intent(inout) :: self
1440  integer,intent(in) :: unit
1441  logical,intent(in),optional :: newline
1442  character(len=*),optional,intent(in) :: firstchar
1443 
1444 !Local variables-------------------------------
1445  logical :: nl
1446 ! *************************************************************************
1447 
1448  if (self%stream%length == 0) return
1449  ABI_DEFAULT(nl, newline, .true.)
1450 
1451  call self%stream%push('...')
1452 
1453  ! FIXME: In principle, we should not use is_open here but it seems that
1454  ! ab_out is not set to dev_null if parallelism over images.
1455  if (is_open(unit)) then
1456    if (present(firstchar)) then
1457      call self%stream%flush(unit, newline=nl, firstchar=firstchar)
1458    else
1459      call self%stream%flush(unit, newline=nl)
1460    end if
1461  else
1462    call self%stream%free()
1463  end if
1464 
1465 end subroutine yamldoc_write_unit_and_free

m_yaml/yamldoc_write_units_and_free [ Functions ]

[ Top ] [ m_yaml ] [ Functions ]

NAME

 yamldoc_write_units_and_free

FUNCTION

  Write Yaml document to a list of units and free memory.

INPUTS

  [newline]= set to false to prevent adding newlines after fields. Default: True

SOURCE

1480 subroutine yamldoc_write_units_and_free(self, units, newline)
1481 
1482 !Arguments ------------------------------------
1483  class(yamldoc_t),intent(inout) :: self
1484  integer,intent(in) :: units(:)
1485  logical,intent(in),optional :: newline
1486 
1487 !Local variables-------------------------------
1488  integer :: ii, cnt
1489  logical :: nl
1490 !arrays
1491  integer :: my_units(size(units))
1492 ! *************************************************************************
1493 
1494  if (self%stream%length == 0) return
1495  ABI_DEFAULT(nl, newline, .true.)
1496 
1497  ! Remove duplicated units (if any)
1498  ! FIXME: In principle, we should not use is_open here but it seems that
1499  ! ab_out is not set to dev_null if parallelism over images.
1500  my_units(1) = units(1); cnt = 1
1501  do ii=2,size(units)
1502    if (any(units(ii) == my_units(1:cnt))) cycle
1503    if (is_open(units(ii))) then
1504      cnt = cnt + 1
1505      my_units(cnt) = units(ii)
1506    end if
1507  end do
1508 
1509  call self%stream%push('...')
1510  call self%stream%flush_units(my_units, newline=nl)
1511 
1512 end subroutine yamldoc_write_units_and_free