Enable parsing of simple functions

The functions COS, EXP, LOG, LOG10, SIN, SQRT, and TAN can be used with one optionally signed integer or float number as argument.
cp2k · May 21, 2023 · acc1b77 · acc1b77
1 parent a8a26f8
commit acc1b77
Show file tree

Hide file tree

Showing 3 changed files with 67 additions and 14 deletions.
diff --git a/src/input/cp_parser_methods.F b/src/input/cp_parser_methods.F
@@ -36,6 +36,7 @@ MODULE cp_parser_methods
                                               dp,&
                                               int_8,&
                                               max_line_length
+   USE mathconstants,                   ONLY: radians
    USE message_passing,                 ONLY: mp_para_env_type
    USE string_utilities,                ONLY: is_whitespace,&
                                               uppercase
@@ -1247,22 +1248,28 @@ END SUBROUTINE parser_get_string
 !> \param object ...
 !> \param error_message ...
 !> \date    11.01.2011 (MK)
+!> \par History
+!>      - Add simple function parsing (17.05.2023, MK)
 !> \author  Matthias Krack
-!> \version 1.0
-!> \note - Parse also multiple products and fractions of floating point
-!>            numbers (23.11.2012,MK)
+!> \version 2.0
+!> \note - Parse also multiple products and fractions of floating point numbers (23.11.2012,MK)
 ! **************************************************************************************************
    ELEMENTAL SUBROUTINE read_float_object(string, object, error_message)
 
       CHARACTER(LEN=*), INTENT(IN)                       :: string
       REAL(KIND=dp), INTENT(OUT)                         :: object
       CHARACTER(LEN=*), INTENT(OUT)                      :: error_message
 
-      INTEGER                                            :: i, iop, islash, istar, istat, n
+      INTEGER, PARAMETER                                 :: maxlen = 5
+
+      CHARACTER(LEN=maxlen)                              :: func
+      INTEGER                                            :: i, ileft, iop, iright, is, islash, &
+                                                            istar, istat, n
       LOGICAL                                            :: parsing_done
-      REAL(KIND=dp)                                      :: z
+      REAL(KIND=dp)                                      :: fsign, z
 
       error_message = ""
+      func = ""
 
       i = 1
       iop = 0
@@ -1285,11 +1292,55 @@ ELEMENTAL SUBROUTINE read_float_object(string, object, error_message)
          ELSE IF (istar > 0) THEN
             iop = istar
          END IF
-         READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z
-         IF (istat /= 0) THEN
-            error_message = "A floating point type object was expected, found <"// &
-                            string(i:i + iop - 2)//">"
-            RETURN
+         ileft = INDEX(string(i:MIN(n, i + maxlen + 1)), "(")
+         IF (ileft > 0) THEN
+            ! Check for sign
+            is = ICHAR(string(i:i))
+            SELECT CASE (is)
+            CASE (43)
+               fsign = 1.0_dp
+               func = string(i + 1:i + ileft - 2)
+            CASE (45)
+               fsign = -1.0_dp
+               func = string(i + 1:i + ileft - 2)
+            CASE DEFAULT
+               fsign = 1.0_dp
+               func = string(i:i + ileft - 2)
+            END SELECT
+            iright = INDEX(string(i:n), ")")
+            READ (UNIT=string(i + ileft:i + iright - 2), FMT=*, IOSTAT=istat) z
+            IF (istat /= 0) THEN
+               error_message = "A floating point type object as argument for function <"// &
+                               TRIM(func)//"> is expected, found <"// &
+                               string(i + ileft:i + iright - 2)//">"
+               RETURN
+            END IF
+            SELECT CASE (func)
+            CASE ("COS")
+               z = fsign*COS(z*radians)
+            CASE ("EXP")
+               z = fsign*EXP(z)
+            CASE ("LOG")
+               z = fsign*LOG(z)
+            CASE ("LOG10")
+               z = fsign*LOG10(z)
+            CASE ("SIN")
+               z = fsign*SIN(z*radians)
+            CASE ("SQRT")
+               z = fsign*SQRT(z)
+            CASE ("TAN")
+               z = fsign*TAN(z*radians)
+            CASE DEFAULT
+               error_message = "Unknown function <"//TRIM(func)//"> found"
+               RETURN
+            END SELECT
+         ELSE
+            READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z
+            IF (istat /= 0) THEN
+               error_message = "A floating point type object was expected, found <"// &
+                               string(i:i + iop - 2)//">"
+               RETURN
+            END IF
          END IF
          IF (i == 1) THEN
             object = z

diff --git a/src/input/input_parsing.F b/src/input/input_parsing.F
@@ -657,7 +657,7 @@ SUBROUTINE get_r_val(r_val, parser, unit, default_units, c_val)
             CALL parser_get_object(parser, c_val)
             IF (c_val(1:1) /= "[" .OR. c_val(LEN_TRIM(c_val):LEN_TRIM(c_val)) /= "]") THEN
                CALL cp_abort(__LOCATION__, &
-                             "Invalid unit specifier found when parsing a number: "// &
+                             "Invalid unit specifier or function found when parsing a number: "// &
                              c_val)
             END IF
             ALLOCATE (my_unit)

diff --git a/tests/Fist/regtest-13/Si_nosym_hexagonal.inp b/tests/Fist/regtest-13/Si_nosym_hexagonal.inp
@@ -35,12 +35,14 @@
  &END MM
  &SUBSYS
   &CELL
-   A  3.850/2 -3.850*${Sqrt3}/2      0
-   B  3.850/2  3.850*${Sqrt3}/2      0
-   C        0                 0  6.366
+   # Test function parsing
+   A -3.85000/-2  -3.85*+SQRT(3.000e00)/2                                      COS(+9.E001)
+   B +3.850/+2.0  -0.385E1*-TAN(+6E+01)/2                                      -LOG(01)/-10
+   C     -SIN(0)                 +000/342  +LOG10(+0.10)*6.366*+EXP(-00.000)/-COS(0.000E-5)
    MULTIPLE_UNIT_CELL 3 3 3
    PERIODIC XYZ
    &CELL_REF
+    # CELL and CELL_REF should coincide if parsing works
     A  3.850/2 -3.850*${Sqrt3}/2      0
     B  3.850/2  3.850*${Sqrt3}/2      0
     C        0                 0  6.366