Line data Source code
1 : !!****m* ABINIT/m_yaml
2 : !! NAME
3 : !! m_yaml
4 : !!
5 : !! FUNCTION
6 : !! This module defines low-level routines to format data into YAML documents.
7 : !! Supported data include numeric arrays of one and two dimensions,
8 : !! strings, numbers, dictionaries from m_pair_list and 1D arrays of dictionaries.
9 : !!
10 : !! COPYRIGHT
11 : !! Copyright (C) 2009-2026 ABINIT group (TC, MG)
12 : !! This file is distributed under the terms of the
13 : !! GNU General Public License, see ~abinit/COPYING
14 : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : !!
16 : !! SOURCE
17 :
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
40 : !!***
41 :
42 : !----------------------------------------------------------------------
43 :
44 : !!****t* m_yaml/yamldoc_t
45 : !! NAME
46 : !! yamldoc_t
47 : !!
48 : !! FUNCTION
49 : !! High-level API to write (simple) Yaml documents.
50 : !!
51 : !! SOURCE
52 :
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
139 : !!***
140 :
141 : public :: yamldoc_open
142 : ! Open a yaml document
143 :
144 : public :: yaml_single_dict
145 : ! Create a full document from a single dictionary
146 :
147 : public :: yaml_write_dict
148 : ! Write a dictionary in a Yaml document.
149 :
150 : public :: yaml_iterstart
151 : ! Set the value of the iteration indices used to build the iteration_state dict in the Yaml documents
152 :
153 : character(len=1),parameter :: eol = char(10)
154 :
155 : ! This is a list of reserved_keywords that shall not be used as keys in Yaml dictionaries.
156 : character(len=12),parameter :: reserved_keywords(10) = [character(len=12) :: &
157 : "tol_abs", "tol_rel", "tol_vec", "tol_eq", "ignore", &
158 : "ceil", "equation", "equations", "callback", "callbacks"]
159 :
160 : ! Global variables used to save the iteration state in Abinit.
161 : ! Set by yaml_iterstart
162 : integer,public,save,protected :: DTSET_IDX = -1
163 : integer,public,save,protected :: TIMIMAGE_IDX = -1
164 : integer,public,save,protected :: IMAGE_IDX = -1
165 : integer,public,save,protected :: ITIME_IDX = -1
166 : integer,public,save,protected :: ICYCLE_IDX = -1
167 :
168 : integer,parameter,private :: MAGIC_IGNORE_INT = huge(0) - 1
169 : real(dp),parameter,private :: MAGIC_IGNORE_REAL = huge(one) - one
170 :
171 : contains
172 :
173 : !!****f* m_yaml/yaml_iterstart
174 : !! NAME
175 : !! yaml_iterstart
176 : !!
177 : !! FUNCTION
178 : !! Mark the start of an iteration named by label and numbered by file
179 : !!
180 : !! INPUTS
181 : !! label=key name
182 : !! val=value
183 : !! [newline] = set to false to prevent adding newlines after fields
184 : !!
185 : !! SOURCE
186 :
187 22510 : 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 5285 : select case (label)
201 : case ("dtset")
202 5285 : DTSET_IDX = val
203 5285 : TIMIMAGE_IDX = -1
204 5285 : IMAGE_IDX = -1
205 5285 : ITIME_IDX = -1
206 5285 : ICYCLE_IDX = -1
207 : case ("timimage")
208 358 : TIMIMAGE_IDX = val
209 : case ("image")
210 1716 : IMAGE_IDX = val
211 : case ("itime")
212 3655 : ITIME_IDX = val
213 : case ("icycle")
214 11496 : ICYCLE_IDX = val
215 : case default
216 0 : ABI_ERROR(sjoin("Invalid value for label:", label))
217 : end select
218 :
219 22510 : if (use_yaml == 1) then
220 48 : if (unit == dev_null .or. .not. is_open(unit)) return
221 12 : ABI_DEFAULT(nl, newline, .true.)
222 12 : write(tmp_i, '(I6)') val
223 12 : call stream%push('--- !IterStart'//eol//label//':'//tmp_i//eol//'...')
224 12 : if (nl) call stream%push(eol)
225 12 : call stream%flush(unit)
226 : end if
227 :
228 22510 : end subroutine yaml_iterstart
229 : !!***
230 :
231 : !!****f* m_yaml/yamldoc_open
232 : !! NAME
233 : !! yamldoc_open
234 : !!
235 : !! FUNCTION
236 : !! Open a yaml document
237 : !!
238 : !! INPUTS
239 : !! tag: add a tag to the field
240 : !! [info]: info about document.
241 : !! [newline]: optional, set to false to prevent adding newlines after fields
242 : !! [width]: optional, impose a minimum width of the field name side of the column (padding with spaces)
243 : !! [int_fmt]: Default format for integers.
244 : !! [real_fmt]: Default format for real.
245 : !! [with_iter_state]: True if dict with iteration state should be added. Default: True
246 : !!
247 : !! SOURCE
248 :
249 63537 : 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 0 : ABI_DEFAULT(nl, newline, .False.)
265 :
266 63537 : if (present(width)) new%default_width = width
267 63537 : if (present(int_fmt)) new%default_ifmt = int_fmt
268 63537 : if (present(real_fmt)) new%default_rfmt = real_fmt
269 :
270 63537 : call new%stream%push(ch10//'---'//' !'//trim(tag)//ch10)
271 :
272 63537 : with_iter_state_ = .True.; if (present(with_iter_state)) with_iter_state_ = with_iter_state
273 63537 : if (with_iter_state_ .and. DTSET_IDX /= -1) then
274 : ! Write dictionary with iteration state.
275 62847 : call dict%set('dtset', i=DTSET_IDX)
276 62847 : if (TIMIMAGE_IDX /= -1) call dict%set("timimage", i=TIMIMAGE_IDX)
277 62847 : if (IMAGE_IDX /= -1) call dict%set("image", i=IMAGE_IDX)
278 62847 : if (ITIME_IDX /= -1) call dict%set("itime", i=ITIME_IDX)
279 62847 : if (ICYCLE_IDX /= -1) call dict%set("icycle", i=ICYCLE_IDX)
280 62847 : call new%add_dict('iteration_state', dict, int_fmt="(i0)")
281 62847 : call dict%free()
282 : end if
283 :
284 63537 : if (present(info)) then
285 12756 : if (len_trim(info) /= 0) then
286 : ! TODO: Replace comment with info
287 12756 : call new%stream%push('comment')
288 123844 : if (new%default_width > 7) call new%stream%push(repeat(' ', new%default_width - 7))
289 12756 : call new%stream%push(': ')
290 12756 : call yaml_print_string(new%stream, info)
291 12756 : call new%stream%push(eol)
292 : end if
293 : end if
294 :
295 63537 : if (nl) call new%stream%push(eol)
296 :
297 63537 : end function yamldoc_open
298 : !!***
299 :
300 : !!****f* m_yaml/yamldoc_add_real
301 : !! NAME
302 : !! yamldoc_add_real
303 : !!
304 : !! FUNCTION
305 : !! Add a real number field to a document
306 : !!
307 : !! INPUTS
308 : !! label = key name
309 : !! val = value
310 : !! [tag] = optional, add a tag to the field
311 : !! [real_fmt] = override the default formatting
312 : !! [newline] = set to false to prevent adding newlines after fields
313 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
314 : !! [comment]: optional Yaml comment added after the value
315 : !! [ignore]= If present, ignore entry if value is equal to ignore.
316 : !!
317 : !! SOURCE
318 :
319 279247 : 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 279247 : if (present(ignore)) then
339 16448 : if (val == ignore) return
340 : end if
341 :
342 279247 : ABI_DEFAULT(nl, newline, .true.)
343 279247 : ABI_DEFAULT(w, width, self%default_width)
344 279247 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
345 :
346 279247 : if (present(tag)) then
347 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
348 : else
349 279247 : call yaml_start_field(self%stream, label, width=w)
350 : end if
351 :
352 279247 : call self%stream%push(' ')
353 279247 : call format_real(val, tmp_r, trim(rfmt))
354 279247 : call self%stream%push(trim(tmp_r))
355 :
356 279247 : if (present(comment)) call self%stream%push(' # '//trim(comment))
357 279247 : if (nl) call self%stream%push(eol)
358 :
359 279247 : end subroutine yamldoc_add_real
360 : !!***
361 :
362 : !!****f* m_yaml/yamldoc_add_reals
363 : !! NAME
364 : !! yamldoc_add_reals
365 : !!
366 : !! FUNCTION
367 : !! Add a list of real numbers to the document
368 : !!
369 : !! INPUTS
370 : !! keylist = List of comma-separated keywords
371 : !! values = List of values
372 : !! [real_fmt] = override the default formatting
373 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
374 : !! [dict_key]=If present, a dictionary with key `dict_key` is created instead of a list.
375 : !! [multiline_trig] = optional minimum number of elements before switching to multiline representation
376 : !! [ignore]= If present, ignore entries whose values is equal to ignore.
377 : !!
378 : !! SOURCE
379 :
380 66514 : 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 0 : ABI_DEFAULT(w, width, self%default_width)
398 33257 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
399 33257 : ABI_DEFAULT(my_ignore, ignore, MAGIC_IGNORE_REAL)
400 :
401 33257 : n = char_count(keylist, ",") + 1
402 33257 : ABI_CHECK(size(values) == n, sjoin("size of values:", itoa(size(values)), " != len(tokens):", keylist))
403 :
404 33257 : start = 1
405 :
406 33257 : if (.not. present(dict_key)) then
407 21932 : do i=1,n
408 16448 : stp = index(keylist(start:), ",")
409 21932 : if (stp == 0) then
410 5484 : call self%add_real(adjustl(keylist(start:)), values(i), real_fmt=rfmt, width=w, ignore=my_ignore)
411 : else
412 10964 : call self%add_real(adjustl(keylist(start: start + stp - 2)), values(i), real_fmt=rfmt, width=w, ignore=my_ignore)
413 10964 : start = start + stp
414 10964 : 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 142367 : do i=1,n
422 114594 : stp = index(keylist(start:), ",")
423 142367 : if (stp == 0) then
424 27773 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start:)), r=values(i))
425 : else
426 86821 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start: start + stp - 2)), r=values(i))
427 86821 : start = start + stp
428 86821 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
429 : end if
430 : end do
431 27773 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
432 27773 : call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, real_fmt=rfmt, width=w)
433 27773 : call dict%free()
434 : end if
435 :
436 33257 : end subroutine yamldoc_add_reals
437 : !!***
438 :
439 : !!****f* m_yaml/yamldoc_add_int
440 : !! NAME
441 : !! yamldoc_add_int
442 : !!
443 : !! FUNCTION
444 : !! Add an integer field to a document
445 : !!
446 : !! INPUTS
447 : !! label = key name
448 : !! val = value
449 : !! [tag] = optional, add a tag to the field
450 : !! [int_fmt] = optional override the default formatting
451 : !! [newline] = set to false to prevent adding newlines after fields
452 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
453 : !! [comment]: optional Yaml comment added after the value
454 : !! [ignore]= If present, ignore entrie if values is equal to ignore.
455 : !!
456 : !! SOURCE
457 :
458 76362 : 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 76362 : if (present(ignore)) then
478 2637 : if (val == ignore) return
479 : end if
480 :
481 76362 : ABI_DEFAULT(nl, newline, .true.)
482 76362 : ABI_DEFAULT(w, width, self%default_width)
483 76362 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
484 :
485 76362 : if (present(tag)) then
486 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
487 : else
488 76362 : call yaml_start_field(self%stream, label, width=w)
489 : end if
490 :
491 76362 : call self%stream%push(' ')
492 76362 : write(tmp_i, trim(ifmt)) val
493 76362 : call self%stream%push(trim(tmp_i))
494 :
495 76362 : if (present(comment)) call self%stream%push(' # '//trim(comment))
496 76362 : if (nl) call self%stream%push(eol)
497 :
498 76362 : end subroutine yamldoc_add_int
499 : !!***
500 :
501 : !!****f* m_yaml/yamldoc_add_ints
502 : !! NAME
503 : !! yamldoc_add_ints
504 : !!
505 : !! FUNCTION
506 : !! Add a list of integer numbers to the document
507 : !!
508 : !! INPUTS
509 : !! keylist = List of comma-separated keywords e.g. "foo, bar"
510 : !! values = List of integer values
511 : !! [int_fmt] = override the default formatting
512 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
513 : !! [dict_key]=If present, a dictionary with key `dict_key` is created instead of a list.
514 : !! [multiline_trig] = minimum number of elements before switching to multiline representation
515 : !! [ignore]= If present, ignore entrie if values is equal to ignore.
516 : !!
517 : !! SOURCE
518 :
519 36160 : 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 0 : ABI_DEFAULT(w, width, self%default_width)
536 18080 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
537 18080 : ABI_DEFAULT(my_ignore, ignore, MAGIC_IGNORE_INT)
538 :
539 18080 : n = char_count(keylist, ",") + 1
540 18080 : ABI_CHECK(size(values) == n, sjoin("size of values:", itoa(size(values)), " != len(tokens):", keylist))
541 :
542 18080 : start = 1
543 :
544 18080 : if (.not. present(dict_key)) then
545 : ! one line per entry.
546 3295 : do i=1,n
547 2637 : stp = index(keylist(start:), ",")
548 3295 : if (stp == 0) then
549 658 : call self%add_int(adjustl(keylist(start:)), values(i), int_fmt=ifmt, width=w, ignore=my_ignore)
550 : else
551 1979 : call self%add_int(adjustl(keylist(start: start + stp - 2)), values(i), int_fmt=ifmt, width=w, ignore=my_ignore)
552 1979 : start = start + stp
553 1979 : 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 103768 : do i=1,n
560 86346 : stp = index(keylist(start:), ",")
561 103768 : if (stp == 0) then
562 17422 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start:)), i=values(i))
563 : else
564 68924 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start: start + stp - 2)), i=values(i))
565 68924 : start = start + stp
566 68924 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
567 : end if
568 : end do
569 :
570 17422 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
571 17422 : call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, int_fmt=ifmt, width=w)
572 17422 : call dict%free()
573 : end if
574 :
575 18080 : end subroutine yamldoc_add_ints
576 : !!***
577 :
578 : !!****f* m_yaml/yamldoc_add_string
579 : !! NAME
580 : !! yamldoc_add_string
581 : !!
582 : !! FUNCTION
583 : !! Add a string field to a document
584 : !!
585 : !! INPUTS
586 : !! label = key name
587 : !! val = value
588 : !! [tag] = optional, add a tag to the field
589 : !! [newline] = set to false to prevent adding newlines after fields
590 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
591 : !!
592 : !! SOURCE
593 :
594 38184 : 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 38184 : ABI_DEFAULT(nl, newline, .true.)
610 38184 : ABI_DEFAULT(w, width, self%default_width)
611 :
612 38184 : if (present(tag)) then
613 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
614 : else
615 38184 : call yaml_start_field(self%stream, label, width=w)
616 : end if
617 :
618 38184 : call self%stream%push(' ')
619 38184 : call yaml_print_string(self%stream, trim(val))
620 38184 : if (nl) call self%stream%push(eol)
621 :
622 38184 : end subroutine yamldoc_add_string
623 : !!***
624 :
625 : !!****f* m_yaml/yamldoc_add_real1d
626 : !! NAME
627 : !! yamldoc_add_real1d
628 : !!
629 : !! FUNCTION
630 : !! Add a field containing a 1D array of real numbers
631 : !!
632 : !! INPUTS
633 : !! label = key name
634 : !! arr(:)
635 : !! [multiline_trig] = optional minimum number of elements before switching to multiline representation
636 : !! [tag] = optional, add a tag to the field
637 : !! [real_fmt] = override the default formatting
638 : !! [newline] = set to false to prevent adding newlines after fields
639 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
640 : !! [comment]: optional Yaml comment added after the value
641 : !!
642 : !! SOURCE
643 :
644 22810 : 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 11405 : length = size(arr)
663 :
664 11405 : ABI_DEFAULT(nl, newline, .true.)
665 11405 : ABI_DEFAULT(w, width, self%default_width)
666 11405 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
667 11405 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
668 :
669 11405 : if (present(tag)) then
670 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
671 : else
672 11405 : call yaml_start_field(self%stream, label, width=w)
673 : end if
674 :
675 11405 : call yaml_print_real1d(self%stream, length, arr, trim(rfmt), vmax)
676 11405 : if (present(comment)) call self%stream%push(' # '//trim(comment))
677 11405 : if (nl) call self%stream%push(eol)
678 :
679 11405 : end subroutine yamldoc_add_real1d
680 : !!***
681 :
682 : !!****f* m_yaml/yamldoc_add_int1d
683 : !! NAME
684 : !! yamldoc_add_int1d
685 : !!
686 : !! FUNCTION
687 : !! Add a field containing a 1D integer array
688 : !!
689 : !! INPUTS
690 : !! label = key name
691 : !! arr(:) <integer>=
692 : !! [multiline_trig] = optional minimum number of elements before switching to multiline representation
693 : !! [tag] : add a tag to the field
694 : !! int_fmt <character(len=*)>=optional override the default formatting
695 : !! [newline] = set to false to prevent adding newlines after fields
696 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
697 : !! [comment]: optional Yaml comment added after the value
698 : !!
699 : !! SOURCE
700 :
701 0 : 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 0 : ABI_DEFAULT(nl, newline, .true.)
720 0 : ABI_DEFAULT(w, width, self%default_width)
721 0 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
722 0 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
723 0 : length = size(arr)
724 :
725 0 : if (present(tag)) then
726 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
727 : else
728 0 : call yaml_start_field(self%stream, label, width=w)
729 : end if
730 :
731 0 : call yaml_print_int1d(self%stream, length, arr, trim(ifmt), vmax)
732 0 : if (present(comment)) call self%stream%push(' # '//trim(comment))
733 0 : if (nl) call self%stream%push(eol)
734 :
735 0 : end subroutine yamldoc_add_int1d
736 : !!***
737 :
738 : !!****f* m_yaml/yamldoc_add_dict
739 : !! NAME
740 : !! yamldoc_add_dict
741 : !!
742 : !! FUNCTION
743 : !! Add a field containing a dictionary/pair_list
744 : !!
745 : !! INPUTS
746 : !! label <character(len=*)>=
747 : !! pl <type(pair_list)>=
748 : !! string_size <integer>=optional maximum storage size for strings found in a pair_list
749 : !! key_size <integer>=optional maximum storage size for keys of a pair_list
750 : !! multiline_trig <integer>=optional minimum number of elements before switching to multiline representation
751 : !! tag <character(len=*)>=optional add a tag to the field
752 : !! key_fmt <character(len=*)>=optional override the default formatting
753 : !! int_fmt <character(len=*)>=optional override the default formatting
754 : !! real_fmt <character(len=*)>=optional override the default formatting
755 : !! string_fmt <character(len=*)>=optional override the default formatting
756 : !! newline <logical>=optional set to false to prevent adding newlines after fields
757 : !! width <integer>=optional impose a minimum width of the field name side of the column (padding with spaces)
758 : !! [comment]: optional Yaml comment added after the value
759 : !!
760 : !! OUTPUT
761 : !! pl <type(pair_list)>=
762 : !!
763 : !! SOURCE
764 :
765 108709 : 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 0 : ABI_DEFAULT(nl, newline, .true.)
785 108709 : ABI_DEFAULT(w, width, self%default_width)
786 108709 : ABI_DEFAULT(ks, key_size, self%default_keysize)
787 108709 : ABI_DEFAULT(ss, string_size, self%default_stringsize)
788 108709 : ABI_DEFAULT(kfmt, key_fmt, self%default_kfmt)
789 108709 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
790 108709 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
791 108709 : ABI_DEFAULT(sfmt, string_fmt, self%default_sfmt)
792 108709 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
793 :
794 108709 : if (present(tag)) then
795 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
796 : else
797 108709 : call yaml_start_field(self%stream, label, width=w)
798 : end if
799 :
800 108709 : call yaml_print_dict(self%stream, pl, ks, ss, trim(kfmt), trim(ifmt), trim(rfmt), trim(sfmt), vmax)
801 108709 : if (present(comment)) call self%stream%push(' # '//trim(comment))
802 108709 : if (nl) call self%stream%push(eol)
803 :
804 108709 : end subroutine yamldoc_add_dict
805 : !!***
806 :
807 : !!****f* m_yaml/yamldoc_add_real2d
808 : !! NAME
809 : !! yamldoc_add_real2d
810 : !!
811 : !! FUNCTION
812 : !! Add a field containing a 2D array of real numbers
813 : !!
814 : !! INPUTS
815 : !! label = key name
816 : !! arr(:, :) = input array.
817 : !! [slist(:)]= List of strings (same length as the first dim or second dime of arr, depending on mode).
818 : !! If present, the string will be included in the the row.
819 : !! [tag]= add a tag to the field
820 : !! [real_fmt]= override the default formatting
821 : !! [multiline_trig]: optional minimum number of elements before switching to multiline representation
822 : !! [newline]: set to false to prevent adding newlines after fields
823 : !! [width]: impose a minimum width of the field name side of the column (padding with spaces)
824 : !! [mode]: "T" to write the transpose of arr i.e columns become rows in output (DEFAULT), "N" for normal order
825 : !! [comment]: optional Yaml comment added after the key.
826 : !!
827 : !! SOURCE
828 :
829 20777 : 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 41554 : 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 20777 : m = size(arr, dim=1)
852 20777 : n = size(arr, dim=2)
853 :
854 20777 : ABI_DEFAULT(nl, newline, .true.)
855 20777 : ABI_DEFAULT(w, width, self%default_width)
856 20777 : ABI_DEFAULT(my_mode, mode, "T")
857 20777 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
858 20777 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
859 :
860 20777 : if (present(tag)) then
861 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
862 : else
863 20777 : call yaml_start_field(self%stream, label, width=w)
864 : end if
865 20777 : if (present(comment)) call self%stream%push(' # '//trim(comment))
866 :
867 20777 : if (my_mode == "T") then
868 81531 : do i=1,n
869 60754 : call self%stream%push(eol//'-')
870 243016 : line(1:m) = arr(:,i)
871 81531 : if (.not. present(slist)) then
872 45357 : call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
873 : else
874 15397 : call yaml_print_real1d(self%stream, m, line, rfmt, vmax, string=trim(slist(i)))
875 : end if
876 : end do
877 : else
878 0 : do i=1,m
879 0 : call self%stream%push(eol//'-')
880 0 : line(1:n) = arr(i,:)
881 0 : if (.not. present(slist)) then
882 0 : call yaml_print_real1d(self%stream, n, line, rfmt, vmax)
883 : else
884 0 : 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 20777 : if (nl) call self%stream%push(eol)
890 :
891 20777 : end subroutine yamldoc_add_real2d
892 : !!***
893 :
894 : !!****f* m_yaml/yamldoc_add_paired_real2d
895 : !! NAME
896 : !! yamldoc_add_paired_real2d
897 : !!
898 : !! FUNCTION
899 : !! Add a field containing two 2D real arrays with the same shape.
900 : !!
901 : !! Example:
902 : !! cartesian_forces_and_xred:
903 : !! - [ [ -0.0000E+00, -0.0000E+00, -0.0000E+00, ], [ 0.0000E+00, 0.0000E+00, 0.0000E+00, ] ]
904 : !! - [ [ -0.0000E+00, -0.0000E+00, -0.0000E+00, ], [ 2.5000E-01, 2.5000E-01, 2.5000E-01, ] ]
905 : !!
906 : !! INPUTS
907 : !! label = key name
908 : !! arr1(:,:), arr2(:,:) = input arrays.
909 : !! [slist(:)]= List of strings (same length as the first dim or second dime of arr, depending on mode).
910 : !! If present, the string will be included in the the row.
911 : !! [tag]= add a tag to the field
912 : !! [real_fmt]= override the default formatting
913 : !! [multiline_trig]: optional minimum number of elements before switching to multiline representation
914 : !! [newline]: set to false to prevent adding newlines after fields
915 : !! [width]: impose a minimum width of the field name side of the column (padding with spaces)
916 : !! [mode]: "T" to write the transpose of arr i.e columns become rows in output (DEFAULT), "N" for normal order
917 : !! [comment]: optional Yaml comment added after the key
918 : !!
919 : !! SOURCE
920 :
921 0 : 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 0 : 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 0 : m = size(arr1, dim=1)
945 0 : n = size(arr1, dim=2)
946 :
947 0 : ABI_CHECK(all(shape(arr1) == shape(arr2)), "arr1 and arr2 must have same shape")
948 :
949 0 : ABI_DEFAULT(nl, newline, .true.)
950 0 : ABI_DEFAULT(w, width, self%default_width)
951 0 : ABI_DEFAULT(my_mode, mode, "T")
952 0 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
953 0 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
954 :
955 0 : if (present(tag)) then
956 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
957 : else
958 0 : call yaml_start_field(self%stream, label, width=w)
959 : end if
960 0 : if (present(comment)) call self%stream%push(' # '//trim(comment))
961 :
962 0 : if (my_mode == "T") then
963 0 : if (present(slist)) then
964 0 : ABI_CHECK(size(slist) == n, "size(slist) != n")
965 : end if
966 0 : do i=1,n
967 0 : call self%stream%push(eol//'- [')
968 0 : line(1:m) = arr1(:,i)
969 0 : call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
970 0 : call self%stream%push(',')
971 0 : line(1:m) = arr2(:,i)
972 0 : call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
973 0 : if (present(slist)) call self%stream%push(', '//trim(slist(i)))
974 0 : call self%stream%push(' ]')
975 : end do
976 : else
977 0 : if (present(slist)) then
978 0 : ABI_CHECK(size(slist) == n, "size(slist) != m")
979 : end if
980 0 : do i=1,m
981 0 : call self%stream%push(eol//'- [')
982 0 : line(1:n) = arr1(i,:)
983 0 : call yaml_print_real1d(self%stream, n, line, rfmt, vmax)
984 0 : call self%stream%push(',')
985 0 : line(1:n) = arr2(i,:)
986 0 : call yaml_print_real1d(self%stream, n, line, rfmt, vmax)
987 0 : if (present(slist)) call self%stream%push(', '//trim(slist(i)))
988 0 : call self%stream%push(']')
989 : end do
990 : end if
991 :
992 0 : if (nl) call self%stream%push(eol)
993 :
994 0 : end subroutine yamldoc_add_paired_real2d
995 : !!***
996 :
997 : !!****f* m_yaml/yamldoc_add_int2d
998 : !! NAME
999 : !! yamldoc_add_int2d
1000 : !!
1001 : !! FUNCTION
1002 : !! Add a field containing a 2D integer array
1003 : !!
1004 : !! INPUTS
1005 : !! label = key name
1006 : !! arr(:, :) <integer>=
1007 : !! [slist(:)]= List of strings (same length as the first dim or second dime of arr, depending on mode).
1008 : !! If present, the string will be included in the the row.
1009 : !! [tag]= add a tag to the field
1010 : !! [int_fmt]: override the default formatting
1011 : !! multiline_trig <integer>=optional minimum number of elements before switching to multiline representation
1012 : !! [newline] = set to false to prevent adding newlines after fields
1013 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
1014 : !! [mode] = "T" to write the transpose of arr i.e columns become rows in output (DEFAULT), "N" for normal order
1015 : !! [comment]: optional Yaml comment added after the key.
1016 : !!
1017 : !! SOURCE
1018 :
1019 0 : 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 0 : 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 0 : m = size(arr, dim=1)
1042 0 : n = size(arr, dim=2)
1043 :
1044 0 : ABI_DEFAULT(nl, newline, .true.)
1045 0 : ABI_DEFAULT(w, width, self%default_width)
1046 0 : ABI_DEFAULT(my_mode, mode, "T")
1047 0 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
1048 0 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1049 :
1050 0 : if (present(tag)) then
1051 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
1052 : else
1053 0 : call yaml_start_field(self%stream, label, width=w)
1054 : end if
1055 0 : if (present(comment)) call self%stream%push(' # '//trim(comment))
1056 :
1057 0 : if (my_mode == "T") then
1058 0 : do i=1,n
1059 0 : call self%stream%push(eol//'-')
1060 0 : line(1:m) = arr(:,i)
1061 0 : if (.not. present(slist)) then
1062 0 : call yaml_print_int1d(self%stream, m, line, ifmt, vmax)
1063 : else
1064 0 : call yaml_print_int1d(self%stream, m, line, ifmt, vmax, string=slist(i))
1065 : end if
1066 : end do
1067 : else
1068 0 : do i=1,m
1069 0 : call self%stream%push(eol//'-')
1070 0 : line(1:n) = arr(i,:)
1071 0 : if (.not. present(slist)) then
1072 0 : call yaml_print_int1d(self%stream, n, line, ifmt, vmax)
1073 : else
1074 0 : call yaml_print_int1d(self%stream, n, line, ifmt, vmax, string=slist(i))
1075 : end if
1076 : end do
1077 : end if
1078 :
1079 0 : if (nl) call self%stream%push(eol)
1080 :
1081 0 : end subroutine yamldoc_add_int2d
1082 : !!***
1083 :
1084 : !!****f* m_yaml/yamldoc_add_dictlist
1085 : !! NAME
1086 : !! yamldoc_add_dictlist
1087 : !!
1088 : !! FUNCTION
1089 : !! Add a field containing a list of dictionaries/array of pair_list
1090 : !!
1091 : !! INPUTS
1092 : !! label = key name
1093 : !! n <integer>=
1094 : !! plarr(n) <type(pair_list)>=
1095 : !! key_size <integer>=optional maximum storage size for keys of a pair_list
1096 : !! string_size <integer>=optional maximum storage size for strings of a pair_list
1097 : !! multiline_trig <integer>=optional minimum number of elements before switching to multiline representation
1098 : !! [tag]= add a tag to the field
1099 : !! key_fmt <character(len=*)>=optional override the default formatting
1100 : !! int_fmt <character(len=*)>=optional override the default formatting
1101 : !! real_fmt <character(len=*)>=optional override the default formatting
1102 : !! string_fmt <character(len=*)>=optional override the default formatting
1103 : !! [newline] = set to false to prevent adding newlines after fields
1104 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
1105 : !!
1106 : !! SOURCE
1107 :
1108 0 : 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 0 : ABI_DEFAULT(nl, newline, .true.)
1130 0 : ABI_DEFAULT(w, width, self%default_width)
1131 0 : ABI_DEFAULT(kfmt, key_fmt, self%default_kfmt)
1132 0 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
1133 0 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
1134 0 : ABI_DEFAULT(sfmt, string_fmt, self%default_sfmt)
1135 0 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1136 0 : ABI_DEFAULT(ks, key_size, self%default_keysize)
1137 0 : ABI_DEFAULT(ss, string_size, self%default_keysize)
1138 :
1139 0 : if (present(tag)) then
1140 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
1141 : else
1142 0 : call yaml_start_field(self%stream, label, width=w)
1143 : end if
1144 0 : call self%stream%push(eol)
1145 :
1146 0 : do i=1,n
1147 0 : call self%stream%push('- ')
1148 0 : call yaml_print_dict(self%stream, plarr(i), ks, ss, trim(kfmt), trim(ifmt), trim(rfmt), trim(sfmt), vmax)
1149 0 : if (nl .or. i /= n) call self%stream%push(eol)
1150 : end do
1151 :
1152 0 : end subroutine yamldoc_add_dictlist
1153 : !!***
1154 :
1155 : !!****f* m_yaml/yamldoc_open_tabular
1156 : !! NAME
1157 : !! yamldoc_open_tabular
1158 : !!
1159 : !! FUNCTION
1160 : !! Open a field for tabular data
1161 : !!
1162 : !! INPUTS
1163 : !! label = key name
1164 : !! [tag] <character(len=*)>=optional add a tag to the field
1165 : !! [newline] = set to false to prevent adding newlines after fields
1166 : !! [indent] = optional number of spaces to add to the header
1167 : !! [comment]: optional Yaml comment added after the value
1168 : !!
1169 : !! SOURCE
1170 :
1171 1158 : 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 1158 : ABI_DEFAULT(nl, newline, .true.)
1187 1158 : ABI_DEFAULT(n, indent, 4)
1188 :
1189 0 : if (n > 4) then
1190 0 : call self%stream%push(repeat(' ', n-4))
1191 : end if
1192 :
1193 1158 : if (present(tag)) then
1194 505 : call yaml_start_field(self%stream, label, tag=tag)
1195 : else
1196 653 : call yaml_start_field(self%stream, label, tag='Tabular')
1197 : end if
1198 :
1199 1158 : if (present(comment)) then
1200 0 : call self%stream%push(' | # '//trim(comment)//eol)
1201 : else
1202 1158 : call self%stream%push(' |'//eol)
1203 : end if
1204 :
1205 1158 : end subroutine yamldoc_open_tabular
1206 : !!***
1207 :
1208 : !!****f* m_yaml/yamldoc_add_tabular_line
1209 : !! NAME
1210 : !! yamldoc_add_tabular_line
1211 : !!
1212 : !! FUNCTION
1213 : !! Add a line of tabular data in an already opened table field
1214 : !!
1215 : !! INPUTS
1216 : !! line <character(len=*)>=
1217 : !! [newline] = set to false to prevent adding newlines after fields
1218 : !! [indent] = optional number of spaces to add to the header
1219 : !!
1220 : !! SOURCE
1221 :
1222 7377 : 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 7377 : ABI_DEFAULT(nl, newline, .true.)
1236 7377 : ABI_DEFAULT(n, indent, 4)
1237 :
1238 28249 : call self%stream%push(repeat(' ', n)//trim(line))
1239 7377 : if (nl) call self%stream%push(eol)
1240 :
1241 7377 : end subroutine yamldoc_add_tabular_line
1242 : !!***
1243 :
1244 : !!****f* m_yaml/yamldoc_add_tabular
1245 : !! NAME
1246 : !! yamldoc_add_tabular
1247 : !!
1248 : !! FUNCTION
1249 : !! Add a field with a complete table data
1250 : !!
1251 : !! INPUTS
1252 : !! label <character(len=*)>=
1253 : !! input <type(stream_string)>=stream containing an already built table
1254 : !! tag <character(len=*)>=optional add a tag to the field
1255 : !! newline <logical>=optional set to false to prevent adding newlines after fields
1256 : !! indent <integer>=optional number of spaces to add to each line
1257 : !!
1258 : !! SOURCE
1259 :
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
1288 : !!***
1289 :
1290 : !!****f* m_yaml/yaml_single_dict
1291 : !! NAME
1292 : !! yaml_single_dict
1293 : !!
1294 : !! FUNCTION
1295 : !! Create a full document from a single dictionary
1296 : !!
1297 : !! INPUTS
1298 : !! unit
1299 : !! tag <character(len=*)>=
1300 : !! comment <character(len=*)>=
1301 : !! pl <type(pair_list)>=
1302 : !! key_size <integer>=maximum storage size for the keys of pl
1303 : !! string_size <integer>=maximum storage size for the strings found in pl
1304 : !! tag <character(len=*)>=optional add a tag to the field
1305 : !! int_fmt <character(len=*)>=optional override the default formatting
1306 : !! real_fmt <character(len=*)>=optional override the default formatting
1307 : !! string_fmt <character(len=*)>=optional override the default formatting
1308 : !! width <integer>=optional impose a minimum width of the field name side of the column (padding with spaces)
1309 : !! newline <logical>=optional set to false to prevent adding newlines after fields
1310 : !!
1311 : !! OUTPUT
1312 : !! pl <type(pair_list)>=
1313 : !!
1314 : !! SOURCE
1315 :
1316 0 : 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 0 : character(len=string_size) :: vs, tmp_s
1333 0 : 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 0 : ABI_DEFAULT(nl, newline, .true.)
1341 0 : ABI_DEFAULT(rfmt, real_fmt, doc%default_rfmt)
1342 0 : ABI_DEFAULT(ifmt, int_fmt, doc%default_ifmt)
1343 0 : ABI_DEFAULT(sfmt, string_fmt, doc%default_sfmt)
1344 0 : ABI_DEFAULT(w, width, doc%default_width)
1345 :
1346 0 : call doc%stream%push('--- !'//tag)
1347 :
1348 0 : if (comment /= '') then
1349 0 : call doc%stream%push(eol)
1350 0 : call yaml_start_field(doc%stream, 'comment', width=w)
1351 0 : call yaml_print_string(doc%stream, comment)
1352 : end if
1353 0 : call doc%stream%push(eol)
1354 :
1355 0 : call pl%restart()
1356 0 : do k=1,pl%length()
1357 0 : call string_clear(key)
1358 0 : call string_clear(vs)
1359 0 : call pl%iter(key, type_code, vi, vr, vs)
1360 :
1361 0 : call yaml_start_field(doc%stream, trim(key), width=w)
1362 0 : call doc%stream%push(' ')
1363 0 : if (type_code == TC_INT) then
1364 0 : call string_clear(tmp_i)
1365 0 : write(tmp_i, ifmt) vi
1366 0 : call doc%stream%push(trim(tmp_i))
1367 0 : else if (type_code == TC_REAL) then
1368 0 : call string_clear(tmp_r)
1369 0 : call format_real(vr, tmp_r, rfmt)
1370 0 : call doc%stream%push(trim(tmp_r))
1371 0 : else if (type_code == TC_STRING) then
1372 0 : call string_clear(tmp_s)
1373 0 : write(tmp_s, sfmt) vs
1374 0 : call yaml_print_string(doc%stream, trim(tmp_s))
1375 : end if
1376 0 : call doc%stream%push(eol)
1377 : end do
1378 :
1379 0 : call doc%write_and_free(unit, newline=nl)
1380 :
1381 0 : end subroutine yaml_single_dict
1382 : !!***
1383 :
1384 : !!****f* m_yaml/yaml_write_dict
1385 : !! NAME
1386 : !! yaml_write_dict
1387 : !!
1388 : !! FUNCTION
1389 : !! Write a dictionary in a Yaml document.
1390 : !!
1391 : !! INPUTS
1392 : !! tag: Yaml tag
1393 : !! dict_name: Dictionary name
1394 : !! dict: Dictionary
1395 : !! unit: Unit numver
1396 : !! [with_iter_state]: True if dict with iteration state should be added. Default: False
1397 : !!
1398 : !! SOURCE
1399 :
1400 0 : 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 0 : with_iter_state_ = .False.; if (present(with_iter_state)) with_iter_state_ = with_iter_state
1414 :
1415 0 : ydoc = yamldoc_open(tag, with_iter_state=with_iter_state_)
1416 0 : call ydoc%add_dict(dict_name, dict)
1417 0 : call ydoc%write_and_free(unit)
1418 :
1419 0 : end subroutine yaml_write_dict
1420 : !!***
1421 :
1422 : !!****f* m_yaml/yamldoc_write_unit_and_free
1423 : !! NAME
1424 : !! yamldoc_write_unit_and_free
1425 : !!
1426 : !! FUNCTION
1427 : !! Write Yaml document to unit and free memory.
1428 : !!
1429 : !! INPUTS
1430 : !! [newline]= set to False to prevent adding newlines after fields. Default: True
1431 : !! [firstchar]= Add first char to each line. Useful if the Yaml document must be added after shell comments
1432 : !! with firstchar="#".
1433 : !!
1434 : !! SOURCE
1435 :
1436 26947 : 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 26947 : if (self%stream%length == 0) return
1449 26944 : ABI_DEFAULT(nl, newline, .true.)
1450 :
1451 26944 : 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 26944 : if (is_open(unit)) then
1456 24291 : if (present(firstchar)) then
1457 5 : call self%stream%flush(unit, newline=nl, firstchar=firstchar)
1458 : else
1459 24286 : call self%stream%flush(unit, newline=nl)
1460 : end if
1461 : else
1462 2653 : call self%stream%free()
1463 : end if
1464 :
1465 : end subroutine yamldoc_write_unit_and_free
1466 : !!***
1467 :
1468 : !!****f* m_yaml/yamldoc_write_units_and_free
1469 : !! NAME
1470 : !! yamldoc_write_units_and_free
1471 : !!
1472 : !! FUNCTION
1473 : !! Write Yaml document to a list of units and free memory.
1474 : !!
1475 : !! INPUTS
1476 : !! units=List of unit numbers.
1477 : !! [newline]= set to false to prevent adding newlines after fields. Default: True
1478 : !!
1479 : !! SOURCE
1480 :
1481 36594 : subroutine yamldoc_write_units_and_free(self, units, newline)
1482 :
1483 : !Arguments ------------------------------------
1484 : class(yamldoc_t),intent(inout) :: self
1485 : integer,intent(in) :: units(:)
1486 : logical,intent(in),optional :: newline
1487 :
1488 : !Local variables-------------------------------
1489 : integer :: ii, cnt
1490 : logical :: nl
1491 : !arrays
1492 36594 : integer :: my_units(size(units))
1493 : ! *************************************************************************
1494 :
1495 36594 : if (self%stream%length == 0) return
1496 36594 : ABI_DEFAULT(nl, newline, .true.)
1497 :
1498 : ! Remove duplicated units (if any)
1499 : ! FIXME: In principle, we should not use is_open here but it seems that
1500 : ! ab_out is not set to dev_null if parallelism over images.
1501 36594 : my_units(1) = units(1); cnt = 1
1502 36597 : do ii=2,size(units)
1503 6 : if (any(units(ii) == my_units(1:cnt))) cycle
1504 36597 : if (is_open(units(ii))) then
1505 3 : cnt = cnt + 1
1506 3 : my_units(cnt) = units(ii)
1507 : end if
1508 : end do
1509 :
1510 36594 : call self%stream%push('...')
1511 36594 : call self%stream%flush_units(my_units, newline=nl)
1512 :
1513 : end subroutine yamldoc_write_units_and_free
1514 : !!***
1515 :
1516 : !!****f* m_yaml/yamldoc_set_keys_to_string
1517 : !! NAME
1518 : !! yamldoc_set_keys_to_string
1519 : !!
1520 : !! FUNCTION
1521 : !! Set all keys to a common (string) value
1522 : !!
1523 : !! INPUTS
1524 : !! keylist = List of comma-separated keywords
1525 : !! svalue = String Value
1526 : !! [width] = impose a minimum width of the field name side of the column (padding with spaces)
1527 : !! [dict_key]=If present, a dictionary with key `dict_key` is created instead of a list.
1528 : !! [multiline_trig] = optional minimum number of elements before switching to multiline representation
1529 : !!
1530 : !! SOURCE
1531 :
1532 1124 : subroutine yamldoc_set_keys_to_string(self, keylist, svalue, dict_key, width, multiline_trig)
1533 :
1534 : !Arguments ------------------------------------
1535 : class(yamldoc_t),intent(inout) :: self
1536 : character(len=*),intent(in) :: keylist, svalue
1537 : character(len=*),intent(in),optional :: dict_key
1538 : integer,intent(in),optional :: width, multiline_trig
1539 :
1540 : !Local variables-------------------------------
1541 : integer :: i, n, w, start, stp, vmax
1542 : type(pair_list) :: dict
1543 :
1544 : ! *************************************************************************
1545 :
1546 0 : ABI_DEFAULT(w, width, self%default_width)
1547 :
1548 1124 : n = char_count(keylist, ",") + 1
1549 1124 : start = 1
1550 :
1551 1124 : if (.not. present(dict_key)) then
1552 1581 : do i=1,n
1553 1054 : stp = index(keylist(start:), ",")
1554 1581 : if (stp == 0) then
1555 527 : call self%add_string(adjustl(keylist(start:)), svalue, width=w)
1556 : else
1557 527 : call self%add_string(adjustl(keylist(start: start + stp - 2)), svalue, width=w)
1558 527 : start = start + stp
1559 527 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
1560 : end if
1561 : end do
1562 :
1563 : else
1564 : ! Create and insert dictionary.
1565 2453 : do i=1,n
1566 1856 : stp = index(keylist(start:), ",")
1567 2453 : if (stp == 0) then
1568 597 : call dict%set(adjustl(keylist(start:)), s=svalue)
1569 : else
1570 1259 : call dict%set(adjustl(keylist(start: start + stp - 2)), s=svalue)
1571 1259 : start = start + stp
1572 1259 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
1573 : end if
1574 : end do
1575 597 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1576 597 : call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, width=w)
1577 597 : call dict%free()
1578 : end if
1579 :
1580 1124 : end subroutine yamldoc_set_keys_to_string
1581 : !!***
1582 :
1583 : ! private
1584 464652 : subroutine string_clear(string)
1585 : character(len=*),intent(inout) :: string
1586 36848402 : string = repeat(' ', len(string))
1587 464652 : end subroutine string_clear
1588 :
1589 567232 : subroutine format_real(val, dest, formt)
1590 : real(dp),intent(in) :: val
1591 : character(len=*),intent(out) :: dest
1592 : character(len=*),intent(in) :: formt
1593 :
1594 : !#ifdef HAVE_FC_IEEE_ARITHMETIC
1595 : ! if (ieee_is_nan(val)) then ! NaN
1596 : ! write(dest, '(a)') '.nan'
1597 : ! else if (val == MAGIC_UNDEF) then
1598 : !#else
1599 : ! if (val == MAGIC_UNDEF) then
1600 : !#endif
1601 567232 : if (val == MAGIC_UNDEF) then
1602 2760 : write(dest, '(a)') 'null'
1603 : else
1604 564472 : write(dest, trim(formt)) val
1605 : end if
1606 :
1607 567232 : end subroutine format_real
1608 :
1609 : !subroutine write_indent(input, output, n)
1610 : ! class(stream_string),intent(inout) :: input, output
1611 : ! integer,intent(in) :: n
1612 : !
1613 : ! integer :: buffstart, buffstop, length
1614 : ! character(len=chunk_size) :: buffer
1615 : !
1616 : ! do while (input%length > 0)
1617 : ! length = input%length
1618 : ! call input%pop_chunk(buffer)
1619 : !
1620 : ! buffstart = 1
1621 : ! buffstop = 1
1622 : ! do while (buffstart < min(length, chunk_size))
1623 : ! buffstop = index(buffer(buffstart:), eol)
1624 : ! if (buffstop > 0) then
1625 : ! call output%push(buffer(buffstart:buffstop))
1626 : ! call output%push(repeat(' ', n))
1627 : ! buffstart = buffstop+1
1628 : ! else if (buffstart < min(length, chunk_size)) then
1629 : ! call output%push(buffer(buffstart:min(length, chunk_size)))
1630 : ! buffstart = chunk_size
1631 : ! end if
1632 : ! end do
1633 : ! end do
1634 : !end subroutine write_indent
1635 :
1636 784017 : subroutine forbid_reserved_label(label)
1637 : character(len=*),intent(in) :: label
1638 : integer :: i
1639 :
1640 8624187 : do i=1,size(reserved_keywords)
1641 8624187 : if (reserved_keywords(i) == label) then
1642 0 : ABI_ERROR(trim(label)//' is a reserved keyword and cannot be used as a YAML label.')
1643 : end if
1644 : end do
1645 784017 : end subroutine forbid_reserved_label
1646 :
1647 588638 : pure function yaml_quote_string(string) result(quoted)
1648 :
1649 : character(len=*),intent(in) :: string
1650 : character(len=len(string)+2) :: quoted
1651 : logical :: multiline, spec_char, quote
1652 588638 : spec_char = index(string, ':', back=.true.) /= 0
1653 588638 : spec_char = spec_char .or. index(string, '{') /= 0
1654 588638 : spec_char = spec_char .or. index(string, '}') /= 0
1655 588638 : spec_char = spec_char .or. index(string, '[') /= 0
1656 588638 : spec_char = spec_char .or. index(string, ']') /= 0
1657 588638 : spec_char = spec_char .or. index(string, ',') /= 0
1658 588144 : spec_char = spec_char .or. index(string, '&') /= 0
1659 588144 : spec_char = spec_char .or. index(string, '*') /= 0
1660 586401 : spec_char = spec_char .or. index(string, '#') /= 0
1661 586401 : spec_char = spec_char .or. index(string, '?') /= 0
1662 586401 : spec_char = spec_char .or. index(string, '|') /= 0
1663 586401 : spec_char = spec_char .or. index(string, '-') /= 0
1664 584596 : spec_char = spec_char .or. index(string, '<') /= 0
1665 584596 : spec_char = spec_char .or. index(string, '>') /= 0
1666 584596 : spec_char = spec_char .or. index(string, '=') /= 0
1667 584596 : spec_char = spec_char .or. index(string, '!') /= 0
1668 584596 : spec_char = spec_char .or. index(string, '%') /= 0
1669 584596 : spec_char = spec_char .or. index(string, '@') /= 0
1670 584596 : spec_char = spec_char .or. index(string, '`') /= 0
1671 :
1672 588638 : quote = index(string, "'") /= 0
1673 588638 : multiline = index(string, eol, back=.true.) /= 0
1674 :
1675 588638 : if (quote) then
1676 0 : quoted='"'//string//'"'
1677 588638 : else if (multiline .or. spec_char) then
1678 4042 : quoted="'"//string//"'"
1679 : else
1680 584596 : quoted=string
1681 : endif
1682 588638 : end function yaml_quote_string
1683 :
1684 535842 : subroutine yaml_start_field(stream, label, tag, width)
1685 :
1686 : type(stream_string),intent(inout) :: stream
1687 : character(len=*),intent(in) :: label
1688 : integer,optional,intent(in) :: width
1689 : character(len=*),intent(in),optional :: tag
1690 : !character(len=*),optional,intent(in) :: comment
1691 :
1692 535842 : character(len=len_trim(label)+2) :: quoted
1693 :
1694 : !#ifdef HAVE_DEBUG_MODE
1695 535842 : call forbid_reserved_label(trim(label))
1696 : !#endif
1697 :
1698 535842 : quoted = yaml_quote_string(label)
1699 535842 : if (present(width)) then
1700 534684 : if (width > len_trim(label)) then
1701 891155 : call stream%push(trim(quoted)//repeat(' ', width-len_trim(quoted))//':')
1702 : else
1703 436144 : call stream%push(trim(quoted)//':')
1704 : end if
1705 : else
1706 1158 : call stream%push(trim(quoted)//':')
1707 : end if
1708 535842 : if (present(tag)) call stream%push(' !'//trim(tag))
1709 : !if (present(comment)) call stream%push(' #'//trim(comment))
1710 :
1711 535842 : end subroutine yaml_start_field
1712 :
1713 72159 : subroutine yaml_print_real1d(stream, length, arr, rfmt, vmax, string)
1714 :
1715 : !Arguments ------------------------------------
1716 : type(stream_string),intent(inout) :: stream
1717 : integer,intent(in) :: vmax, length
1718 : real(dp),intent(in) :: arr(length)
1719 : character(len=*),intent(in) :: rfmt
1720 : character(len=*),optional,intent(in) :: string
1721 :
1722 : !Local variables-------------------------------
1723 : integer :: i
1724 : character(len=50) :: tmp_r
1725 : ! *************************************************************************
1726 :
1727 72159 : if (length > vmax) then
1728 0 : call stream%push(' ['//eol//' ')
1729 : else
1730 72159 : call stream%push(' [')
1731 : end if
1732 :
1733 288636 : do i=1,length
1734 216477 : call string_clear(tmp_r)
1735 216477 : call format_real(arr(i), tmp_r, rfmt)
1736 216477 : call stream%push(trim(tmp_r))
1737 288636 : if (i > 0 .and. mod(i, vmax) == 0 .and. i /= length) then
1738 0 : call stream%push(', '//eol//' ')
1739 : else
1740 216477 : call stream%push(', ')
1741 : end if
1742 : end do
1743 :
1744 72159 : if (length > vmax) call stream%push(eol)
1745 72159 : if (present(string)) call stream%push(trim(string))
1746 72159 : call stream%push(']')
1747 :
1748 72159 : end subroutine yaml_print_real1d
1749 :
1750 0 : subroutine yaml_print_int1d(stream, length, arr, ifmt, vmax, string)
1751 :
1752 : !Arguments ------------------------------------
1753 : type(stream_string),intent(inout) :: stream
1754 : integer,intent(in) :: vmax
1755 : integer,intent(in) :: length
1756 : integer,intent(in) :: arr(length)
1757 : character(len=*),intent(in) :: ifmt
1758 : character(len=*),optional,intent(in) :: string
1759 :
1760 : !Local variables-------------------------------
1761 : integer :: i
1762 : character(len=50) :: tmp_i
1763 : ! *************************************************************************
1764 :
1765 0 : if (length > vmax) then
1766 0 : call stream%push(' ['//eol//' ')
1767 : else
1768 0 : call stream%push(' [')
1769 : end if
1770 :
1771 0 : do i=1,length
1772 0 : call string_clear(tmp_i)
1773 0 : write(tmp_i, ifmt) arr(i)
1774 0 : call stream%push(trim(tmp_i))
1775 0 : if (i > 0 .and. mod(i, vmax) == 0 .and. i /= length) then
1776 0 : call stream%push(', '//eol//' ')
1777 : else
1778 0 : call stream%push(', ')
1779 : end if
1780 : end do
1781 :
1782 0 : if (length > vmax) call stream%push(eol)
1783 0 : if (present(string)) call stream%push(trim(string))
1784 0 : call stream%push(']')
1785 :
1786 0 : end subroutine yaml_print_int1d
1787 :
1788 108709 : subroutine yaml_print_dict(stream, pl, key_size, s_size, kfmt, ifmt, rfmt, sfmt, vmax)
1789 :
1790 : type(stream_string),intent(inout) :: stream
1791 : integer,intent(in) :: vmax
1792 : type(pair_list),intent(inout) :: pl
1793 : character(len=*),intent(in) :: ifmt, rfmt, kfmt, sfmt
1794 : integer,intent(in) :: key_size, s_size
1795 108709 : character(len=key_size) :: key
1796 108709 : character(len=key_size+5) :: tmp_key
1797 : character(len=100) :: tmp_r, tmp_i
1798 108709 : character(len=s_size) :: tmp_s
1799 :
1800 : integer :: i, vi, type_code
1801 : real(dp) :: vr
1802 108709 : character(len=s_size) :: vs
1803 :
1804 108709 : if (pl%length() > vmax) then
1805 0 : call stream%push(' {'//eol//' ')
1806 : else
1807 108709 : call stream%push(' {')
1808 : end if
1809 :
1810 108709 : call pl%restart()
1811 356884 : do i=1,pl%length()
1812 248175 : call pl%iter(key, type_code, vi, vr, vs)
1813 :
1814 : !#ifdef HAVE_DEBUG_MODE
1815 248175 : call forbid_reserved_label(trim(key))
1816 : !#endif
1817 :
1818 : ! TODO: Should enclose key in double quotation markers only if needed
1819 : !if has_whitespaces(key) then
1820 : ! call string_clear(tmp_key)
1821 : ! write(tmp_key, kfmt) '"'//trim(key)//'"'
1822 : !else
1823 : !end if
1824 248175 : write(tmp_key, kfmt) trim(key)
1825 :
1826 248175 : call stream%push(trim(tmp_key)//': ')
1827 :
1828 174811 : select case (type_code)
1829 : case (TC_INT)
1830 174811 : call string_clear(tmp_i)
1831 174811 : write(tmp_i, ifmt) vi
1832 174811 : call stream%push(trim(tmp_i))
1833 : case (TC_REAL)
1834 71508 : call string_clear(tmp_r)
1835 71508 : call format_real(vr, tmp_r, rfmt)
1836 71508 : call stream%push(trim(tmp_r))
1837 : case (TC_STRING)
1838 1856 : call string_clear(tmp_s)
1839 1856 : write(tmp_s, sfmt) vs
1840 1856 : call yaml_print_string(stream, trim(tmp_s))
1841 : case default
1842 248175 : ABI_ERROR(sjoin("Invalid type_code:", itoa(type_code)))
1843 : end select
1844 :
1845 356884 : if (i > 0 .and. mod(i, vmax) == 0 .and. i /= pl%length()) then
1846 0 : call stream%push(', '//eol//' ')
1847 : else
1848 248175 : call stream%push(', ')
1849 : end if
1850 : end do
1851 :
1852 108709 : if (pl%length() > vmax) call stream%push(eol)
1853 108709 : call stream%push('}')
1854 :
1855 108709 : end subroutine yaml_print_dict
1856 :
1857 52796 : subroutine yaml_print_string(stream, string)
1858 :
1859 : type(stream_string),intent(inout) :: stream
1860 : character(len=*),intent(in) :: string
1861 52796 : character(len=len_trim(string)+2) :: quoted
1862 :
1863 52796 : quoted = yaml_quote_string(string)
1864 52796 : call stream%push(trim(quoted))
1865 :
1866 52796 : end subroutine yaml_print_string
1867 :
1868 : !pure logical function has_whitespaces(string) result (ans)
1869 : !
1870 : ! character(len=*),intent(in) :: string
1871 : ! integer :: ii, jj
1872 : !
1873 : ! ans = .False.
1874 : ! do ii=len_trim(string), 1, -1
1875 : ! if (string(ii:ii) == " ") then
1876 : ! ans = .True.; exit
1877 : ! end if
1878 : ! end do
1879 : !
1880 : ! if (ans) then
1881 : ! do jj=1,ii-1
1882 : ! if (string(ii:ii) /= " ") exit
1883 : ! end do
1884 : ! if (jj == ii) ans = .False.
1885 : ! end do
1886 : !
1887 : !end function has_whitespaces
1888 :
1889 0 : end module m_yaml
1890 : !!***
|
