(git:374b731)
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-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! **************************************************************************************************
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("")
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
768END 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
cp_units::cp_unit_type
stores a unit
Definition cp_units.F:132
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