add getoptionr4*

Author: AlexandreMary

src/fiat/util/xrd_getoptions.F90

@@ -7,7 +7,7 @@ MODULE XRD_GETOPTIONS
 !      Philippe Marguinaud *METEO FRANCE*
 !      Original : 11-09-2012
 
-USE EC_PARKIND, ONLY: JPIM, JPRD
+USE EC_PARKIND, ONLY: JPIM, JPRD, JPRM
 
 USE XRD_UNIX_ENV, ONLY: XRD_IARGC, XRD_GETARG, &
   XRD_BASENAME, XRD_COUNTWORDS, XRD_GETENV,    &
@@ -18,6 +18,7 @@ MODULE XRD_GETOPTIONS
 INTERFACE GETOPTION
   MODULE PROCEDURE GETOPTIONS, GETOPTIONSL, &
                    GETOPTIONI, GETOPTIONIL, &
+                   GETOPTIONR4, GETOPTIONR4L, &
                    GETOPTIONR8, GETOPTIONR8L, &
                    GETOPTIONB
 
@@ -513,6 +514,41 @@ SUBROUTINE GETOPTIONI( KEY, VAL, MND, USE )
 
 END SUBROUTINE GETOPTIONI
 
+SUBROUTINE GETOPTIONR4( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*),   INTENT(IN)  :: KEY
+ REAL(KIND=JPRM), INTENT(INOUT) :: VAL
+ LOGICAL(KIND=JPIM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ CHARACTER(LEN=ARGSIZEMAX) :: SVAL
+ INTEGER :: ERR
+ LOGICAL(KIND=JPIM) :: LSHELL1
+
+ LSHELL1 = LSHELL
+ 
+ IF( LHELP ) THEN
+   CALL ADDOPT( KEY, 'REAL', USE )
+   RETURN
+ ELSE IF( LSHELL ) THEN
+   LSHELL = .FALSE.
+   CALL ADDOPT_SHELL( KEY, 'REAL', MND, USE )
+ ENDIF
+ 
+ SVAL = ""
+ CALL GETOPTIONS( KEY, SVAL, MND, USE )
+ IF( TRIM( SVAL ) .NE. "" ) THEN
+   READ( SVAL, *, IOSTAT = ERR ) VAL
+   IF( ERR .NE. 0 ) THEN
+     PRINT *, "ERROR WHILE PARSING OPTION "//TRIM(KEY)
+     CALL XRD_EXIT(1_JPIM)
+   ENDIF
+ ENDIF
+
+ LSHELL = LSHELL1
+
+END SUBROUTINE GETOPTIONR4
+
 SUBROUTINE GETOPTIONR8( KEY, VAL, MND, USE )
 !
  CHARACTER(LEN=*),   INTENT(IN)  :: KEY
@@ -742,6 +778,51 @@ SUBROUTINE GETOPTIONIL( KEY, VAL, MND, USE )
 
 END SUBROUTINE GETOPTIONIL
 
+SUBROUTINE GETOPTIONR4L( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*),   INTENT(IN) :: KEY
+ REAL(KIND=JPRM), POINTER    :: VAL(:)
+ LOGICAL(KIND=JPIM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ CHARACTER(LEN=ARGSIZEMAX), POINTER :: SVAL(:)
+ INTEGER(KIND=JPIM) :: I, N
+ INTEGER :: ERR
+ LOGICAL(KIND=JPIM) :: LSHELL1
+
+ NULLIFY (SVAL)
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+   CALL ADDOPT( KEY, 'REAL-LIST', USE )
+   RETURN
+ ELSE IF( LSHELL ) THEN
+   LSHELL = .FALSE.
+   CALL ADDOPT_SHELL( KEY, 'REAL-LIST', MND, USE )
+ ENDIF
+ 
+ CALL GETOPTIONSL( KEY, SVAL, MND, USE )
+
+ IF( .NOT. ASSOCIATED( SVAL ) ) GOTO 999
+
+ N = SIZE( SVAL )
+ ALLOCATE( VAL( N ) )
+ DO I = 1, N
+   READ( SVAL( I ), *, IOSTAT = ERR ) VAL( I )
+   IF( ERR .NE. 0 ) THEN
+     PRINT *, "ERROR WHILE PARSING OPTION "//TRIM(KEY)
+     CALL XRD_EXIT(1_JPIM)
+   ENDIF
+ ENDDO
+
+ DEALLOCATE( SVAL )
+
+999 CONTINUE
+ LSHELL = LSHELL1
+
+END SUBROUTINE GETOPTIONR4L
+
 SUBROUTINE GETOPTIONR8L( KEY, VAL, MND, USE )
 !
  CHARACTER(LEN=*),   INTENT(IN) :: KEY