(git:e7e05ae)
input_val_types.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief a wrapper for basic fortran types.
10 !> \par History
11 !> 06.2004 created
12 !> \author fawzi
13 ! **************************************************************************************************
14 MODULE input_val_types
15 
16  USE cp_parser_types, ONLY: default_continuation_character
17  USE cp_units, ONLY: cp_unit_create,&
18  cp_unit_desc,&
19  cp_unit_from_cp2k,&
20  cp_unit_from_cp2k1,&
21  cp_unit_release,&
22  cp_unit_type
23  USE input_enumeration_types, ONLY: enum_i2c,&
24  enum_release,&
25  enum_retain,&
26  enumeration_type
27  USE kinds, ONLY: default_string_length,&
28  dp
29 #include "../base/base_uses.f90"
30 
31  IMPLICIT NONE
32  PRIVATE
33 
34  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
35  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_val_types'
36 
37  PUBLIC :: val_p_type, val_type
38  PUBLIC :: val_create, val_retain, val_release, val_get, val_write, &
39  val_write_internal, val_duplicate
40 
41  INTEGER, PARAMETER, PUBLIC :: no_t = 0, logical_t = 1, &
42  integer_t = 2, real_t = 3, char_t = 4, enum_t = 5, lchar_t = 6
43 
44 ! **************************************************************************************************
45 !> \brief pointer to a val, to create arrays of pointers
46 !> \param val to pointer to the val
47 !> \author fawzi
48 ! **************************************************************************************************
49  TYPE val_p_type
50  TYPE(val_type), POINTER :: val => null()
51  END TYPE val_p_type
52 
53 ! **************************************************************************************************
54 !> \brief a type to have a wrapper that stores any basic fortran type
55 !> \param type_of_var type stored in the val (should be one of no_t,
56 !> integer_t, logical_t, real_t, char_t)
57 !> \param l_val , i_val, c_val, r_val: arrays with logical,integer,character
58 !> or real values. Only one should be associated (and namely the one
59 !> specified in type_of_var).
60 !> \param enum an enumaration to map char to integers
61 !> \author fawzi
62 ! **************************************************************************************************
63  TYPE val_type
64  INTEGER :: ref_count = 0, type_of_var = no_t
65  LOGICAL, DIMENSION(:), POINTER :: l_val => null()
66  INTEGER, DIMENSION(:), POINTER :: i_val => null()
67  CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: &
68  c_val => null()
69  REAL(kind=dp), DIMENSION(:), POINTER :: r_val => null()
70  TYPE(enumeration_type), POINTER :: enum => null()
71  END TYPE val_type
72 CONTAINS
73 
74 ! **************************************************************************************************
75 !> \brief creates a keyword value
76 !> \param val the object to be created
77 !> \param l_val ,i_val,r_val,c_val,lc_val: a logical,integer,real,string, long
78 !> string to be stored in the val
79 !> \param l_vals , i_vals, r_vals, c_vals: an array of logicals,
80 !> integers, reals, characters, long strings to be stored in val
81 !> \param l_vals_ptr , i_vals_ptr, r_vals_ptr, c_vals_ptr: an array of logicals,
82 !> ... to be stored in val, val will get the ownership of the pointer
83 !> \param i_val ...
84 !> \param i_vals ...
85 !> \param i_vals_ptr ...
86 !> \param r_val ...
87 !> \param r_vals ...
88 !> \param r_vals_ptr ...
89 !> \param c_val ...
90 !> \param c_vals ...
91 !> \param c_vals_ptr ...
92 !> \param lc_val ...
93 !> \param lc_vals ...
94 !> \param lc_vals_ptr ...
95 !> \param enum the enumaration type this value is using
96 !> \author fawzi
97 !> \note
98 !> using an enumeration only i_val/i_vals/i_vals_ptr are accepted
99 ! **************************************************************************************************
100  SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, &
101  r_val, r_vals, r_vals_ptr, c_val, c_vals, c_vals_ptr, lc_val, lc_vals, &
102  lc_vals_ptr, enum)
103 
104  TYPE(val_type), POINTER :: val
105  LOGICAL, INTENT(in), OPTIONAL :: l_val
106  LOGICAL, DIMENSION(:), INTENT(in), OPTIONAL :: l_vals
107  LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals_ptr
108  INTEGER, INTENT(in), OPTIONAL :: i_val
109  INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: i_vals
110  INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals_ptr
111  REAL(kind=dp), INTENT(in), OPTIONAL :: r_val
112  REAL(kind=dp), DIMENSION(:), INTENT(in), OPTIONAL :: r_vals
113  REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: r_vals_ptr
114  CHARACTER(LEN=*), INTENT(in), OPTIONAL :: c_val
115  CHARACTER(LEN=*), DIMENSION(:), INTENT(in), &
116  OPTIONAL :: c_vals
117  CHARACTER(LEN=default_string_length), &
118  DIMENSION(:), OPTIONAL, POINTER :: c_vals_ptr
119  CHARACTER(LEN=*), INTENT(in), OPTIONAL :: lc_val
120  CHARACTER(LEN=*), DIMENSION(:), INTENT(in), &
121  OPTIONAL :: lc_vals
122  CHARACTER(LEN=default_string_length), &
123  DIMENSION(:), OPTIONAL, POINTER :: lc_vals_ptr
124  TYPE(enumeration_type), OPTIONAL, POINTER :: enum
125 
126  INTEGER :: i, len_c, narg, nval
127 
128  cpassert(.NOT. ASSOCIATED(val))
129  ALLOCATE (val)
130  NULLIFY (val%l_val, val%i_val, val%r_val, val%c_val, val%enum)
131  val%type_of_var = no_t
132  val%ref_count = 1
133 
134  narg = 0
135  val%type_of_var = no_t
136  IF (PRESENT(l_val)) THEN
137  narg = narg + 1
138  ALLOCATE (val%l_val(1))
139  val%l_val(1) = l_val
140  val%type_of_var = logical_t
141  END IF
142  IF (PRESENT(l_vals)) THEN
143  narg = narg + 1
144  ALLOCATE (val%l_val(SIZE(l_vals)))
145  val%l_val = l_vals
146  val%type_of_var = logical_t
147  END IF
148  IF (PRESENT(l_vals_ptr)) THEN
149  narg = narg + 1
150  val%l_val => l_vals_ptr
151  val%type_of_var = logical_t
152  END IF
153 
154  IF (PRESENT(r_val)) THEN
155  narg = narg + 1
156  ALLOCATE (val%r_val(1))
157  val%r_val(1) = r_val
158  val%type_of_var = real_t
159  END IF
160  IF (PRESENT(r_vals)) THEN
161  narg = narg + 1
162  ALLOCATE (val%r_val(SIZE(r_vals)))
163  val%r_val = r_vals
164  val%type_of_var = real_t
165  END IF
166  IF (PRESENT(r_vals_ptr)) THEN
167  narg = narg + 1
168  val%r_val => r_vals_ptr
169  val%type_of_var = real_t
170  END IF
171 
172  IF (PRESENT(i_val)) THEN
173  narg = narg + 1
174  ALLOCATE (val%i_val(1))
175  val%i_val(1) = i_val
176  val%type_of_var = integer_t
177  END IF
178  IF (PRESENT(i_vals)) THEN
179  narg = narg + 1
180  ALLOCATE (val%i_val(SIZE(i_vals)))
181  val%i_val = i_vals
182  val%type_of_var = integer_t
183  END IF
184  IF (PRESENT(i_vals_ptr)) THEN
185  narg = narg + 1
186  val%i_val => i_vals_ptr
187  val%type_of_var = integer_t
188  END IF
189 
190  IF (PRESENT(c_val)) THEN
191  cpassert(len_trim(c_val) <= default_string_length)
192  narg = narg + 1
193  ALLOCATE (val%c_val(1))
194  val%c_val(1) = c_val
195  val%type_of_var = char_t
196  END IF
197  IF (PRESENT(c_vals)) THEN
198  cpassert(all(len_trim(c_vals) <= default_string_length))
199  narg = narg + 1
200  ALLOCATE (val%c_val(SIZE(c_vals)))
201  val%c_val = c_vals
202  val%type_of_var = char_t
203  END IF
204  IF (PRESENT(c_vals_ptr)) THEN
205  narg = narg + 1
206  val%c_val => c_vals_ptr
207  val%type_of_var = char_t
208  END IF
209  IF (PRESENT(lc_val)) THEN
210  narg = narg + 1
211  len_c = len_trim(lc_val)
212  nval = max(1, ceiling(real(len_c, dp)/80._dp))
213  ALLOCATE (val%c_val(nval))
214 
215  IF (len_c == 0) THEN
216  val%c_val(1) = ""
217  ELSE
218  DO i = 1, nval
219  val%c_val(i) = lc_val((i - 1)*default_string_length + 1: &
220  min(len_c, i*default_string_length))
221  END DO
222  END IF
223  val%type_of_var = lchar_t
224  END IF
225  IF (PRESENT(lc_vals)) THEN
226  cpassert(all(len_trim(lc_vals) <= default_string_length))
227  narg = narg + 1
228  ALLOCATE (val%c_val(SIZE(lc_vals)))
229  val%c_val = lc_vals
230  val%type_of_var = lchar_t
231  END IF
232  IF (PRESENT(lc_vals_ptr)) THEN
233  narg = narg + 1
234  val%c_val => lc_vals_ptr
235  val%type_of_var = lchar_t
236  END IF
237  cpassert(narg <= 1)
238  IF (PRESENT(enum)) THEN
239  IF (ASSOCIATED(enum)) THEN
240  IF (val%type_of_var /= no_t .AND. val%type_of_var /= integer_t .AND. &
241  val%type_of_var /= enum_t) THEN
242  cpabort("")
243  END IF
244  IF (ASSOCIATED(val%i_val)) THEN
245  val%type_of_var = enum_t
246  val%enum => enum
247  CALL enum_retain(enum)
248  END IF
249  END IF
250  END IF
251 
252  cpassert(ASSOCIATED(val%enum) .EQV. val%type_of_var == enum_t)
253 
254  END SUBROUTINE val_create
255 
256 ! **************************************************************************************************
257 !> \brief releases the given val
258 !> \param val the val to release
259 !> \author fawzi
260 ! **************************************************************************************************
261  SUBROUTINE val_release(val)
262 
263  TYPE(val_type), POINTER :: val
264 
265  IF (ASSOCIATED(val)) THEN
266  cpassert(val%ref_count > 0)
267  val%ref_count = val%ref_count - 1
268  IF (val%ref_count == 0) THEN
269  IF (ASSOCIATED(val%l_val)) THEN
270  DEALLOCATE (val%l_val)
271  END IF
272  IF (ASSOCIATED(val%i_val)) THEN
273  DEALLOCATE (val%i_val)
274  END IF
275  IF (ASSOCIATED(val%r_val)) THEN
276  DEALLOCATE (val%r_val)
277  END IF
278  IF (ASSOCIATED(val%c_val)) THEN
279  DEALLOCATE (val%c_val)
280  END IF
281  CALL enum_release(val%enum)
282  val%type_of_var = no_t
283  DEALLOCATE (val)
284  END IF
285  END IF
286 
287  NULLIFY (val)
288 
289  END SUBROUTINE val_release
290 
291 ! **************************************************************************************************
292 !> \brief retains the given val
293 !> \param val the val to retain
294 !> \author fawzi
295 ! **************************************************************************************************
296  SUBROUTINE val_retain(val)
297 
298  TYPE(val_type), POINTER :: val
299 
300  cpassert(ASSOCIATED(val))
301  cpassert(val%ref_count > 0)
302  val%ref_count = val%ref_count + 1
303 
304  END SUBROUTINE val_retain
305 
306 ! **************************************************************************************************
307 !> \brief returns the stored values
308 !> \param val the object from which you want to extract the values
309 !> \param has_l ...
310 !> \param has_i ...
311 !> \param has_r ...
312 !> \param has_lc ...
313 !> \param has_c ...
314 !> \param l_val gets a logical from the val
315 !> \param l_vals gets an array of logicals from the val
316 !> \param i_val gets an integer from the val
317 !> \param i_vals gets an array of integers from the val
318 !> \param r_val gets a real from the val
319 !> \param r_vals gets an array of reals from the val
320 !> \param c_val gets a char from the val
321 !> \param c_vals gets an array of chars from the val
322 !> \param len_c len_trim of c_val (if it was a lc_val, of type lchar_t
323 !> it might be longet than default_string_length)
324 !> \param type_of_var ...
325 !> \param enum ...
326 !> \author fawzi
327 !> \note
328 !> using an enumeration only i_val/i_vals/i_vals_ptr are accepted
329 !> add something like ignore_string_cut that if true does not warn if
330 !> the c_val is too short to contain the string
331 ! **************************************************************************************************
332  SUBROUTINE val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val, &
333  i_vals, r_val, r_vals, c_val, c_vals, len_c, type_of_var, enum)
334 
335  TYPE(val_type), POINTER :: val
336  LOGICAL, INTENT(out), OPTIONAL :: has_l, has_i, has_r, has_lc, has_c, l_val
337  LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals
338  INTEGER, INTENT(out), OPTIONAL :: i_val
339  INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals
340  REAL(kind=dp), INTENT(out), OPTIONAL :: r_val
341  REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: r_vals
342  CHARACTER(LEN=*), INTENT(out), OPTIONAL :: c_val
343  CHARACTER(LEN=default_string_length), &
344  DIMENSION(:), OPTIONAL, POINTER :: c_vals
345  INTEGER, INTENT(out), OPTIONAL :: len_c, type_of_var
346  TYPE(enumeration_type), OPTIONAL, POINTER :: enum
347 
348  INTEGER :: i, l_in, l_out
349 
350  IF (PRESENT(has_l)) has_l = ASSOCIATED(val%l_val)
351  IF (PRESENT(has_i)) has_i = ASSOCIATED(val%i_val)
352  IF (PRESENT(has_r)) has_r = ASSOCIATED(val%r_val)
353  IF (PRESENT(has_c)) has_c = ASSOCIATED(val%c_val) ! use type_of_var?
354  IF (PRESENT(has_lc)) has_lc = (val%type_of_var == lchar_t)
355  IF (PRESENT(l_vals)) l_vals => val%l_val
356  IF (PRESENT(l_val)) THEN
357  IF (ASSOCIATED(val%l_val)) THEN
358  IF (SIZE(val%l_val) > 0) THEN
359  l_val = val%l_val(1)
360  ELSE
361  cpabort("")
362  END IF
363  ELSE
364  cpabort("")
365  END IF
366  END IF
367 
368  IF (PRESENT(i_vals)) i_vals => val%i_val
369  IF (PRESENT(i_val)) THEN
370  IF (ASSOCIATED(val%i_val)) THEN
371  IF (SIZE(val%i_val) > 0) THEN
372  i_val = val%i_val(1)
373  ELSE
374  cpabort("")
375  END IF
376  ELSE
377  cpabort("")
378  END IF
379  END IF
380 
381  IF (PRESENT(r_vals)) r_vals => val%r_val
382  IF (PRESENT(r_val)) THEN
383  IF (ASSOCIATED(val%r_val)) THEN
384  IF (SIZE(val%r_val) > 0) THEN
385  r_val = val%r_val(1)
386  ELSE
387  cpabort("")
388  END IF
389  ELSE
390  cpabort("")
391  END IF
392  END IF
393 
394  IF (PRESENT(c_vals)) c_vals => val%c_val
395  IF (PRESENT(c_val)) THEN
396  l_out = len(c_val)
397  IF (ASSOCIATED(val%c_val)) THEN
398  IF (SIZE(val%c_val) > 0) THEN
399  IF (val%type_of_var == lchar_t) THEN
400  l_in = default_string_length*(SIZE(val%c_val) - 1) + &
401  len_trim(val%c_val(SIZE(val%c_val)))
402  IF (l_out < l_in) &
403  CALL cp_warn(__location__, &
404  "val_get will truncate value, value beginning with '"// &
405  trim(val%c_val(1))//"' is too long for variable")
406  DO i = 1, SIZE(val%c_val)
407  c_val((i - 1)*default_string_length + 1:min(l_out, i*default_string_length)) = &
408  val%c_val(i) (1:min(80, l_out - (i - 1)*default_string_length))
409  IF (l_out <= i*default_string_length) EXIT
410  END DO
411  IF (l_out > SIZE(val%c_val)*default_string_length) &
412  c_val(SIZE(val%c_val)*default_string_length + 1:l_out) = ""
413  ELSE
414  l_in = len_trim(val%c_val(1))
415  IF (l_out < l_in) &
416  CALL cp_warn(__location__, &
417  "val_get will truncate value, value '"// &
418  trim(val%c_val(1))//"' is too long for variable")
419  c_val = val%c_val(1)
420  END IF
421  ELSE
422  cpabort("")
423  END IF
424  ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
425  IF (SIZE(val%i_val) > 0) THEN
426  c_val = enum_i2c(val%enum, val%i_val(1))
427  ELSE
428  cpabort("")
429  END IF
430  ELSE
431  cpabort("")
432  END IF
433  END IF
434 
435  IF (PRESENT(len_c)) THEN
436  IF (ASSOCIATED(val%c_val)) THEN
437  IF (SIZE(val%c_val) > 0) THEN
438  IF (val%type_of_var == lchar_t) THEN
439  len_c = default_string_length*(SIZE(val%c_val) - 1) + &
440  len_trim(val%c_val(SIZE(val%c_val)))
441  ELSE
442  len_c = len_trim(val%c_val(1))
443  END IF
444  ELSE
445  len_c = -huge(0)
446  END IF
447  ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
448  IF (SIZE(val%i_val) > 0) THEN
449  len_c = len_trim(enum_i2c(val%enum, val%i_val(1)))
450  ELSE
451  len_c = -huge(0)
452  END IF
453  ELSE
454  len_c = -huge(0)
455  END IF
456  END IF
457 
458  IF (PRESENT(type_of_var)) type_of_var = val%type_of_var
459 
460  IF (PRESENT(enum)) enum => val%enum
461 
462  END SUBROUTINE val_get
463 
464 ! **************************************************************************************************
465 !> \brief writes out the values stored in the val
466 !> \param val the val to write
467 !> \param unit_nr the number of the unit to write to
468 !> \param unit the unit of mesure in which the output should be written
469 !> (overrides unit_str)
470 !> \param unit_str the unit of mesure in which the output should be written
471 !> \param fmt ...
472 !> \author fawzi
473 !> \note
474 !> unit of mesure used only for reals
475 ! **************************************************************************************************
476  SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt)
477 
478  TYPE(val_type), POINTER :: val
479  INTEGER, INTENT(in) :: unit_nr
480  TYPE(cp_unit_type), OPTIONAL, POINTER :: unit
481  CHARACTER(len=*), INTENT(in), OPTIONAL :: unit_str, fmt
482 
483  CHARACTER(len=default_string_length) :: c_string, myfmt, rcval
484  INTEGER :: i, iend, item, j, l
485  LOGICAL :: owns_unit
486  TYPE(cp_unit_type), POINTER :: my_unit
487 
488  NULLIFY (my_unit)
489  myfmt = ""
490  owns_unit = .false.
491 
492  IF (PRESENT(fmt)) myfmt = fmt
493  IF (PRESENT(unit)) my_unit => unit
494  IF (.NOT. ASSOCIATED(my_unit) .AND. PRESENT(unit_str)) THEN
495  ALLOCATE (my_unit)
496  CALL cp_unit_create(my_unit, unit_str)
497  owns_unit = .true.
498  END IF
499 
500  IF (ASSOCIATED(val)) THEN
501  SELECT CASE (val%type_of_var)
502  CASE (logical_t)
503  IF (ASSOCIATED(val%l_val)) THEN
504  DO i = 1, SIZE(val%l_val)
505  IF (modulo(i, 20) == 0) THEN
506  WRITE (unit=unit_nr, fmt="(1X,A1)") default_continuation_character
507  WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
508  END IF
509  WRITE (unit=unit_nr, fmt="(1X,L1)", advance="NO") &
510  val%l_val(i)
511  END DO
512  ELSE
513  cpabort("Input value of type <logical_t> not associated")
514  END IF
515  CASE (integer_t)
516  IF (ASSOCIATED(val%i_val)) THEN
517  item = 0
518  i = 1
519  loop_i: DO WHILE (i <= SIZE(val%i_val))
520  item = item + 1
521  IF (modulo(item, 10) == 0) THEN
522  WRITE (unit=unit_nr, fmt="(1X,A)") default_continuation_character
523  WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
524  END IF
525  iend = i
526  loop_j: DO j = i + 1, SIZE(val%i_val)
527  IF (val%i_val(j - 1) + 1 == val%i_val(j)) THEN
528  iend = iend + 1
529  ELSE
530  EXIT loop_j
531  END IF
532  END DO loop_j
533  IF ((iend - i) > 1) THEN
534  WRITE (unit=unit_nr, fmt="(1X,I0,A2,I0)", advance="NO") &
535  val%i_val(i), "..", val%i_val(iend)
536  i = iend
537  ELSE
538  WRITE (unit=unit_nr, fmt="(1X,I0)", advance="NO") &
539  val%i_val(i)
540  END IF
541  i = i + 1
542  END DO loop_i
543  ELSE
544  cpabort("Input value of type <integer_t> not associated")
545  END IF
546  CASE (real_t)
547  IF (ASSOCIATED(val%r_val)) THEN
548  DO i = 1, SIZE(val%r_val)
549  IF (modulo(i, 5) == 0) THEN
550  WRITE (unit=unit_nr, fmt="(1X,A)") default_continuation_character
551  WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
552  END IF
553  IF (ASSOCIATED(my_unit)) THEN
554  WRITE (unit=rcval, fmt="(ES25.16E3)") &
555  cp_unit_from_cp2k1(val%r_val(i), my_unit)
556  ELSE
557  WRITE (unit=rcval, fmt="(ES25.16E3)") val%r_val(i)
558  END IF
559  WRITE (unit=unit_nr, fmt="(A)", advance="NO") trim(rcval)
560  END DO
561  ELSE
562  cpabort("Input value of type <real_t> not associated")
563  END IF
564  CASE (char_t)
565  IF (ASSOCIATED(val%c_val)) THEN
566  l = 0
567  DO i = 1, SIZE(val%c_val)
568  l = l + 1
569  IF (l > 10 .AND. l + len_trim(val%c_val(i)) > 76) THEN
570  WRITE (unit=unit_nr, fmt="(A1)") default_continuation_character
571  WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
572  l = 0
573  WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") """"//trim(val%c_val(i))//""""
574  l = l + len_trim(val%c_val(i)) + 3
575  ELSE IF (len_trim(val%c_val(i)) > 0) THEN
576  l = l + len_trim(val%c_val(i))
577  WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") """"//trim(val%c_val(i))//""""
578  ELSE
579  l = l + 3
580  WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") '""'
581  END IF
582  END DO
583  ELSE
584  cpabort("Input value of type <char_t> not associated")
585  END IF
586  CASE (lchar_t)
587  IF (ASSOCIATED(val%c_val)) THEN
588  SELECT CASE (SIZE(val%c_val))
589  CASE (1)
590  WRITE (unit=unit_nr, fmt='(1X,A)', advance="NO") trim(val%c_val(1))
591  CASE (2)
592  WRITE (unit=unit_nr, fmt='(1X,A)', advance="NO") val%c_val(1)
593  WRITE (unit=unit_nr, fmt='(A)', advance="NO") trim(val%c_val(2))
594  CASE (3:)
595  WRITE (unit=unit_nr, fmt='(1X,A)', advance="NO") val%c_val(1)
596  DO i = 2, SIZE(val%c_val) - 1
597  WRITE (unit=unit_nr, fmt="(A)", advance="NO") val%c_val(i)
598  END DO
599  WRITE (unit=unit_nr, fmt='(A)', advance="NO") trim(val%c_val(SIZE(val%c_val)))
600  END SELECT
601  ELSE
602  cpabort("Input value of type <lchar_t> not associated")
603  END IF
604  CASE (enum_t)
605  IF (ASSOCIATED(val%i_val)) THEN
606  l = 0
607  DO i = 1, SIZE(val%i_val)
608  c_string = enum_i2c(val%enum, val%i_val(i))
609  IF (l > 10 .AND. l + len_trim(c_string) > 76) THEN
610  WRITE (unit=unit_nr, fmt="(1X,A)") default_continuation_character
611  WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
612  l = 0
613  ELSE
614  l = l + len_trim(c_string) + 3
615  END IF
616  WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") trim(c_string)
617  END DO
618  ELSE
619  cpabort("Input value of type <enum_t> not associated")
620  END IF
621  CASE (no_t)
622  WRITE (unit=unit_nr, fmt="(' *empty*')", advance="NO")
623  CASE default
624  cpabort("Unexpected type_of_var for val")
625  END SELECT
626  ELSE
627  WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") "NULL()"
628  END IF
629 
630  IF (owns_unit) THEN
631  CALL cp_unit_release(my_unit)
632  DEALLOCATE (my_unit)
633  END IF
634 
635  WRITE (unit=unit_nr, fmt="()")
636 
637  END SUBROUTINE val_write
638 
639 ! **************************************************************************************************
640 !> \brief Write values to an internal file, i.e. string variable.
641 !> \param val ...
642 !> \param string ...
643 !> \param unit ...
644 !> \date 10.03.2005
645 !> \par History
646 !> 17.01.2006, MK, Optional argument unit for the conversion to the external unit added
647 !> \author MK
648 !> \version 1.0
649 ! **************************************************************************************************
650  SUBROUTINE val_write_internal(val, string, unit)
651 
652  TYPE(val_type), POINTER :: val
653  CHARACTER(LEN=*), INTENT(OUT) :: string
654  TYPE(cp_unit_type), OPTIONAL, POINTER :: unit
655 
656  CHARACTER(LEN=default_string_length) :: enum_string
657  INTEGER :: i, ipos
658  REAL(kind=dp) :: value
659 
660  string = ""
661 
662  IF (ASSOCIATED(val)) THEN
663 
664  SELECT CASE (val%type_of_var)
665  CASE (logical_t)
666  IF (ASSOCIATED(val%l_val)) THEN
667  DO i = 1, SIZE(val%l_val)
668  WRITE (unit=string(2*i - 1:), fmt="(1X,L1)") val%l_val(i)
669  END DO
670  ELSE
671  cpabort("")
672  END IF
673  CASE (integer_t)
674  IF (ASSOCIATED(val%i_val)) THEN
675  DO i = 1, SIZE(val%i_val)
676  WRITE (unit=string(12*i - 11:), fmt="(I12)") val%i_val(i)
677  END DO
678  ELSE
679  cpabort("")
680  END IF
681  CASE (real_t)
682  IF (ASSOCIATED(val%r_val)) THEN
683  IF (PRESENT(unit)) THEN
684  DO i = 1, SIZE(val%r_val)
685  value = cp_unit_from_cp2k(value=val%r_val(i), &
686  unit_str=cp_unit_desc(unit=unit))
687  WRITE (unit=string(17*i - 16:), fmt="(ES17.8E3)") value
688  END DO
689  ELSE
690  DO i = 1, SIZE(val%r_val)
691  WRITE (unit=string(17*i - 16:), fmt="(ES17.8E3)") val%r_val(i)
692  END DO
693  END IF
694  ELSE
695  cpabort("")
696  END IF
697  CASE (char_t)
698  IF (ASSOCIATED(val%c_val)) THEN
699  ipos = 1
700  DO i = 1, SIZE(val%c_val)
701  WRITE (unit=string(ipos:), fmt="(A)") trim(adjustl(val%c_val(i)))
702  ipos = ipos + len_trim(adjustl(val%c_val(i))) + 1
703  END DO
704  ELSE
705  cpabort("")
706  END IF
707  CASE (lchar_t)
708  IF (ASSOCIATED(val%c_val)) THEN
709  CALL val_get(val, c_val=string)
710  ELSE
711  cpabort("")
712  END IF
713  CASE (enum_t)
714  IF (ASSOCIATED(val%i_val)) THEN
715  DO i = 1, SIZE(val%i_val)
716  enum_string = enum_i2c(val%enum, val%i_val(i))
717  WRITE (unit=string, fmt="(A)") trim(adjustl(enum_string))
718  END DO
719  ELSE
720  cpabort("")
721  END IF
722  CASE default
723  cpabort("unexpected type_of_var for val ")
724  END SELECT
725 
726  END IF
727 
728  END SUBROUTINE val_write_internal
729 
730 ! **************************************************************************************************
731 !> \brief creates a copy of the given value
732 !> \param val_in the value to copy
733 !> \param val_out the value tha will be created
734 !> \author fawzi
735 ! **************************************************************************************************
736  SUBROUTINE val_duplicate(val_in, val_out)
737 
738  TYPE(val_type), POINTER :: val_in, val_out
739 
740  cpassert(ASSOCIATED(val_in))
741  cpassert(.NOT. ASSOCIATED(val_out))
742  ALLOCATE (val_out)
743  val_out%type_of_var = val_in%type_of_var
744  val_out%ref_count = 1
745  val_out%enum => val_in%enum
746  IF (ASSOCIATED(val_out%enum)) CALL enum_retain(val_out%enum)
747 
748  NULLIFY (val_out%l_val, val_out%i_val, val_out%c_val, val_out%r_val)
749  IF (ASSOCIATED(val_in%l_val)) THEN
750  ALLOCATE (val_out%l_val(SIZE(val_in%l_val)))
751  val_out%l_val = val_in%l_val
752  END IF
753  IF (ASSOCIATED(val_in%i_val)) THEN
754  ALLOCATE (val_out%i_val(SIZE(val_in%i_val)))
755  val_out%i_val = val_in%i_val
756  END IF
757  IF (ASSOCIATED(val_in%r_val)) THEN
758  ALLOCATE (val_out%r_val(SIZE(val_in%r_val)))
759  val_out%r_val = val_in%r_val
760  END IF
761  IF (ASSOCIATED(val_in%c_val)) THEN
762  ALLOCATE (val_out%c_val(SIZE(val_in%c_val)))
763  val_out%c_val = val_in%c_val
764  END IF
765 
766  END SUBROUTINE val_duplicate
767 
768 END MODULE input_val_types
modulo
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition: grid_common.h:117
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition: cp_parser_types.F:21
cp_parser_types::default_continuation_character
character(len=1), parameter, public default_continuation_character
Definition: cp_parser_types.F:59
cp_units
unit conversion facility
Definition: cp_units.F:30
cp_units::cp_unit_desc
character(len=cp_unit_desc_length) function, public cp_unit_desc(unit, defaults, accept_undefined)
returns the "name" of the given unit
Definition: cp_units.F:1036
cp_units::cp_unit_from_cp2k1
real(kind=dp) function, public cp_unit_from_cp2k1(value, unit, defaults, power)
converts from the internal cp2k units to the given unit
Definition: cp_units.F:1121
cp_units::cp_unit_from_cp2k
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
Definition: cp_units.F:1179
cp_units::cp_unit_create
subroutine, public cp_unit_create(unit, string)
creates a unit parsing a string
Definition: cp_units.F:163
cp_units::cp_unit_release
elemental subroutine, public cp_unit_release(unit)
releases the given unit
Definition: cp_units.F:545
input_enumeration_types
represents an enumeration, i.e. a mapping between integers and strings
Definition: input_enumeration_types.F:14
input_enumeration_types::enum_release
subroutine, public enum_release(enum)
releases the given enumeration
Definition: input_enumeration_types.F:124
input_enumeration_types::enum_retain
subroutine, public enum_retain(enum)
retains the given enumeration
Definition: input_enumeration_types.F:111
input_enumeration_types::enum_i2c
character(len=default_string_length) function, public enum_i2c(enum, i)
maps an integer to a string
Definition: input_enumeration_types.F:152
input_val_types
a wrapper for basic fortran types.
Definition: input_val_types.F:14
input_val_types::real_t
integer, parameter, public real_t
Definition: input_val_types.F:41
input_val_types::lchar_t
integer, parameter, public lchar_t
Definition: input_val_types.F:41
input_val_types::logical_t
integer, parameter, public logical_t
Definition: input_val_types.F:41
input_val_types::val_retain
subroutine, public val_retain(val)
retains the given val
Definition: input_val_types.F:297
input_val_types::val_duplicate
subroutine, public val_duplicate(val_in, val_out)
creates a copy of the given value
Definition: input_val_types.F:737
input_val_types::val_write
subroutine, public val_write(val, unit_nr, unit, unit_str, fmt)
writes out the values stored in the val
Definition: input_val_types.F:477
input_val_types::val_write_internal
subroutine, public val_write_internal(val, string, unit)
Write values to an internal file, i.e. string variable.
Definition: input_val_types.F:651
input_val_types::val_get
subroutine, public val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val, i_vals, r_val, r_vals, c_val, c_vals, len_c, type_of_var, enum)
returns the stored values
Definition: input_val_types.F:334
input_val_types::val_create
subroutine, public val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, r_val, r_vals, r_vals_ptr, c_val, c_vals, c_vals_ptr, lc_val, lc_vals, lc_vals_ptr, enum)
creates a keyword value
Definition: input_val_types.F:103
input_val_types::val_release
subroutine, public val_release(val)
releases the given val
Definition: input_val_types.F:262
input_val_types::char_t
integer, parameter, public char_t
Definition: input_val_types.F:41
input_val_types::integer_t
integer, parameter, public integer_t
Definition: input_val_types.F:41
input_val_types::no_t
integer, parameter, public no_t
Definition: input_val_types.F:41
input_val_types::enum_t
integer, parameter, public enum_t
Definition: input_val_types.F:41
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition: kinds.F:57