Branch data 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 : 22561 : 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 : 5336 : select case (label)
201 : : case ("dtset")
202 : 5336 : DTSET_IDX = val
203 : 5336 : TIMIMAGE_IDX = -1
204 : 5336 : IMAGE_IDX = -1
205 : 5336 : ITIME_IDX = -1
206 : 5336 : 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 [ + + ]: 22561 : 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 [ + + + + : 22561 : 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 : 64025 : 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 [ + + ]: 64025 : if (present(width)) new%default_width = width
267 [ - + - - ]: 64025 : if (present(int_fmt)) new%default_ifmt = int_fmt
268 [ + + + - ]: 64025 : if (present(real_fmt)) new%default_rfmt = real_fmt
269 : :
270 [ + - ]: 64025 : call new%stream%push(ch10//'---'//' !'//trim(tag)//ch10)
271 : :
272 [ + + ]: 64025 : with_iter_state_ = .True.; if (present(with_iter_state)) with_iter_state_ = with_iter_state
273 [ - + + + ]: 64025 : if (with_iter_state_ .and. DTSET_IDX /= -1) then
274 : : ! Write dictionary with iteration state.
275 : 63335 : call dict%set('dtset', i=DTSET_IDX)
276 [ + + ]: 63335 : if (TIMIMAGE_IDX /= -1) call dict%set("timimage", i=TIMIMAGE_IDX)
277 [ + + ]: 63335 : if (IMAGE_IDX /= -1) call dict%set("image", i=IMAGE_IDX)
278 [ + + ]: 63335 : if (ITIME_IDX /= -1) call dict%set("itime", i=ITIME_IDX)
279 [ + + ]: 63335 : if (ICYCLE_IDX /= -1) call dict%set("icycle", i=ICYCLE_IDX)
280 : 63335 : call new%add_dict('iteration_state', dict, int_fmt="(i0)")
281 : 63335 : call dict%free()
282 : : end if
283 : :
284 [ + + ]: 64025 : if (present(info)) then
285 [ + - ]: 12870 : if (len_trim(info) /= 0) then
286 : : ! TODO: Replace comment with info
287 : 12870 : call new%stream%push('comment')
288 [ + - + + ]: 125120 : if (new%default_width > 7) call new%stream%push(repeat(' ', new%default_width - 7))
289 : 12870 : call new%stream%push(': ')
290 : 12870 : call yaml_print_string(new%stream, info)
291 : 12870 : call new%stream%push(eol)
292 : : end if
293 : : end if
294 : :
295 [ - + ]: 64025 : if (nl) call new%stream%push(eol)
296 : :
297 [ - + ]: 64025 : 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 : 355142 : 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 : 355142 : if (present(ignore)) then
339 [ - + ]: 16544 : if (val == ignore) return
340 : : end if
341 : :
342 [ - + ]: 355142 : ABI_DEFAULT(nl, newline, .true.)
343 [ + + ]: 355142 : ABI_DEFAULT(w, width, self%default_width)
344 [ + + + + ]: 355142 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
345 : :
346 [ - + ]: 355142 : if (present(tag)) then
347 : 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
348 : : else
349 : 355142 : call yaml_start_field(self%stream, label, width=w)
350 : : end if
351 : :
352 : 355142 : call self%stream%push(' ')
353 [ + - ]: 355142 : call format_real(val, tmp_r, trim(rfmt))
354 [ + - ]: 355142 : call self%stream%push(trim(tmp_r))
355 : :
356 [ - + - - ]: 355142 : if (present(comment)) call self%stream%push(' # '//trim(comment))
357 [ + - ]: 355142 : if (nl) call self%stream%push(eol)
358 : :
359 [ + + ]: 355142 : 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 : 66966 : 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 [ + + + - ]: 33483 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
399 [ + + ]: 33483 : ABI_DEFAULT(my_ignore, ignore, MAGIC_IGNORE_REAL)
400 : :
401 : 33483 : n = char_count(keylist, ",") + 1
402 [ - + ]: 33483 : ABI_CHECK(size(values) == n, sjoin("size of values:", itoa(size(values)), " != len(tokens):", keylist))
403 : :
404 : 33483 : start = 1
405 : :
406 [ + + ]: 33483 : if (.not. present(dict_key)) then
407 [ + + ]: 22060 : do i=1,n
408 : 16544 : stp = index(keylist(start:), ",")
409 [ + + ]: 22060 : if (stp == 0) then
410 : 5516 : call self%add_real(adjustl(keylist(start:)), values(i), real_fmt=rfmt, width=w, ignore=my_ignore)
411 : : else
412 : 11028 : call self%add_real(adjustl(keylist(start: start + stp - 2)), values(i), real_fmt=rfmt, width=w, ignore=my_ignore)
413 : 11028 : start = start + stp
414 [ + - ]: 11028 : 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 [ + + ]: 143308 : do i=1,n
422 : 115341 : stp = index(keylist(start:), ",")
423 [ + + ]: 143308 : if (stp == 0) then
424 [ + + ]: 27967 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start:)), r=values(i))
425 : : else
426 [ + + ]: 87374 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start: start + stp - 2)), r=values(i))
427 : 87374 : start = start + stp
428 [ + - ]: 87374 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
429 : : end if
430 : : end do
431 [ - + ]: 27967 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
432 [ + - ]: 27967 : call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, real_fmt=rfmt, width=w)
433 : 27967 : call dict%free()
434 : : end if
435 : :
436 [ - + - + ]: 33483 : 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 : 113795 : 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 : 113795 : if (present(ignore)) then
478 [ - + ]: 2637 : if (val == ignore) return
479 : : end if
480 : :
481 [ - + ]: 113795 : ABI_DEFAULT(nl, newline, .true.)
482 [ + + ]: 113795 : ABI_DEFAULT(w, width, self%default_width)
483 [ + + + + ]: 113795 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
484 : :
485 [ - + ]: 113795 : if (present(tag)) then
486 : 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
487 : : else
488 : 113795 : call yaml_start_field(self%stream, label, width=w)
489 : : end if
490 : :
491 : 113795 : call self%stream%push(' ')
492 : 113795 : write(tmp_i, trim(ifmt)) val
493 [ + - ]: 113795 : call self%stream%push(trim(tmp_i))
494 : :
495 [ - + - - ]: 113795 : if (present(comment)) call self%stream%push(' # '//trim(comment))
496 [ + - ]: 113795 : if (nl) call self%stream%push(eol)
497 : :
498 [ + + ]: 113795 : 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 : 36430 : 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 [ - + - - ]: 18215 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
537 [ + + ]: 18215 : ABI_DEFAULT(my_ignore, ignore, MAGIC_IGNORE_INT)
538 : :
539 : 18215 : n = char_count(keylist, ",") + 1
540 [ - + ]: 18215 : ABI_CHECK(size(values) == n, sjoin("size of values:", itoa(size(values)), " != len(tokens):", keylist))
541 : :
542 : 18215 : start = 1
543 : :
544 [ + + ]: 18215 : 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 [ + + ]: 104592 : do i=1,n
560 : 87035 : stp = index(keylist(start:), ",")
561 [ + + ]: 104592 : if (stp == 0) then
562 [ + + ]: 17557 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start:)), i=values(i))
563 : : else
564 [ + + ]: 69478 : if (values(i) /= my_ignore) call dict%set(adjustl(keylist(start: start + stp - 2)), i=values(i))
565 : 69478 : start = start + stp
566 [ + - ]: 69478 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
567 : : end if
568 : : end do
569 : :
570 [ - + ]: 17557 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
571 [ + - ]: 17557 : call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, int_fmt=ifmt, width=w)
572 : 17557 : call dict%free()
573 : : end if
574 : :
575 [ - + - + ]: 18215 : 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 : 112212 : 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 [ - + ]: 112212 : ABI_DEFAULT(nl, newline, .true.)
610 [ + + ]: 112212 : ABI_DEFAULT(w, width, self%default_width)
611 : :
612 [ - + ]: 112212 : if (present(tag)) then
613 : 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
614 : : else
615 : 112212 : call yaml_start_field(self%stream, label, width=w)
616 : : end if
617 : :
618 : 112212 : call self%stream%push(' ')
619 [ + - ]: 112212 : call yaml_print_string(self%stream, trim(val))
620 [ + - ]: 112212 : if (nl) call self%stream%push(eol)
621 : :
622 : 112212 : 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 : 22948 : 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 : 11474 : length = size(arr)
663 : :
664 [ - + ]: 11474 : ABI_DEFAULT(nl, newline, .true.)
665 [ - + ]: 11474 : ABI_DEFAULT(w, width, self%default_width)
666 [ + + + - ]: 11474 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
667 [ - + ]: 11474 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
668 : :
669 [ - + ]: 11474 : if (present(tag)) then
670 : 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
671 : : else
672 : 11474 : call yaml_start_field(self%stream, label, width=w)
673 : : end if
674 : :
675 [ - + - - : 11474 : call yaml_print_real1d(self%stream, length, arr, trim(rfmt), vmax)
- - - + +
- ]
676 [ + + + - ]: 11474 : if (present(comment)) call self%stream%push(' # '//trim(comment))
677 [ + - ]: 11474 : if (nl) call self%stream%push(eol)
678 : :
679 [ - + ]: 11474 : 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 : 109531 : 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 [ + + ]: 109531 : ABI_DEFAULT(w, width, self%default_width)
786 [ - + ]: 109531 : ABI_DEFAULT(ks, key_size, self%default_keysize)
787 [ - + ]: 109531 : ABI_DEFAULT(ss, string_size, self%default_stringsize)
788 [ - + - - ]: 109531 : ABI_DEFAULT(kfmt, key_fmt, self%default_kfmt)
789 [ + + - + ]: 109531 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
790 [ + + + + ]: 109531 : ABI_DEFAULT(ifmt, int_fmt, self%default_ifmt)
791 [ - + - - ]: 109531 : ABI_DEFAULT(sfmt, string_fmt, self%default_sfmt)
792 [ + + ]: 109531 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
793 : :
794 [ - + ]: 109531 : if (present(tag)) then
795 : 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
796 : : else
797 : 109531 : call yaml_start_field(self%stream, label, width=w)
798 : : end if
799 : :
800 [ + - + - : 109531 : call yaml_print_dict(self%stream, pl, ks, ss, trim(kfmt), trim(ifmt), trim(rfmt), trim(sfmt), vmax)
+ - + - ]
801 [ - + - - ]: 109531 : if (present(comment)) call self%stream%push(' # '//trim(comment))
802 [ + - ]: 109531 : if (nl) call self%stream%push(eol)
803 : :
804 [ - + ]: 109531 : 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 [ + + + - : 20899 : 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 : 41798 : 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 : 20899 : m = size(arr, dim=1)
852 : 20899 : n = size(arr, dim=2)
853 : :
854 [ - + ]: 20899 : ABI_DEFAULT(nl, newline, .true.)
855 [ - + ]: 20899 : ABI_DEFAULT(w, width, self%default_width)
856 [ - + ]: 20899 : ABI_DEFAULT(my_mode, mode, "T")
857 [ + + + - ]: 20899 : ABI_DEFAULT(rfmt, real_fmt, self%default_rfmt)
858 [ - + ]: 20899 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
859 : :
860 [ - + ]: 20899 : if (present(tag)) then
861 : 0 : call yaml_start_field(self%stream, label, width=w, tag=tag)
862 : : else
863 : 20899 : call yaml_start_field(self%stream, label, width=w)
864 : : end if
865 [ + + + - ]: 20899 : if (present(comment)) call self%stream%push(' # '//trim(comment))
866 : :
867 [ - + ]: 20899 : if (my_mode == "T") then
868 [ + + ]: 81949 : do i=1,n
869 : 61050 : call self%stream%push(eol//'-')
870 [ + + ]: 244200 : line(1:m) = arr(:,i)
871 [ + + ]: 81949 : if (.not. present(slist)) then
872 : 45594 : call yaml_print_real1d(self%stream, m, line, rfmt, vmax)
873 : : else
874 [ + - ]: 15456 : 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 [ + - ]: 20899 : if (nl) call self%stream%push(eol)
890 : :
891 [ - + ]: 20899 : 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 : 1163 : 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 : 1163 : ABI_DEFAULT(nl, newline, .true.)
1187 [ - + ]: 1163 : 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 [ + + ]: 1163 : if (present(tag)) then
1194 : 510 : 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 [ - + ]: 1163 : if (present(comment)) then
1200 [ # # ]: 0 : call self%stream%push(' | # '//trim(comment)//eol)
1201 : : else
1202 : 1163 : call self%stream%push(' |'//eol)
1203 : : end if
1204 : :
1205 : 1163 : 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 : 7396 : 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 [ - + ]: 7396 : ABI_DEFAULT(nl, newline, .true.)
1236 [ + + ]: 7396 : ABI_DEFAULT(n, indent, 4)
1237 : :
1238 [ - + + + : 28344 : call self%stream%push(repeat(' ', n)//trim(line))
+ - ]
1239 [ + - ]: 7396 : if (nl) call self%stream%push(eol)
1240 : :
1241 : 7396 : 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 : 27156 : 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 [ + + ]: 27156 : if (self%stream%length == 0) return
1449 [ + + ]: 27153 : ABI_DEFAULT(nl, newline, .true.)
1450 : :
1451 : 27153 : 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 [ + + ]: 27153 : if (is_open(unit)) then
1456 [ + + ]: 24479 : if (present(firstchar)) then
1457 : 5 : call self%stream%flush(unit, newline=nl, firstchar=firstchar)
1458 : : else
1459 : 24474 : call self%stream%flush(unit, newline=nl)
1460 : : end if
1461 : : else
1462 : 2674 : 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 [ - + ]: 36873 : 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 : 36873 : integer :: my_units(size(units))
1493 : : ! *************************************************************************
1494 : :
1495 [ - + ]: 36873 : if (self%stream%length == 0) return
1496 [ - + ]: 36873 : 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 : 36873 : my_units(1) = units(1); cnt = 1
1502 [ + + ]: 36876 : do ii=2,size(units)
1503 [ + + + - : 6 : if (any(units(ii) == my_units(1:cnt))) cycle
- + ]
1504 [ - + ]: 36876 : 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 : 36873 : call self%stream%push('...')
1511 : 36873 : 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 : 1132 : 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 : 1132 : n = char_count(keylist, ",") + 1
1549 : 1132 : start = 1
1550 : :
1551 [ + + ]: 1132 : if (.not. present(dict_key)) then
1552 [ + + ]: 1590 : do i=1,n
1553 : 1060 : stp = index(keylist(start:), ",")
1554 [ + + ]: 1590 : if (stp == 0) then
1555 : 530 : call self%add_string(adjustl(keylist(start:)), svalue, width=w)
1556 : : else
1557 : 530 : call self%add_string(adjustl(keylist(start: start + stp - 2)), svalue, width=w)
1558 : 530 : start = start + stp
1559 [ + - ]: 530 : 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 [ + + ]: 2475 : do i=1,n
1566 : 1873 : stp = index(keylist(start:), ",")
1567 [ + + ]: 2475 : if (stp == 0) then
1568 : 602 : call dict%set(adjustl(keylist(start:)), s=svalue)
1569 : : else
1570 : 1271 : call dict%set(adjustl(keylist(start: start + stp - 2)), s=svalue)
1571 : 1271 : start = start + stp
1572 [ + - ]: 1271 : ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
1573 : : end if
1574 : : end do
1575 [ - + ]: 602 : ABI_DEFAULT(vmax, multiline_trig, self%default_multiline_trig)
1576 [ + - ]: 602 : call self%add_dict(trim(dict_key), dict, multiline_trig=vmax, width=w)
1577 : 602 : call dict%free()
1578 : : end if
1579 : :
1580 [ - + ]: 1132 : end subroutine yamldoc_set_keys_to_string
1581 : : !!***
1582 : :
1583 : : ! private
1584 : 467455 : subroutine string_clear(string)
1585 : : character(len=*),intent(inout) :: string
1586 [ + + + - : 37083555 : string = repeat(' ', len(string))
- + ]
1587 [ - + ]: 467455 : end subroutine string_clear
1588 : :
1589 : 644744 : 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 [ + + ]: 644744 : if (val == MAGIC_UNDEF) then
1602 : 2770 : write(dest, '(a)') 'null'
1603 : : else
1604 : 641974 : write(dest, trim(formt)) val
1605 : : end if
1606 : :
1607 : 644744 : 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 : 974099 : subroutine forbid_reserved_label(label)
1637 : : character(len=*),intent(in) :: label
1638 : : integer :: i
1639 : :
1640 [ + + ]: 10715089 : do i=1,size(reserved_keywords)
1641 [ - + ]: 10715089 : 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 : 974099 : end subroutine forbid_reserved_label
1646 : :
1647 : 851171 : 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 : 851171 : spec_char = index(string, ':', back=.true.) /= 0
1653 [ + - ]: 851171 : spec_char = spec_char .or. index(string, '{') /= 0
1654 [ + - ]: 851171 : spec_char = spec_char .or. index(string, '}') /= 0
1655 [ + - ]: 851171 : spec_char = spec_char .or. index(string, '[') /= 0
1656 [ + - ]: 851171 : spec_char = spec_char .or. index(string, ']') /= 0
1657 [ + + ]: 851171 : spec_char = spec_char .or. index(string, ',') /= 0
1658 [ + - ]: 850653 : spec_char = spec_char .or. index(string, '&') /= 0
1659 [ + + ]: 850653 : spec_char = spec_char .or. index(string, '*') /= 0
1660 [ + - ]: 848904 : spec_char = spec_char .or. index(string, '#') /= 0
1661 [ + - ]: 848904 : spec_char = spec_char .or. index(string, '?') /= 0
1662 [ + - ]: 848904 : spec_char = spec_char .or. index(string, '|') /= 0
1663 [ + + ]: 848904 : spec_char = spec_char .or. index(string, '-') /= 0
1664 [ + - ]: 847074 : spec_char = spec_char .or. index(string, '<') /= 0
1665 [ + - ]: 847074 : spec_char = spec_char .or. index(string, '>') /= 0
1666 [ + - ]: 847074 : spec_char = spec_char .or. index(string, '=') /= 0
1667 [ + - ]: 847074 : spec_char = spec_char .or. index(string, '!') /= 0
1668 [ + - ]: 847074 : spec_char = spec_char .or. index(string, '%') /= 0
1669 [ + - ]: 847074 : spec_char = spec_char .or. index(string, '@') /= 0
1670 [ - + ]: 847074 : spec_char = spec_char .or. index(string, '`') /= 0
1671 : :
1672 : 851171 : quote = index(string, "'") /= 0
1673 : 851171 : multiline = index(string, eol, back=.true.) /= 0
1674 : :
1675 [ - + ]: 851171 : if (quote) then
1676 [ # # # # ]: 0 : quoted='"'//string//'"'
1677 [ + + ]: 851171 : else if (multiline .or. spec_char) then
1678 [ + - - + ]: 4097 : quoted="'"//string//"'"
1679 : : else
1680 [ + - + - ]: 847074 : quoted=string
1681 : : endif
1682 [ + - ]: 851171 : end function yaml_quote_string
1683 : :
1684 : 724216 : 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 : 724216 : character(len=len_trim(label)+2) :: quoted
1693 : :
1694 : : !#ifdef HAVE_DEBUG_MODE
1695 [ + - ]: 724216 : call forbid_reserved_label(trim(label))
1696 : : !#endif
1697 : :
1698 [ + - - + ]: 724216 : quoted = yaml_quote_string(label)
1699 [ + + ]: 724216 : if (present(width)) then
1700 [ + + ]: 723053 : if (width > len_trim(label)) then
1701 [ - + + + : 897868 : call stream%push(trim(quoted)//repeat(' ', width-len_trim(quoted))//':')
+ - ]
1702 : : else
1703 [ + - ]: 623719 : call stream%push(trim(quoted)//':')
1704 : : end if
1705 : : else
1706 [ + - ]: 1163 : call stream%push(trim(quoted)//':')
1707 : : end if
1708 [ + + + - ]: 724216 : if (present(tag)) call stream%push(' !'//trim(tag))
1709 : : !if (present(comment)) call stream%push(' #'//trim(comment))
1710 : :
1711 : 724216 : end subroutine yaml_start_field
1712 : :
1713 : 72524 : 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 [ - + ]: 72524 : if (length > vmax) then
1728 : 0 : call stream%push(' ['//eol//' ')
1729 : : else
1730 : 72524 : call stream%push(' [')
1731 : : end if
1732 : :
1733 [ + + ]: 290096 : do i=1,length
1734 : 217572 : call string_clear(tmp_r)
1735 : 217572 : call format_real(arr(i), tmp_r, rfmt)
1736 [ + - ]: 217572 : call stream%push(trim(tmp_r))
1737 [ - + - - ]: 290096 : if (i > 0 .and. mod(i, vmax) == 0 .and. i /= length) then
1738 : 0 : call stream%push(', '//eol//' ')
1739 : : else
1740 : 217572 : call stream%push(', ')
1741 : : end if
1742 : : end do
1743 : :
1744 [ - + ]: 72524 : if (length > vmax) call stream%push(eol)
1745 [ + + + - ]: 72524 : if (present(string)) call stream%push(trim(string))
1746 : 72524 : call stream%push(']')
1747 : :
1748 : 72524 : 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 : 109531 : 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 : 109531 : character(len=key_size) :: key
1796 : 109531 : character(len=key_size+5) :: tmp_key
1797 : : character(len=100) :: tmp_r, tmp_i
1798 : 109531 : character(len=s_size) :: tmp_s
1799 : :
1800 : : integer :: i, vi, type_code
1801 : : real(dp) :: vr
1802 : 109531 : character(len=s_size) :: vs
1803 : :
1804 [ - + ]: 109531 : if (pl%length() > vmax) then
1805 : 0 : call stream%push(' {'//eol//' ')
1806 : : else
1807 : 109531 : call stream%push(' {')
1808 : : end if
1809 : :
1810 : 109531 : call pl%restart()
1811 [ + + ]: 359414 : do i=1,pl%length()
1812 : 249883 : call pl%iter(key, type_code, vi, vr, vs)
1813 : :
1814 : : !#ifdef HAVE_DEBUG_MODE
1815 [ + - ]: 249883 : 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 : 249883 : write(tmp_key, kfmt) trim(key)
1825 : :
1826 [ + - ]: 249883 : call stream%push(trim(tmp_key)//': ')
1827 : :
1828 : 175980 : select case (type_code)
1829 : : case (TC_INT)
1830 : 175980 : call string_clear(tmp_i)
1831 : 175980 : write(tmp_i, ifmt) vi
1832 [ + - ]: 175980 : call stream%push(trim(tmp_i))
1833 : : case (TC_REAL)
1834 : 72030 : call string_clear(tmp_r)
1835 : 72030 : call format_real(vr, tmp_r, rfmt)
1836 [ + - ]: 72030 : call stream%push(trim(tmp_r))
1837 : : case (TC_STRING)
1838 : 1873 : call string_clear(tmp_s)
1839 : 1873 : write(tmp_s, sfmt) vs
1840 [ + - ]: 1873 : call yaml_print_string(stream, trim(tmp_s))
1841 : : case default
1842 [ + + + - ]: 249883 : ABI_ERROR(sjoin("Invalid type_code:", itoa(type_code)))
1843 : : end select
1844 : :
1845 [ - + - - ]: 359414 : if (i > 0 .and. mod(i, vmax) == 0 .and. i /= pl%length()) then
1846 : 0 : call stream%push(', '//eol//' ')
1847 : : else
1848 : 249883 : call stream%push(', ')
1849 : : end if
1850 : : end do
1851 : :
1852 [ - + ]: 109531 : if (pl%length() > vmax) call stream%push(eol)
1853 : 109531 : call stream%push('}')
1854 : :
1855 : 109531 : end subroutine yaml_print_dict
1856 : :
1857 : 126955 : subroutine yaml_print_string(stream, string)
1858 : :
1859 : : type(stream_string),intent(inout) :: stream
1860 : : character(len=*),intent(in) :: string
1861 : 126955 : character(len=len_trim(string)+2) :: quoted
1862 : :
1863 [ + - - + ]: 126955 : quoted = yaml_quote_string(string)
1864 [ + - ]: 126955 : call stream%push(trim(quoted))
1865 : :
1866 : 126955 : 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 : : !!***
|
