LCOV - code coverage report
Current view: top level - src/input - input_val_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:b1c14e6) Lines: 245 335 73.1 %
Date: 2022-07-02 11:36:49 Functions: 5 9 55.6 %

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

Generated by: LCOV version 1.15