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.
This commit is contained in:
Matthias Krack 2023-05-17 19:04:02 +02:00
parent a8a26f8278
commit acc1b77f41
3 changed files with 67 additions and 14 deletions

View file

@ -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,10 +1248,11 @@ CONTAINS
!> \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)
@ -1258,11 +1260,16 @@ CONTAINS
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 @@ CONTAINS
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

View file

@ -657,7 +657,7 @@ CONTAINS
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)

View file

@ -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