LCOV - code coverage report
Current view: top level - src/input - input_val_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 71.8 % 333 239
Test Date: 2025-07-25 12:55:17 Functions: 55.6 % 9 5

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 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   1302994491 :    SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, &
     101   2605953198 :                          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   1302976599 :       CPASSERT(.NOT. ASSOCIATED(val))
     129   1302976599 :       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   1302976599 :       val%ref_count = 1
     133              : 
     134   1302976599 :       narg = 0
     135              :       val%type_of_var = no_t
     136   1302976599 :       IF (PRESENT(l_val)) THEN
     137    166007703 :          narg = narg + 1
     138    166007703 :          ALLOCATE (val%l_val(1))
     139    166007703 :          val%l_val(1) = l_val
     140    166007703 :          val%type_of_var = logical_t
     141              :       END IF
     142   1302976599 :       IF (PRESENT(l_vals)) THEN
     143        17892 :          narg = narg + 1
     144        53676 :          ALLOCATE (val%l_val(SIZE(l_vals)))
     145        35784 :          val%l_val = l_vals
     146        17892 :          val%type_of_var = logical_t
     147              :       END IF
     148   1302976599 :       IF (PRESENT(l_vals_ptr)) THEN
     149        19582 :          narg = narg + 1
     150        19582 :          val%l_val => l_vals_ptr
     151        19582 :          val%type_of_var = logical_t
     152              :       END IF
     153              : 
     154   1302976599 :       IF (PRESENT(r_val)) THEN
     155    369379815 :          narg = narg + 1
     156    369379815 :          ALLOCATE (val%r_val(1))
     157    369379815 :          val%r_val(1) = r_val
     158    369379815 :          val%type_of_var = real_t
     159              :       END IF
     160   1302976599 :       IF (PRESENT(r_vals)) THEN
     161      1457852 :          narg = narg + 1
     162      4373556 :          ALLOCATE (val%r_val(SIZE(r_vals)))
     163      5535920 :          val%r_val = r_vals
     164      1457852 :          val%type_of_var = real_t
     165              :       END IF
     166   1302976599 :       IF (PRESENT(r_vals_ptr)) THEN
     167      1000282 :          narg = narg + 1
     168      1000282 :          val%r_val => r_vals_ptr
     169      1000282 :          val%type_of_var = real_t
     170              :       END IF
     171              : 
     172   1302976599 :       IF (PRESENT(i_val)) THEN
     173    174861419 :          narg = narg + 1
     174    174861419 :          ALLOCATE (val%i_val(1))
     175    174861419 :          val%i_val(1) = i_val
     176    174861419 :          val%type_of_var = integer_t
     177              :       END IF
     178   1302976599 :       IF (PRESENT(i_vals)) THEN
     179      1837366 :          narg = narg + 1
     180      5512098 :          ALLOCATE (val%i_val(SIZE(i_vals)))
     181      6563636 :          val%i_val = i_vals
     182      1837366 :          val%type_of_var = integer_t
     183              :       END IF
     184   1302976599 :       IF (PRESENT(i_vals_ptr)) THEN
     185       176797 :          narg = narg + 1
     186       176797 :          val%i_val => i_vals_ptr
     187       176797 :          val%type_of_var = integer_t
     188              :       END IF
     189              : 
     190   1302976599 :       IF (PRESENT(c_val)) THEN
     191      2294551 :          CPASSERT(LEN_TRIM(c_val) <= default_string_length)
     192      2294551 :          narg = narg + 1
     193      2294551 :          ALLOCATE (val%c_val(1))
     194      2294551 :          val%c_val(1) = c_val
     195      2294551 :          val%type_of_var = char_t
     196              :       END IF
     197   1302976599 :       IF (PRESENT(c_vals)) THEN
     198       444104 :          CPASSERT(ALL(LEN_TRIM(c_vals) <= default_string_length))
     199       157346 :          narg = narg + 1
     200       472038 :          ALLOCATE (val%c_val(SIZE(c_vals)))
     201       444104 :          val%c_val = c_vals
     202       157346 :          val%type_of_var = char_t
     203              :       END IF
     204   1302976599 :       IF (PRESENT(c_vals_ptr)) THEN
     205        75564 :          narg = narg + 1
     206        75564 :          val%c_val => c_vals_ptr
     207        75564 :          val%type_of_var = char_t
     208              :       END IF
     209   1302976599 :       IF (PRESENT(lc_val)) THEN
     210      9133225 :          narg = narg + 1
     211      9133225 :          len_c = LEN_TRIM(lc_val)
     212      9133225 :          nVal = MAX(1, CEILING(REAL(len_c, dp)/80._dp))
     213     27399675 :          ALLOCATE (val%c_val(nVal))
     214              : 
     215      9133225 :          IF (len_c == 0) THEN
     216      2642770 :             val%c_val(1) = ""
     217              :          ELSE
     218     14714030 :             DO i = 1, nVal
     219              :                val%c_val(i) = lc_val((i - 1)*default_string_length + 1: &
     220     14714030 :                                      MIN(len_c, i*default_string_length))
     221              :             END DO
     222              :          END IF
     223      9133225 :          val%type_of_var = lchar_t
     224              :       END IF
     225   1302976599 :       IF (PRESENT(lc_vals)) THEN
     226            0 :          CPASSERT(ALL(LEN_TRIM(lc_vals) <= default_string_length))
     227            0 :          narg = narg + 1
     228            0 :          ALLOCATE (val%c_val(SIZE(lc_vals)))
     229            0 :          val%c_val = lc_vals
     230            0 :          val%type_of_var = lchar_t
     231              :       END IF
     232   1302976599 :       IF (PRESENT(lc_vals_ptr)) THEN
     233       266351 :          narg = narg + 1
     234       266351 :          val%c_val => lc_vals_ptr
     235       266351 :          val%type_of_var = lchar_t
     236              :       END IF
     237   1302976599 :       CPASSERT(narg <= 1)
     238   1302976599 :       IF (PRESENT(enum)) THEN
     239   1299910156 :          IF (ASSOCIATED(enum)) THEN
     240     46723851 :             IF (val%type_of_var /= no_t .AND. val%type_of_var /= integer_t .AND. &
     241              :                 val%type_of_var /= enum_t) THEN
     242            0 :                CPABORT("")
     243              :             END IF
     244     46723851 :             IF (ASSOCIATED(val%i_val)) THEN
     245     30070774 :                val%type_of_var = enum_t
     246     30070774 :                val%enum => enum
     247     30070774 :                CALL enum_retain(enum)
     248              :             END IF
     249              :          END IF
     250              :       END IF
     251              : 
     252   1302976599 :       CPASSERT(ASSOCIATED(val%enum) .EQV. val%type_of_var == enum_t)
     253              : 
     254   1302976599 :    END SUBROUTINE val_create
     255              : 
     256              : ! **************************************************************************************************
     257              : !> \brief releases the given val
     258              : !> \param val the val to release
     259              : !> \author fawzi
     260              : ! **************************************************************************************************
     261   1879349221 :    SUBROUTINE val_release(val)
     262              : 
     263              :       TYPE(val_type), POINTER                            :: val
     264              : 
     265   1879349221 :       IF (ASSOCIATED(val)) THEN
     266   1303058367 :          CPASSERT(val%ref_count > 0)
     267   1303058367 :          val%ref_count = val%ref_count - 1
     268   1303058367 :          IF (val%ref_count == 0) THEN
     269   1303058367 :             IF (ASSOCIATED(val%l_val)) THEN
     270    166049703 :                DEALLOCATE (val%l_val)
     271              :             END IF
     272   1303058367 :             IF (ASSOCIATED(val%i_val)) THEN
     273    176890032 :                DEALLOCATE (val%i_val)
     274              :             END IF
     275   1303058367 :             IF (ASSOCIATED(val%r_val)) THEN
     276    371859407 :                DEALLOCATE (val%r_val)
     277              :             END IF
     278   1303058367 :             IF (ASSOCIATED(val%c_val)) THEN
     279     11968371 :                DEALLOCATE (val%c_val)
     280              :             END IF
     281   1303058367 :             CALL enum_release(val%enum)
     282   1303058367 :             val%type_of_var = no_t
     283   1303058367 :             DEALLOCATE (val)
     284              :          END IF
     285              :       END IF
     286              : 
     287   1879349221 :       NULLIFY (val)
     288              : 
     289   1879349221 :    END SUBROUTINE val_release
     290              : 
     291              : ! **************************************************************************************************
     292              : !> \brief retains the given val
     293              : !> \param val the val to retain
     294              : !> \author fawzi
     295              : ! **************************************************************************************************
     296            0 :    SUBROUTINE val_retain(val)
     297              : 
     298              :       TYPE(val_type), POINTER                            :: val
     299              : 
     300            0 :       CPASSERT(ASSOCIATED(val))
     301            0 :       CPASSERT(val%ref_count > 0)
     302            0 :       val%ref_count = val%ref_count + 1
     303              : 
     304            0 :    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     36182620 :    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            0 :       IF (PRESENT(has_l)) has_l = ASSOCIATED(val%l_val)
     351     36182620 :       IF (PRESENT(has_i)) has_i = ASSOCIATED(val%i_val)
     352     36182620 :       IF (PRESENT(has_r)) has_r = ASSOCIATED(val%r_val)
     353     36182620 :       IF (PRESENT(has_c)) has_c = ASSOCIATED(val%c_val) ! use type_of_var?
     354     36182620 :       IF (PRESENT(has_lc)) has_lc = (val%type_of_var == lchar_t)
     355     36182620 :       IF (PRESENT(l_vals)) l_vals => val%l_val
     356     36182620 :       IF (PRESENT(l_val)) THEN
     357      4845822 :          IF (ASSOCIATED(val%l_val)) THEN
     358      4845822 :             IF (SIZE(val%l_val) > 0) THEN
     359      4845822 :                l_val = val%l_val(1)
     360              :             ELSE
     361            0 :                CPABORT("")
     362              :             END IF
     363              :          ELSE
     364            0 :             CPABORT("")
     365              :          END IF
     366              :       END IF
     367              : 
     368     36182620 :       IF (PRESENT(i_vals)) i_vals => val%i_val
     369     36182620 :       IF (PRESENT(i_val)) THEN
     370     25894290 :          IF (ASSOCIATED(val%i_val)) THEN
     371     25894290 :             IF (SIZE(val%i_val) > 0) THEN
     372     25894290 :                i_val = val%i_val(1)
     373              :             ELSE
     374            0 :                CPABORT("")
     375              :             END IF
     376              :          ELSE
     377            0 :             CPABORT("")
     378              :          END IF
     379              :       END IF
     380              : 
     381     36182620 :       IF (PRESENT(r_vals)) r_vals => val%r_val
     382     36182620 :       IF (PRESENT(r_val)) THEN
     383      2819256 :          IF (ASSOCIATED(val%r_val)) THEN
     384      2819256 :             IF (SIZE(val%r_val) > 0) THEN
     385      2819256 :                r_val = val%r_val(1)
     386              :             ELSE
     387            0 :                CPABORT("")
     388              :             END IF
     389              :          ELSE
     390            0 :             CPABORT("")
     391              :          END IF
     392              :       END IF
     393              : 
     394     36182620 :       IF (PRESENT(c_vals)) c_vals => val%c_val
     395     36182620 :       IF (PRESENT(c_val)) THEN
     396      2029974 :          l_out = LEN(c_val)
     397      2029974 :          IF (ASSOCIATED(val%c_val)) THEN
     398      2026598 :             IF (SIZE(val%c_val) > 0) THEN
     399      2026598 :                IF (val%type_of_var == lchar_t) THEN
     400              :                   l_in = default_string_length*(SIZE(val%c_val) - 1) + &
     401      1326605 :                          LEN_TRIM(val%c_val(SIZE(val%c_val)))
     402      1326605 :                   IF (l_out < l_in) &
     403              :                      CALL cp_warn(__LOCATION__, &
     404              :                                   "val_get will truncate value, value beginning with '"// &
     405            0 :                                   TRIM(val%c_val(1))//"' is too long for variable")
     406      1795110 :                   DO i = 1, SIZE(val%c_val)
     407              :                      c_val((i - 1)*default_string_length + 1:MIN(l_out, i*default_string_length)) = &
     408      1358080 :                         val%c_val(i) (1:MIN(80, l_out - (i - 1)*default_string_length))
     409      1795110 :                      IF (l_out <= i*default_string_length) EXIT
     410              :                   END DO
     411      1326605 :                   IF (l_out > SIZE(val%c_val)*default_string_length) &
     412       437030 :                      c_val(SIZE(val%c_val)*default_string_length + 1:l_out) = ""
     413              :                ELSE
     414       699993 :                   l_in = LEN_TRIM(val%c_val(1))
     415       699993 :                   IF (l_out < l_in) &
     416              :                      CALL cp_warn(__LOCATION__, &
     417              :                                   "val_get will truncate value, value '"// &
     418            0 :                                   TRIM(val%c_val(1))//"' is too long for variable")
     419       699993 :                   c_val = val%c_val(1)
     420              :                END IF
     421              :             ELSE
     422            0 :                CPABORT("")
     423              :             END IF
     424         3376 :          ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
     425         3376 :             IF (SIZE(val%i_val) > 0) THEN
     426         3376 :                c_val = enum_i2c(val%enum, val%i_val(1))
     427              :             ELSE
     428            0 :                CPABORT("")
     429              :             END IF
     430              :          ELSE
     431            0 :             CPABORT("")
     432              :          END IF
     433              :       END IF
     434              : 
     435     36182620 :       IF (PRESENT(len_c)) THEN
     436            0 :          IF (ASSOCIATED(val%c_val)) THEN
     437            0 :             IF (SIZE(val%c_val) > 0) THEN
     438            0 :                IF (val%type_of_var == lchar_t) THEN
     439              :                   len_c = default_string_length*(SIZE(val%c_val) - 1) + &
     440            0 :                           LEN_TRIM(val%c_val(SIZE(val%c_val)))
     441              :                ELSE
     442            0 :                   len_c = LEN_TRIM(val%c_val(1))
     443              :                END IF
     444              :             ELSE
     445            0 :                len_c = -HUGE(0)
     446              :             END IF
     447            0 :          ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
     448            0 :             IF (SIZE(val%i_val) > 0) THEN
     449            0 :                len_c = LEN_TRIM(enum_i2c(val%enum, val%i_val(1)))
     450              :             ELSE
     451            0 :                len_c = -HUGE(0)
     452              :             END IF
     453              :          ELSE
     454            0 :             len_c = -HUGE(0)
     455              :          END IF
     456              :       END IF
     457              : 
     458     36182620 :       IF (PRESENT(type_of_var)) type_of_var = val%type_of_var
     459              : 
     460     36182620 :       IF (PRESENT(enum)) enum => val%enum
     461              : 
     462     36182620 :    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      1889211 :    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      1889211 :       NULLIFY (my_unit)
     489      1889211 :       myfmt = ""
     490      1889211 :       owns_unit = .FALSE.
     491              : 
     492      1889191 :       IF (PRESENT(fmt)) myfmt = fmt
     493      1889211 :       IF (PRESENT(unit)) my_unit => unit
     494      1889211 :       IF (.NOT. ASSOCIATED(my_unit) .AND. PRESENT(unit_str)) THEN
     495            0 :          ALLOCATE (my_unit)
     496            0 :          CALL cp_unit_create(my_unit, unit_str)
     497            0 :          owns_unit = .TRUE.
     498              :       END IF
     499              : 
     500      1889211 :       IF (ASSOCIATED(val)) THEN
     501      1938763 :          SELECT CASE (val%type_of_var)
     502              :          CASE (logical_t)
     503        49552 :             IF (ASSOCIATED(val%l_val)) THEN
     504        99104 :                DO i = 1, SIZE(val%l_val)
     505        49552 :                   IF (MODULO(i, 20) == 0) THEN
     506            0 :                      WRITE (UNIT=unit_nr, FMT="(1X,A1)") default_continuation_character
     507            0 :                      WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
     508              :                   END IF
     509              :                   WRITE (UNIT=unit_nr, FMT="(1X,L1)", ADVANCE="NO") &
     510        99104 :                      val%l_val(i)
     511              :                END DO
     512              :             ELSE
     513            0 :                CPABORT("Input value of type <logical_t> not associated")
     514              :             END IF
     515              :          CASE (integer_t)
     516       106672 :             IF (ASSOCIATED(val%i_val)) THEN
     517              :                item = 0
     518              :                i = 1
     519       254207 :                loop_i: DO WHILE (i <= SIZE(val%i_val))
     520       147535 :                   item = item + 1
     521       147535 :                   IF (MODULO(item, 10) == 0) THEN
     522           23 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)") default_continuation_character
     523           23 :                      WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
     524              :                   END IF
     525       147535 :                   iend = i
     526       201085 :                   loop_j: DO j = i + 1, SIZE(val%i_val)
     527       201085 :                      IF (val%i_val(j - 1) + 1 == val%i_val(j)) THEN
     528        53550 :                         iend = iend + 1
     529              :                      ELSE
     530              :                         EXIT loop_j
     531              :                      END IF
     532              :                   END DO loop_j
     533       147535 :                   IF ((iend - i) > 1) THEN
     534              :                      WRITE (UNIT=unit_nr, FMT="(1X,I0,A2,I0)", ADVANCE="NO") &
     535         4610 :                         val%i_val(i), "..", val%i_val(iend)
     536         4610 :                      i = iend
     537              :                   ELSE
     538              :                      WRITE (UNIT=unit_nr, FMT="(1X,I0)", ADVANCE="NO") &
     539       142925 :                         val%i_val(i)
     540              :                   END IF
     541       254207 :                   i = i + 1
     542              :                END DO loop_i
     543              :             ELSE
     544            0 :                CPABORT("Input value of type <integer_t> not associated")
     545              :             END IF
     546              :          CASE (real_t)
     547       677029 :             IF (ASSOCIATED(val%r_val)) THEN
     548      4046002 :                DO i = 1, SIZE(val%r_val)
     549      3368973 :                   IF (MODULO(i, 5) == 0) THEN
     550       362278 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)") default_continuation_character
     551       362278 :                      WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
     552              :                   END IF
     553      3368973 :                   IF (ASSOCIATED(my_unit)) THEN
     554              :                      WRITE (UNIT=rcval, FMT="(ES25.16E3)") &
     555       204058 :                         cp_unit_from_cp2k1(val%r_val(i), my_unit)
     556              :                   ELSE
     557      3164915 :                      WRITE (UNIT=rcval, FMT="(ES25.16E3)") val%r_val(i)
     558              :                   END IF
     559      4046002 :                   WRITE (UNIT=unit_nr, FMT="(A)", ADVANCE="NO") TRIM(rcval)
     560              :                END DO
     561              :             ELSE
     562            0 :                CPABORT("Input value of type <real_t> not associated")
     563              :             END IF
     564              :          CASE (char_t)
     565        42774 :             IF (ASSOCIATED(val%c_val)) THEN
     566        42774 :                l = 0
     567       102643 :                DO i = 1, SIZE(val%c_val)
     568        59869 :                   l = l + 1
     569       102643 :                   IF (l > 10 .AND. l + LEN_TRIM(val%c_val(i)) > 76) THEN
     570            0 :                      WRITE (UNIT=unit_nr, FMT="(A1)") default_continuation_character
     571            0 :                      WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
     572            0 :                      l = 0
     573            0 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)", ADVANCE="NO") """"//TRIM(val%c_val(i))//""""
     574            0 :                      l = l + LEN_TRIM(val%c_val(i)) + 3
     575        59869 :                   ELSE IF (LEN_TRIM(val%c_val(i)) > 0) THEN
     576        59756 :                      l = l + LEN_TRIM(val%c_val(i))
     577        59756 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)", ADVANCE="NO") """"//TRIM(val%c_val(i))//""""
     578              :                   ELSE
     579          113 :                      l = l + 3
     580          113 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)", ADVANCE="NO") '""'
     581              :                   END IF
     582              :                END DO
     583              :             ELSE
     584            0 :                CPABORT("Input value of type <char_t> not associated")
     585              :             END IF
     586              :          CASE (lchar_t)
     587       885877 :             IF (ASSOCIATED(val%c_val)) THEN
     588       956494 :                SELECT CASE (SIZE(val%c_val))
     589              :                CASE (1)
     590        70617 :                   WRITE (UNIT=unit_nr, FMT='(1X,A)', ADVANCE="NO") TRIM(val%c_val(1))
     591              :                CASE (2)
     592       802342 :                   WRITE (UNIT=unit_nr, FMT='(1X,A)', ADVANCE="NO") val%c_val(1)
     593       802342 :                   WRITE (UNIT=unit_nr, FMT='(A)', ADVANCE="NO") TRIM(val%c_val(2))
     594              :                CASE (3:)
     595        12918 :                   WRITE (UNIT=unit_nr, FMT='(1X,A)', ADVANCE="NO") val%c_val(1)
     596        64551 :                   DO i = 2, SIZE(val%c_val) - 1
     597        64551 :                      WRITE (UNIT=unit_nr, FMT="(A)", ADVANCE="NO") val%c_val(i)
     598              :                   END DO
     599       898795 :                   WRITE (UNIT=unit_nr, FMT='(A)', ADVANCE="NO") TRIM(val%c_val(SIZE(val%c_val)))
     600              :                END SELECT
     601              :             ELSE
     602            0 :                CPABORT("Input value of type <lchar_t> not associated")
     603              :             END IF
     604              :          CASE (enum_t)
     605       127307 :             IF (ASSOCIATED(val%i_val)) THEN
     606       127307 :                l = 0
     607       254614 :                DO i = 1, SIZE(val%i_val)
     608       127307 :                   c_string = enum_i2c(val%enum, val%i_val(i))
     609       127307 :                   IF (l > 10 .AND. l + LEN_TRIM(c_string) > 76) THEN
     610            0 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)") default_continuation_character
     611            0 :                      WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
     612            0 :                      l = 0
     613              :                   ELSE
     614       127307 :                      l = l + LEN_TRIM(c_string) + 3
     615              :                   END IF
     616       254614 :                   WRITE (UNIT=unit_nr, FMT="(1X,A)", ADVANCE="NO") TRIM(c_string)
     617              :                END DO
     618              :             ELSE
     619            0 :                CPABORT("Input value of type <enum_t> not associated")
     620              :             END IF
     621              :          CASE (no_t)
     622            0 :             WRITE (UNIT=unit_nr, FMT="(' *empty*')", ADVANCE="NO")
     623              :          CASE default
     624      1889211 :             CPABORT("Unexpected type_of_var for val")
     625              :          END SELECT
     626              :       ELSE
     627            0 :          WRITE (UNIT=unit_nr, FMT="(1X,A)", ADVANCE="NO") "NULL()"
     628              :       END IF
     629              : 
     630      1889211 :       IF (owns_unit) THEN
     631            0 :          CALL cp_unit_release(my_unit)
     632            0 :          DEALLOCATE (my_unit)
     633              :       END IF
     634              : 
     635      1889211 :       WRITE (UNIT=unit_nr, FMT="()")
     636              : 
     637      1889211 :    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            0 :    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            0 :       string = ""
     661              : 
     662            0 :       IF (ASSOCIATED(val)) THEN
     663              : 
     664            0 :          SELECT CASE (val%type_of_var)
     665              :          CASE (logical_t)
     666            0 :             IF (ASSOCIATED(val%l_val)) THEN
     667            0 :                DO i = 1, SIZE(val%l_val)
     668            0 :                   WRITE (UNIT=string(2*i - 1:), FMT="(1X,L1)") val%l_val(i)
     669              :                END DO
     670              :             ELSE
     671            0 :                CPABORT("")
     672              :             END IF
     673              :          CASE (integer_t)
     674            0 :             IF (ASSOCIATED(val%i_val)) THEN
     675            0 :                DO i = 1, SIZE(val%i_val)
     676            0 :                   WRITE (UNIT=string(12*i - 11:), FMT="(I12)") val%i_val(i)
     677              :                END DO
     678              :             ELSE
     679            0 :                CPABORT("")
     680              :             END IF
     681              :          CASE (real_t)
     682            0 :             IF (ASSOCIATED(val%r_val)) THEN
     683            0 :                IF (PRESENT(unit)) THEN
     684            0 :                   DO i = 1, SIZE(val%r_val)
     685              :                      value = cp_unit_from_cp2k(value=val%r_val(i), &
     686            0 :                                                unit_str=cp_unit_desc(unit=unit))
     687            0 :                      WRITE (UNIT=string(17*i - 16:), FMT="(ES17.8E3)") value
     688              :                   END DO
     689              :                ELSE
     690            0 :                   DO i = 1, SIZE(val%r_val)
     691            0 :                      WRITE (UNIT=string(17*i - 16:), FMT="(ES17.8E3)") val%r_val(i)
     692              :                   END DO
     693              :                END IF
     694              :             ELSE
     695            0 :                CPABORT("")
     696              :             END IF
     697              :          CASE (char_t)
     698            0 :             IF (ASSOCIATED(val%c_val)) THEN
     699            0 :                ipos = 1
     700            0 :                DO i = 1, SIZE(val%c_val)
     701            0 :                   WRITE (UNIT=string(ipos:), FMT="(A)") TRIM(ADJUSTL(val%c_val(i)))
     702            0 :                   ipos = ipos + LEN_TRIM(ADJUSTL(val%c_val(i))) + 1
     703              :                END DO
     704              :             ELSE
     705            0 :                CPABORT("")
     706              :             END IF
     707              :          CASE (lchar_t)
     708            0 :             IF (ASSOCIATED(val%c_val)) THEN
     709            0 :                CALL val_get(val, c_val=string)
     710              :             ELSE
     711            0 :                CPABORT("")
     712              :             END IF
     713              :          CASE (enum_t)
     714            0 :             IF (ASSOCIATED(val%i_val)) THEN
     715            0 :                DO i = 1, SIZE(val%i_val)
     716            0 :                   enum_string = enum_i2c(val%enum, val%i_val(i))
     717            0 :                   WRITE (UNIT=string, FMT="(A)") TRIM(ADJUSTL(enum_string))
     718              :                END DO
     719              :             ELSE
     720            0 :                CPABORT("")
     721              :             END IF
     722              :          CASE default
     723            0 :             CPABORT("unexpected type_of_var for val ")
     724              :          END SELECT
     725              : 
     726              :       END IF
     727              : 
     728            0 :    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        81768 :    SUBROUTINE val_duplicate(val_in, val_out)
     737              : 
     738              :       TYPE(val_type), POINTER                            :: val_in, val_out
     739              : 
     740        81768 :       CPASSERT(ASSOCIATED(val_in))
     741        81768 :       CPASSERT(.NOT. ASSOCIATED(val_out))
     742        81768 :       ALLOCATE (val_out)
     743        81768 :       val_out%type_of_var = val_in%type_of_var
     744        81768 :       val_out%ref_count = 1
     745        81768 :       val_out%enum => val_in%enum
     746        81768 :       IF (ASSOCIATED(val_out%enum)) CALL enum_retain(val_out%enum)
     747              : 
     748        81768 :       NULLIFY (val_out%l_val, val_out%i_val, val_out%c_val, val_out%r_val)
     749        81768 :       IF (ASSOCIATED(val_in%l_val)) THEN
     750        13578 :          ALLOCATE (val_out%l_val(SIZE(val_in%l_val)))
     751        18104 :          val_out%l_val = val_in%l_val
     752              :       END IF
     753        81768 :       IF (ASSOCIATED(val_in%i_val)) THEN
     754        43350 :          ALLOCATE (val_out%i_val(SIZE(val_in%i_val)))
     755        66968 :          val_out%i_val = val_in%i_val
     756              :       END IF
     757        81768 :       IF (ASSOCIATED(val_in%r_val)) THEN
     758        64374 :          ALLOCATE (val_out%r_val(SIZE(val_in%r_val)))
     759       115844 :          val_out%r_val = val_in%r_val
     760              :       END IF
     761        81768 :       IF (ASSOCIATED(val_in%c_val)) THEN
     762       124002 :          ALLOCATE (val_out%c_val(SIZE(val_in%c_val)))
     763       167500 :          val_out%c_val = val_in%c_val
     764              :       END IF
     765              : 
     766        81768 :    END SUBROUTINE val_duplicate
     767              : 
     768            0 : END MODULE input_val_types
        

Generated by: LCOV version 2.0-1