LCOV - code coverage report
Current view: top level - src/input - input_val_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:5d0137b) Lines: 239 333 71.8 %
Date: 2024-03-01 06:31:42 Functions: 5 9 55.6 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief a wrapper for basic fortran types.
      10             : !> \par History
      11             : !>      06.2004 created
      12             : !> \author fawzi
      13             : ! **************************************************************************************************
      14             : MODULE input_val_types
      15             : 
      16             :    USE cp_parser_types,                 ONLY: default_continuation_character
      17             :    USE cp_units,                        ONLY: cp_unit_create,&
      18             :                                               cp_unit_desc,&
      19             :                                               cp_unit_from_cp2k,&
      20             :                                               cp_unit_from_cp2k1,&
      21             :                                               cp_unit_release,&
      22             :                                               cp_unit_type
      23             :    USE input_enumeration_types,         ONLY: enum_i2c,&
      24             :                                               enum_release,&
      25             :                                               enum_retain,&
      26             :                                               enumeration_type
      27             :    USE kinds,                           ONLY: default_string_length,&
      28             :                                               dp
      29             : #include "../base/base_uses.f90"
      30             : 
      31             :    IMPLICIT NONE
      32             :    PRIVATE
      33             : 
      34             :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      35             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_val_types'
      36             : 
      37             :    PUBLIC :: val_p_type, val_type
      38             :    PUBLIC :: val_create, val_retain, val_release, val_get, val_write, &
      39             :              val_write_internal, val_duplicate
      40             : 
      41             :    INTEGER, PARAMETER, PUBLIC :: no_t = 0, logical_t = 1, &
      42             :                                  integer_t = 2, real_t = 3, char_t = 4, enum_t = 5, lchar_t = 6
      43             : 
      44             : ! **************************************************************************************************
      45             : !> \brief pointer to a val, to create arrays of pointers
      46             : !> \param val to pointer to the val
      47             : !> \author fawzi
      48             : ! **************************************************************************************************
      49             :    TYPE val_p_type
      50             :       TYPE(val_type), POINTER :: val => NULL()
      51             :    END TYPE val_p_type
      52             : 
      53             : ! **************************************************************************************************
      54             : !> \brief a type to  have a wrapper that stores any basic fortran type
      55             : !> \param type_of_var type stored in the val (should be one of no_t,
      56             : !>        integer_t, logical_t, real_t, char_t)
      57             : !> \param l_val , i_val, c_val, r_val: arrays with logical,integer,character
      58             : !>        or real values. Only one should be associated (and namely the one
      59             : !>        specified in type_of_var).
      60             : !> \param enum an enumaration to map char to integers
      61             : !> \author fawzi
      62             : ! **************************************************************************************************
      63             :    TYPE val_type
      64             :       INTEGER :: ref_count = 0, type_of_var = no_t
      65             :       LOGICAL, DIMENSION(:), POINTER :: l_val => NULL()
      66             :       INTEGER, DIMENSION(:), POINTER :: i_val => NULL()
      67             :       CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: &
      68             :          c_val => NULL()
      69             :       REAL(kind=dp), DIMENSION(:), POINTER :: r_val => NULL()
      70             :       TYPE(enumeration_type), POINTER :: enum => NULL()
      71             :    END TYPE val_type
      72             : CONTAINS
      73             : 
      74             : ! **************************************************************************************************
      75             : !> \brief creates a keyword value
      76             : !> \param val the object to be created
      77             : !> \param l_val ,i_val,r_val,c_val,lc_val: a logical,integer,real,string, long
      78             : !>        string to be stored in the val
      79             : !> \param l_vals , i_vals, r_vals, c_vals: an array of logicals,
      80             : !>        integers, reals, characters, long strings to be stored in val
      81             : !> \param l_vals_ptr , i_vals_ptr, r_vals_ptr, c_vals_ptr: an array of logicals,
      82             : !>        ... to be stored in val, val will get the ownership of the pointer
      83             : !> \param i_val ...
      84             : !> \param i_vals ...
      85             : !> \param i_vals_ptr ...
      86             : !> \param r_val ...
      87             : !> \param r_vals ...
      88             : !> \param r_vals_ptr ...
      89             : !> \param c_val ...
      90             : !> \param c_vals ...
      91             : !> \param c_vals_ptr ...
      92             : !> \param lc_val ...
      93             : !> \param lc_vals ...
      94             : !> \param lc_vals_ptr ...
      95             : !> \param enum the enumaration type this value is using
      96             : !> \author fawzi
      97             : !> \note
      98             : !>      using an enumeration only i_val/i_vals/i_vals_ptr are accepted
      99             : ! **************************************************************************************************
     100  1049411773 :    SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, &
     101  2098789106 :                          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  1049394553 :       CPASSERT(.NOT. ASSOCIATED(val))
     129  1049394553 :       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  1049394553 :       val%ref_count = 1
     133             : 
     134  1049394553 :       narg = 0
     135             :       val%type_of_var = no_t
     136  1049394553 :       IF (PRESENT(l_val)) THEN
     137   130791263 :          narg = narg + 1
     138   130791263 :          ALLOCATE (val%l_val(1))
     139   130791263 :          val%l_val(1) = l_val
     140   130791263 :          val%type_of_var = logical_t
     141             :       END IF
     142  1049394553 :       IF (PRESENT(l_vals)) THEN
     143       17220 :          narg = narg + 1
     144       51660 :          ALLOCATE (val%l_val(SIZE(l_vals)))
     145       34440 :          val%l_val = l_vals
     146       17220 :          val%type_of_var = logical_t
     147             :       END IF
     148  1049394553 :       IF (PRESENT(l_vals_ptr)) THEN
     149       17300 :          narg = narg + 1
     150       17300 :          val%l_val => l_vals_ptr
     151       17300 :          val%type_of_var = logical_t
     152             :       END IF
     153             : 
     154  1049394553 :       IF (PRESENT(r_val)) THEN
     155   286246857 :          narg = narg + 1
     156   286246857 :          ALLOCATE (val%r_val(1))
     157   286246857 :          val%r_val(1) = r_val
     158   286246857 :          val%type_of_var = real_t
     159             :       END IF
     160  1049394553 :       IF (PRESENT(r_vals)) THEN
     161     1163204 :          narg = narg + 1
     162     3489612 :          ALLOCATE (val%r_val(SIZE(r_vals)))
     163     4459830 :          val%r_val = r_vals
     164     1163204 :          val%type_of_var = real_t
     165             :       END IF
     166  1049394553 :       IF (PRESENT(r_vals_ptr)) THEN
     167      996714 :          narg = narg + 1
     168      996714 :          val%r_val => r_vals_ptr
     169      996714 :          val%type_of_var = real_t
     170             :       END IF
     171             : 
     172  1049394553 :       IF (PRESENT(i_val)) THEN
     173   151589283 :          narg = narg + 1
     174   151589283 :          ALLOCATE (val%i_val(1))
     175   151589283 :          val%i_val(1) = i_val
     176   151589283 :          val%type_of_var = integer_t
     177             :       END IF
     178  1049394553 :       IF (PRESENT(i_vals)) THEN
     179     1550462 :          narg = narg + 1
     180     4651386 :          ALLOCATE (val%i_val(SIZE(i_vals)))
     181     5529126 :          val%i_val = i_vals
     182     1550462 :          val%type_of_var = integer_t
     183             :       END IF
     184  1049394553 :       IF (PRESENT(i_vals_ptr)) THEN
     185      167451 :          narg = narg + 1
     186      167451 :          val%i_val => i_vals_ptr
     187      167451 :          val%type_of_var = integer_t
     188             :       END IF
     189             : 
     190  1049394553 :       IF (PRESENT(c_val)) THEN
     191     1796689 :          CPASSERT(LEN_TRIM(c_val) <= default_string_length)
     192     1796689 :          narg = narg + 1
     193     1796689 :          ALLOCATE (val%c_val(1))
     194     1796689 :          val%c_val(1) = c_val
     195     1796689 :          val%type_of_var = char_t
     196             :       END IF
     197  1049394553 :       IF (PRESENT(c_vals)) THEN
     198      344226 :          CPASSERT(ALL(LEN_TRIM(c_vals) <= default_string_length))
     199      117608 :          narg = narg + 1
     200      352824 :          ALLOCATE (val%c_val(SIZE(c_vals)))
     201      344226 :          val%c_val = c_vals
     202      117608 :          val%type_of_var = char_t
     203             :       END IF
     204  1049394553 :       IF (PRESENT(c_vals_ptr)) THEN
     205       72924 :          narg = narg + 1
     206       72924 :          val%c_val => c_vals_ptr
     207       72924 :          val%type_of_var = char_t
     208             :       END IF
     209  1049394553 :       IF (PRESENT(lc_val)) THEN
     210     8208607 :          narg = narg + 1
     211     8208607 :          len_c = LEN_TRIM(lc_val)
     212     8208607 :          nVal = MAX(1, CEILING(REAL(len_c, dp)/80._dp))
     213    24625821 :          ALLOCATE (val%c_val(nVal))
     214             : 
     215     8208607 :          IF (len_c == 0) THEN
     216     2354012 :             val%c_val(1) = ""
     217             :          ELSE
     218    13445814 :             DO i = 1, nVal
     219             :                val%c_val(i) = lc_val((i - 1)*default_string_length + 1: &
     220    13445814 :                                      MIN(len_c, i*default_string_length))
     221             :             END DO
     222             :          END IF
     223     8208607 :          val%type_of_var = lchar_t
     224             :       END IF
     225  1049394553 :       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  1049394553 :       IF (PRESENT(lc_vals_ptr)) THEN
     233      261655 :          narg = narg + 1
     234      261655 :          val%c_val => lc_vals_ptr
     235      261655 :          val%type_of_var = lchar_t
     236             :       END IF
     237  1049394553 :       CPASSERT(narg <= 1)
     238  1049394553 :       IF (PRESENT(enum)) THEN
     239  1046342518 :          IF (ASSOCIATED(enum)) THEN
     240    40160185 :             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    40160185 :             IF (ASSOCIATED(val%i_val)) THEN
     245    25879921 :                val%type_of_var = enum_t
     246    25879921 :                val%enum => enum
     247    25879921 :                CALL enum_retain(enum)
     248             :             END IF
     249             :          END IF
     250             :       END IF
     251             : 
     252  1049394553 :       CPASSERT(ASSOCIATED(val%enum) .EQV. val%type_of_var == enum_t)
     253             : 
     254  1049394553 :    END SUBROUTINE val_create
     255             : 
     256             : ! **************************************************************************************************
     257             : !> \brief releases the given val
     258             : !> \param val the val to release
     259             : !> \author fawzi
     260             : ! **************************************************************************************************
     261  1515873976 :    SUBROUTINE val_release(val)
     262             : 
     263             :       TYPE(val_type), POINTER                            :: val
     264             : 
     265  1515873976 :       IF (ASSOCIATED(val)) THEN
     266  1049476660 :          CPASSERT(val%ref_count > 0)
     267  1049476660 :          val%ref_count = val%ref_count - 1
     268  1049476660 :          IF (val%ref_count == 0) THEN
     269  1049476660 :             IF (ASSOCIATED(val%l_val)) THEN
     270   130830572 :                DEALLOCATE (val%l_val)
     271             :             END IF
     272  1049476660 :             IF (ASSOCIATED(val%i_val)) THEN
     273   153321894 :                DEALLOCATE (val%i_val)
     274             :             END IF
     275  1049476660 :             IF (ASSOCIATED(val%r_val)) THEN
     276   288428151 :                DEALLOCATE (val%r_val)
     277             :             END IF
     278  1049476660 :             IF (ASSOCIATED(val%c_val)) THEN
     279    10498727 :                DEALLOCATE (val%c_val)
     280             :             END IF
     281  1049476660 :             CALL enum_release(val%enum)
     282  1049476660 :             val%type_of_var = no_t
     283  1049476660 :             DEALLOCATE (val)
     284             :          END IF
     285             :       END IF
     286             : 
     287  1515873976 :       NULLIFY (val)
     288             : 
     289  1515873976 :    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    33341917 :    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    33341917 :       IF (PRESENT(has_i)) has_i = ASSOCIATED(val%i_val)
     352    33341917 :       IF (PRESENT(has_r)) has_r = ASSOCIATED(val%r_val)
     353    33341917 :       IF (PRESENT(has_c)) has_c = ASSOCIATED(val%c_val) ! use type_of_var?
     354    33341917 :       IF (PRESENT(has_lc)) has_lc = (val%type_of_var == lchar_t)
     355    33341917 :       IF (PRESENT(l_vals)) l_vals => val%l_val
     356    33341917 :       IF (PRESENT(l_val)) THEN
     357     3908981 :          IF (ASSOCIATED(val%l_val)) THEN
     358     3908981 :             IF (SIZE(val%l_val) > 0) THEN
     359     3908981 :                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    33341917 :       IF (PRESENT(i_vals)) i_vals => val%i_val
     369    33341917 :       IF (PRESENT(i_val)) THEN
     370    24735482 :          IF (ASSOCIATED(val%i_val)) THEN
     371    24735482 :             IF (SIZE(val%i_val) > 0) THEN
     372    24735482 :                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    33341917 :       IF (PRESENT(r_vals)) r_vals => val%r_val
     382    33341917 :       IF (PRESENT(r_val)) THEN
     383     2241655 :          IF (ASSOCIATED(val%r_val)) THEN
     384     2241655 :             IF (SIZE(val%r_val) > 0) THEN
     385     2241655 :                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    33341917 :       IF (PRESENT(c_vals)) c_vals => val%c_val
     395    33341917 :       IF (PRESENT(c_val)) THEN
     396     1915281 :          l_out = LEN(c_val)
     397     1915281 :          IF (ASSOCIATED(val%c_val)) THEN
     398     1912173 :             IF (SIZE(val%c_val) > 0) THEN
     399     1912173 :                IF (val%type_of_var == lchar_t) THEN
     400             :                   l_in = default_string_length*(SIZE(val%c_val) - 1) + &
     401     1317293 :                          LEN_TRIM(val%c_val(SIZE(val%c_val)))
     402     1317293 :                   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     1771369 :                   DO i = 1, SIZE(val%c_val)
     407             :                      c_val((i - 1)*default_string_length + 1:MIN(l_out, i*default_string_length)) = &
     408     1348734 :                         val%c_val(i) (1:MIN(80, l_out - (i - 1)*default_string_length))
     409     1771369 :                      IF (l_out <= i*default_string_length) EXIT
     410             :                   END DO
     411     1317293 :                   IF (l_out > SIZE(val%c_val)*default_string_length) &
     412      422635 :                      c_val(SIZE(val%c_val)*default_string_length + 1:l_out) = ""
     413             :                ELSE
     414      594880 :                   l_in = LEN_TRIM(val%c_val(1))
     415      594880 :                   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      594880 :                   c_val = val%c_val(1)
     420             :                END IF
     421             :             ELSE
     422           0 :                CPABORT("")
     423             :             END IF
     424        3108 :          ELSE IF (ASSOCIATED(val%i_val) .AND. ASSOCIATED(val%enum)) THEN
     425        3108 :             IF (SIZE(val%i_val) > 0) THEN
     426        3108 :                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    33341917 :       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    33341917 :       IF (PRESENT(type_of_var)) type_of_var = val%type_of_var
     459             : 
     460    33341917 :       IF (PRESENT(enum)) enum => val%enum
     461             : 
     462    33341917 :    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     1886584 :    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     1886584 :       NULLIFY (my_unit)
     489     1886584 :       myfmt = ""
     490     1886584 :       owns_unit = .FALSE.
     491             : 
     492     1886564 :       IF (PRESENT(fmt)) myfmt = fmt
     493     1886584 :       IF (PRESENT(unit)) my_unit => unit
     494     1886584 :       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     1886584 :       IF (ASSOCIATED(val)) THEN
     501     1936023 :          SELECT CASE (val%type_of_var)
     502             :          CASE (logical_t)
     503       49439 :             IF (ASSOCIATED(val%l_val)) THEN
     504       98878 :                DO i = 1, SIZE(val%l_val)
     505       49439 :                   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       98878 :                      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      105449 :             IF (ASSOCIATED(val%i_val)) THEN
     517             :                item = 0
     518             :                i = 1
     519      251570 :                loop_i: DO WHILE (i <= SIZE(val%i_val))
     520      146121 :                   item = item + 1
     521      146121 :                   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      146121 :                   iend = i
     526      199814 :                   loop_j: DO j = i + 1, SIZE(val%i_val)
     527      199814 :                      IF (val%i_val(j - 1) + 1 == val%i_val(j)) THEN
     528       53693 :                         iend = iend + 1
     529             :                      ELSE
     530             :                         EXIT loop_j
     531             :                      END IF
     532             :                   END DO loop_j
     533      146121 :                   IF ((iend - i) > 1) THEN
     534             :                      WRITE (UNIT=unit_nr, FMT="(1X,I0,A2,I0)", ADVANCE="NO") &
     535        4620 :                         val%i_val(i), "..", val%i_val(iend)
     536        4620 :                      i = iend
     537             :                   ELSE
     538             :                      WRITE (UNIT=unit_nr, FMT="(1X,I0)", ADVANCE="NO") &
     539      141501 :                         val%i_val(i)
     540             :                   END IF
     541      251570 :                   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      676463 :             IF (ASSOCIATED(val%r_val)) THEN
     548     4044409 :                DO i = 1, SIZE(val%r_val)
     549     3367946 :                   IF (MODULO(i, 5) == 0) THEN
     550      362274 :                      WRITE (UNIT=unit_nr, FMT="(1X,A)") default_continuation_character
     551      362274 :                      WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
     552             :                   END IF
     553     3367946 :                   IF (ASSOCIATED(my_unit)) THEN
     554             :                      WRITE (UNIT=rcval, FMT="(ES25.16E3)") &
     555      203629 :                         cp_unit_from_cp2k1(val%r_val(i), my_unit)
     556             :                   ELSE
     557     3164317 :                      WRITE (UNIT=rcval, FMT="(ES25.16E3)") val%r_val(i)
     558             :                   END IF
     559     4044409 :                   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       42494 :             IF (ASSOCIATED(val%c_val)) THEN
     566       42494 :                l = 0
     567      102029 :                DO i = 1, SIZE(val%c_val)
     568       59535 :                   l = l + 1
     569      102029 :                   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       59535 :                   ELSE IF (LEN_TRIM(val%c_val(i)) > 0) THEN
     576       59422 :                      l = l + LEN_TRIM(val%c_val(i))
     577       59422 :                      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      887192 :             IF (ASSOCIATED(val%c_val)) THEN
     588      957430 :                SELECT CASE (SIZE(val%c_val))
     589             :                CASE (1)
     590       70238 :                   WRITE (UNIT=unit_nr, FMT='(1X,A)', ADVANCE="NO") TRIM(val%c_val(1))
     591             :                CASE (2)
     592      804036 :                   WRITE (UNIT=unit_nr, FMT='(1X,A)', ADVANCE="NO") val%c_val(1)
     593      804036 :                   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      900110 :                   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      125547 :             IF (ASSOCIATED(val%i_val)) THEN
     606      125547 :                l = 0
     607      251094 :                DO i = 1, SIZE(val%i_val)
     608      125547 :                   c_string = enum_i2c(val%enum, val%i_val(i))
     609      125547 :                   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      125547 :                      l = l + LEN_TRIM(c_string) + 3
     615             :                   END IF
     616      251094 :                   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     1886584 :             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     1886584 :       IF (owns_unit) THEN
     631           0 :          CALL cp_unit_release(my_unit)
     632           0 :          DEALLOCATE (my_unit)
     633             :       END IF
     634             : 
     635     1886584 :       WRITE (UNIT=unit_nr, FMT="()")
     636             : 
     637     1886584 :    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       82107 :    SUBROUTINE val_duplicate(val_in, val_out)
     737             : 
     738             :       TYPE(val_type), POINTER                            :: val_in, val_out
     739             : 
     740       82107 :       CPASSERT(ASSOCIATED(val_in))
     741       82107 :       CPASSERT(.NOT. ASSOCIATED(val_out))
     742       82107 :       ALLOCATE (val_out)
     743       82107 :       val_out%type_of_var = val_in%type_of_var
     744       82107 :       val_out%ref_count = 1
     745       82107 :       val_out%enum => val_in%enum
     746       82107 :       IF (ASSOCIATED(val_out%enum)) CALL enum_retain(val_out%enum)
     747             : 
     748       82107 :       NULLIFY (val_out%l_val, val_out%i_val, val_out%c_val, val_out%r_val)
     749       82107 :       IF (ASSOCIATED(val_in%l_val)) THEN
     750       14367 :          ALLOCATE (val_out%l_val(SIZE(val_in%l_val)))
     751       19156 :          val_out%l_val = val_in%l_val
     752             :       END IF
     753       82107 :       IF (ASSOCIATED(val_in%i_val)) THEN
     754       44094 :          ALLOCATE (val_out%i_val(SIZE(val_in%i_val)))
     755       67960 :          val_out%i_val = val_in%i_val
     756             :       END IF
     757       82107 :       IF (ASSOCIATED(val_in%r_val)) THEN
     758       64128 :          ALLOCATE (val_out%r_val(SIZE(val_in%r_val)))
     759      115500 :          val_out%r_val = val_in%r_val
     760             :       END IF
     761       82107 :       IF (ASSOCIATED(val_in%c_val)) THEN
     762      123732 :          ALLOCATE (val_out%c_val(SIZE(val_in%c_val)))
     763      167124 :          val_out%c_val = val_in%c_val
     764             :       END IF
     765             : 
     766       82107 :    END SUBROUTINE val_duplicate
     767             : 
     768           0 : END MODULE input_val_types

Generated by: LCOV version 1.15