(git:b6ef100)
Loading...
Searching...
No Matches
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-2026 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! **************************************************************************************************
14MODULE 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
72CONTAINS
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("Type of variable is incompatible with enum")
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("Invalid size of logical value(s)")
362 END IF
363 ELSE
364 cpabort("Logical value is unavailable")
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("Invalid size of integer value(s)")
375 END IF
376 ELSE
377 cpabort("Integer value is unavailable")
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("Invalid size of real value(s)")
388 END IF
389 ELSE
390 cpabort("Real value is unavailable")
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) THEN
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 END IF
407 DO i = 1, SIZE(val%c_val)
408 c_val((i - 1)*default_string_length + 1:min(l_out, i*default_string_length)) = &
409 val%c_val(i) (1:min(80, l_out - (i - 1)*default_string_length))
410 IF (l_out <= i*default_string_length) EXIT
411 END DO
412 IF (l_out > SIZE(val%c_val)*default_string_length) THEN
413 c_val(SIZE(val%c_val)*default_string_length + 1:l_out) = ""
414 END IF
415 ELSE
416 l_in = len_trim(val%c_val(1))
417 IF (l_out < l_in) THEN
418 CALL cp_warn(__location__, &
419 "val_get will truncate value, value '"// &
420 trim(val%c_val(1))//"' is too long for variable")
421 END IF
422 c_val = val%c_val(1)
423 END IF
424 ELSE
425 cpabort("Invalid size of character value(s)")
426 END IF
427 ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
428 IF (SIZE(val%i_val) > 0) THEN
429 c_val = enum_i2c(val%enum, val%i_val(1))
430 ELSE
431 cpabort("Invalid size of character value(s)")
432 END IF
433 ELSE
434 cpabort("Character value is unavailable")
435 END IF
436 END IF
437
438 IF (PRESENT(len_c)) THEN
439 IF (ASSOCIATED(val%c_val)) THEN
440 IF (SIZE(val%c_val) > 0) THEN
441 IF (val%type_of_var == lchar_t) THEN
442 len_c = default_string_length*(SIZE(val%c_val) - 1) + &
443 len_trim(val%c_val(SIZE(val%c_val)))
444 ELSE
445 len_c = len_trim(val%c_val(1))
446 END IF
447 ELSE
448 len_c = -huge(0)
449 END IF
450 ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
451 IF (SIZE(val%i_val) > 0) THEN
452 len_c = len_trim(enum_i2c(val%enum, val%i_val(1)))
453 ELSE
454 len_c = -huge(0)
455 END IF
456 ELSE
457 len_c = -huge(0)
458 END IF
459 END IF
460
461 IF (PRESENT(type_of_var)) type_of_var = val%type_of_var
462
463 IF (PRESENT(enum)) enum => val%enum
464
465 END SUBROUTINE val_get
466
467! **************************************************************************************************
468!> \brief writes out the values stored in the val
469!> \param val the val to write
470!> \param unit_nr the number of the unit to write to
471!> \param unit the unit of mesure in which the output should be written
472!> (overrides unit_str)
473!> \param unit_str the unit of mesure in which the output should be written
474!> \param fmt ...
475!> \author fawzi
476!> \note
477!> unit of mesure used only for reals
478! **************************************************************************************************
479 SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt)
480
481 TYPE(val_type), POINTER :: val
482 INTEGER, INTENT(in) :: unit_nr
483 TYPE(cp_unit_type), OPTIONAL, POINTER :: unit
484 CHARACTER(len=*), INTENT(in), OPTIONAL :: unit_str, fmt
485
486 CHARACTER(len=default_string_length) :: c_string, myfmt, rcval
487 INTEGER :: i, iend, item, j, l
488 LOGICAL :: owns_unit
489 TYPE(cp_unit_type), POINTER :: my_unit
490
491 NULLIFY (my_unit)
492 myfmt = ""
493 owns_unit = .false.
494
495 IF (PRESENT(fmt)) myfmt = fmt
496 IF (PRESENT(unit)) my_unit => unit
497 IF (.NOT. ASSOCIATED(my_unit) .AND. PRESENT(unit_str)) THEN
498 ALLOCATE (my_unit)
499 CALL cp_unit_create(my_unit, unit_str)
500 owns_unit = .true.
501 END IF
502
503 IF (ASSOCIATED(val)) THEN
504 SELECT CASE (val%type_of_var)
505 CASE (logical_t)
506 IF (ASSOCIATED(val%l_val)) THEN
507 DO i = 1, SIZE(val%l_val)
508 IF (modulo(i, 20) == 0) THEN
509 WRITE (unit=unit_nr, fmt="(1X,A1)") default_continuation_character
510 WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
511 END IF
512 WRITE (unit=unit_nr, fmt="(1X,L1)", advance="NO") &
513 val%l_val(i)
514 END DO
515 ELSE
516 cpabort("Input value of type <logical_t> not associated")
517 END IF
518 CASE (integer_t)
519 IF (ASSOCIATED(val%i_val)) THEN
520 item = 0
521 i = 1
522 loop_i: DO WHILE (i <= SIZE(val%i_val))
523 item = item + 1
524 IF (modulo(item, 10) == 0) THEN
525 WRITE (unit=unit_nr, fmt="(1X,A)") default_continuation_character
526 WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
527 END IF
528 iend = i
529 loop_j: DO j = i + 1, SIZE(val%i_val)
530 IF (val%i_val(j - 1) + 1 == val%i_val(j)) THEN
531 iend = iend + 1
532 ELSE
533 EXIT loop_j
534 END IF
535 END DO loop_j
536 IF ((iend - i) > 1) THEN
537 WRITE (unit=unit_nr, fmt="(1X,I0,A2,I0)", advance="NO") &
538 val%i_val(i), "..", val%i_val(iend)
539 i = iend
540 ELSE
541 WRITE (unit=unit_nr, fmt="(1X,I0)", advance="NO") &
542 val%i_val(i)
543 END IF
544 i = i + 1
545 END DO loop_i
546 ELSE
547 cpabort("Input value of type <integer_t> not associated")
548 END IF
549 CASE (real_t)
550 IF (ASSOCIATED(val%r_val)) THEN
551 DO i = 1, SIZE(val%r_val)
552 IF (modulo(i, 5) == 0) THEN
553 WRITE (unit=unit_nr, fmt="(1X,A)") default_continuation_character
554 WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
555 END IF
556 IF (ASSOCIATED(my_unit)) THEN
557 WRITE (unit=rcval, fmt="(ES25.16E3)") &
558 cp_unit_from_cp2k1(val%r_val(i), my_unit)
559 ELSE
560 WRITE (unit=rcval, fmt="(ES25.16E3)") val%r_val(i)
561 END IF
562 WRITE (unit=unit_nr, fmt="(A)", advance="NO") trim(rcval)
563 END DO
564 ELSE
565 cpabort("Input value of type <real_t> not associated")
566 END IF
567 CASE (char_t)
568 IF (ASSOCIATED(val%c_val)) THEN
569 l = 0
570 DO i = 1, SIZE(val%c_val)
571 l = l + 1
572 IF (l > 10 .AND. l + len_trim(val%c_val(i)) > 76) THEN
573 WRITE (unit=unit_nr, fmt="(A1)") default_continuation_character
574 WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
575 l = 0
576 WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") """"//trim(val%c_val(i))//""""
577 l = l + len_trim(val%c_val(i)) + 3
578 ELSE IF (len_trim(val%c_val(i)) > 0) THEN
579 l = l + len_trim(val%c_val(i))
580 WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") """"//trim(val%c_val(i))//""""
581 ELSE
582 l = l + 3
583 WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") '""'
584 END IF
585 END DO
586 ELSE
587 cpabort("Input value of type <char_t> not associated")
588 END IF
589 CASE (lchar_t)
590 IF (ASSOCIATED(val%c_val)) THEN
591 SELECT CASE (SIZE(val%c_val))
592 CASE (1)
593 WRITE (unit=unit_nr, fmt='(1X,A)', advance="NO") trim(val%c_val(1))
594 CASE (2)
595 WRITE (unit=unit_nr, fmt='(1X,A)', advance="NO") val%c_val(1)
596 WRITE (unit=unit_nr, fmt='(A)', advance="NO") trim(val%c_val(2))
597 CASE (3:)
598 WRITE (unit=unit_nr, fmt='(1X,A)', advance="NO") val%c_val(1)
599 DO i = 2, SIZE(val%c_val) - 1
600 WRITE (unit=unit_nr, fmt="(A)", advance="NO") val%c_val(i)
601 END DO
602 WRITE (unit=unit_nr, fmt='(A)', advance="NO") trim(val%c_val(SIZE(val%c_val)))
603 END SELECT
604 ELSE
605 cpabort("Input value of type <lchar_t> not associated")
606 END IF
607 CASE (enum_t)
608 IF (ASSOCIATED(val%i_val)) THEN
609 l = 0
610 DO i = 1, SIZE(val%i_val)
611 c_string = enum_i2c(val%enum, val%i_val(i))
612 IF (l > 10 .AND. l + len_trim(c_string) > 76) THEN
613 WRITE (unit=unit_nr, fmt="(1X,A)") default_continuation_character
614 WRITE (unit=unit_nr, fmt="("//trim(myfmt)//")", advance="NO")
615 l = 0
616 ELSE
617 l = l + len_trim(c_string) + 3
618 END IF
619 WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") trim(c_string)
620 END DO
621 ELSE
622 cpabort("Input value of type <enum_t> not associated")
623 END IF
624 CASE (no_t)
625 WRITE (unit=unit_nr, fmt="(' *empty*')", advance="NO")
626 CASE default
627 cpabort("Unexpected type_of_var for val")
628 END SELECT
629 ELSE
630 WRITE (unit=unit_nr, fmt="(1X,A)", advance="NO") "NULL()"
631 END IF
632
633 IF (owns_unit) THEN
634 CALL cp_unit_release(my_unit)
635 DEALLOCATE (my_unit)
636 END IF
637
638 WRITE (unit=unit_nr, fmt="()")
639
640 END SUBROUTINE val_write
641
642! **************************************************************************************************
643!> \brief Write values to an internal file, i.e. string variable.
644!> \param val ...
645!> \param string ...
646!> \param unit ...
647!> \date 10.03.2005
648!> \par History
649!> 17.01.2006, MK, Optional argument unit for the conversion to the external unit added
650!> \author MK
651!> \version 1.0
652! **************************************************************************************************
653 SUBROUTINE val_write_internal(val, string, unit)
654
655 TYPE(val_type), POINTER :: val
656 CHARACTER(LEN=*), INTENT(OUT) :: string
657 TYPE(cp_unit_type), OPTIONAL, POINTER :: unit
658
659 CHARACTER(LEN=default_string_length) :: enum_string
660 INTEGER :: i, ipos
661 REAL(kind=dp) :: value
662
663 string = ""
664
665 IF (ASSOCIATED(val)) THEN
666
667 SELECT CASE (val%type_of_var)
668 CASE (logical_t)
669 IF (ASSOCIATED(val%l_val)) THEN
670 DO i = 1, SIZE(val%l_val)
671 WRITE (unit=string(2*i - 1:), fmt="(1X,L1)") val%l_val(i)
672 END DO
673 ELSE
674 cpabort("Logical value is unavailable")
675 END IF
676 CASE (integer_t)
677 IF (ASSOCIATED(val%i_val)) THEN
678 DO i = 1, SIZE(val%i_val)
679 WRITE (unit=string(12*i - 11:), fmt="(I12)") val%i_val(i)
680 END DO
681 ELSE
682 cpabort("Integer value is unavailable")
683 END IF
684 CASE (real_t)
685 IF (ASSOCIATED(val%r_val)) THEN
686 IF (PRESENT(unit)) THEN
687 DO i = 1, SIZE(val%r_val)
688 value = cp_unit_from_cp2k(value=val%r_val(i), &
689 unit_str=cp_unit_desc(unit=unit))
690 WRITE (unit=string(17*i - 16:), fmt="(ES17.8E3)") value
691 END DO
692 ELSE
693 DO i = 1, SIZE(val%r_val)
694 WRITE (unit=string(17*i - 16:), fmt="(ES17.8E3)") val%r_val(i)
695 END DO
696 END IF
697 ELSE
698 cpabort("Real value is unavailable")
699 END IF
700 CASE (char_t)
701 IF (ASSOCIATED(val%c_val)) THEN
702 ipos = 1
703 DO i = 1, SIZE(val%c_val)
704 WRITE (unit=string(ipos:), fmt="(A)") trim(adjustl(val%c_val(i)))
705 ipos = ipos + len_trim(adjustl(val%c_val(i))) + 1
706 END DO
707 ELSE
708 cpabort("Character value is unavailable")
709 END IF
710 CASE (lchar_t)
711 IF (ASSOCIATED(val%c_val)) THEN
712 CALL val_get(val, c_val=string)
713 ELSE
714 cpabort("Character value is unavailable")
715 END IF
716 CASE (enum_t)
717 IF (ASSOCIATED(val%i_val)) THEN
718 DO i = 1, SIZE(val%i_val)
719 enum_string = enum_i2c(val%enum, val%i_val(i))
720 WRITE (unit=string, fmt="(A)") trim(adjustl(enum_string))
721 END DO
722 ELSE
723 cpabort("Enumeration value is unavailable")
724 END IF
725 CASE default
726 cpabort("unexpected type_of_var for val ")
727 END SELECT
728
729 END IF
730
731 END SUBROUTINE val_write_internal
732
733! **************************************************************************************************
734!> \brief creates a copy of the given value
735!> \param val_in the value to copy
736!> \param val_out the value tha will be created
737!> \author fawzi
738! **************************************************************************************************
739 SUBROUTINE val_duplicate(val_in, val_out)
740
741 TYPE(val_type), POINTER :: val_in, val_out
742
743 cpassert(ASSOCIATED(val_in))
744 cpassert(.NOT. ASSOCIATED(val_out))
745 ALLOCATE (val_out)
746 val_out%type_of_var = val_in%type_of_var
747 val_out%ref_count = 1
748 val_out%enum => val_in%enum
749 IF (ASSOCIATED(val_out%enum)) CALL enum_retain(val_out%enum)
750
751 NULLIFY (val_out%l_val, val_out%i_val, val_out%c_val, val_out%r_val)
752 IF (ASSOCIATED(val_in%l_val)) THEN
753 ALLOCATE (val_out%l_val(SIZE(val_in%l_val)))
754 val_out%l_val = val_in%l_val
755 END IF
756 IF (ASSOCIATED(val_in%i_val)) THEN
757 ALLOCATE (val_out%i_val(SIZE(val_in%i_val)))
758 val_out%i_val = val_in%i_val
759 END IF
760 IF (ASSOCIATED(val_in%r_val)) THEN
761 ALLOCATE (val_out%r_val(SIZE(val_in%r_val)))
762 val_out%r_val = val_in%r_val
763 END IF
764 IF (ASSOCIATED(val_in%c_val)) THEN
765 ALLOCATE (val_out%c_val(SIZE(val_in%c_val)))
766 val_out%c_val = val_in%c_val
767 END IF
768
769 END SUBROUTINE val_duplicate
770
771END 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:125
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:1108
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:1193
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:1251
cp_units::cp_unit_create
subroutine, public cp_unit_create(unit, string)
creates a unit parsing a string
Definition cp_units.F:168
cp_units::cp_unit_release
elemental subroutine, public cp_unit_release(unit)
releases the given unit
Definition cp_units.F:566
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:740
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:480
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:654
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
cp_units::cp_unit_type
stores a unit
Definition cp_units.F:137
input_enumeration_types::enumeration_type
Definition input_enumeration_types.F:43
input_val_types::val_p_type
pointer to a val, to create arrays of pointers
Definition input_val_types.F:49
input_val_types::val_type
a type to have a wrapper that stores any basic fortran type
Definition input_val_types.F:63