xrd_getoptions.F90

Go to the documentation of this file.

MODULE xrd_getoptions

!**** *XRD_GETOPTIONS*  - Parse command lines options in long form

!     Author. 
!     ------- 
!      Philippe Marguinaud *METEO FRANCE*
!      Original : 11-09-2012

USE parkind1, ONLY: jpim, jprb, jplm

USE xrd_unix_env, ONLY: xrd_iargc, xrd_getarg, &
  xrd_basename, xrd_countwords, xrd_getenv,    &
  xrd_isalpha, xrd_isdigit, xrd_exit

IMPLICIT NONE

INTERFACE getoption
  MODULE PROCEDURE getoptions, getoptionsl, &
                   getoptioni, getoptionil, &
                   getoptionr, getoptionrl, &
                   getoptionb
                   
END INTERFACE

!! @TODO : LIST WITH FIXED SIZE

PUBLIC :: getoption, initoptions, checkoptions, addgroup

INTEGER, PARAMETER :: argsizemax = 256

CHARACTER(LEN=ARGSIZEMAX), POINTER :: myargs(:) => null()
LOGICAL(KIND=JPLM), POINTER :: check_args(:) => null()
LOGICAL(KIND=JPLM) :: lhelp  = .false., lshell = .false.

CHARACTER(LEN=1056) :: message_opt = ""


TYPE xrd_opt
  CHARACTER(LEN=32) :: key, type
  CHARACTER(LEN=1024) :: use
  LOGICAL(KIND=JPLM) :: group = .false.
END TYPE

INTEGER(KIND=JPIM) :: nopt_seen
TYPE(xrd_opt), POINTER :: opt_seen(:) => null()

PRIVATE

CONTAINS

SUBROUTINE addgroup( USE )
CHARACTER(LEN=*), INTENT(IN) :: USE

CALL init_opt_seen()
nopt_seen = nopt_seen + 1
CALL grow_opt_seen()

opt_seen(nopt_seen)%GROUP = .true.
opt_seen(nopt_seen)%USE = use


END SUBROUTINE addgroup

CHARACTER(LEN=ARGSIZEMAX) FUNCTION get_env_opt( KEY )
CHARACTER(LEN=*), INTENT(IN) :: KEY
CHARACTER(LEN=ARGSIZEMAX) :: KEY_ENV, VAL_ENV
INTEGER(KIND=JPIM) :: I, N
CHARACTER :: C

key_env = key(3:)

n = len(trim(key_env))
DO i = 1, n
  c = key_env(i:i)
  IF((.NOT.xrd_isalpha(c)) .AND. &
     (.NOT.xrd_isdigit(c)) .AND. &
     (c .NE. '_' )) THEN
    key_env(i:i) = '_'
  ENDIF
ENDDO

val_env = ""
CALL xrd_getenv( 'XRD_OPT_'//trim(key_env), val_env )

!PRINT *, " KEY = ", TRIM(KEY_ENV), " VAL = ", TRIM(VAL_ENV)

get_env_opt = val_env

END FUNCTION get_env_opt

SUBROUTINE mygetarg( I, S )
  INTEGER(KIND=JPIM), INTENT(IN)  :: I
  CHARACTER(LEN=*),      INTENT(OUT) :: S
!
  IF( i .LE. ubound( myargs, 1 ) ) THEN
    s = myargs(i)
  ELSE
    s = ""
   ENDIF
END SUBROUTINE mygetarg

INTEGER FUNCTION myiargc()
  INTEGER :: N
  n = ubound( myargs, 1 )
  myiargc = n
END FUNCTION myiargc

SUBROUTINE addopt_shell( KEY, TYPE, MND, USE )
  CHARACTER*(*), INTENT(IN) :: KEY, TYPE, USE
  LOGICAL(KIND=JPLM), INTENT(IN) :: MND
  OPTIONAL :: use, mnd
!
  CHARACTER(LEN=ARGSIZEMAX) :: STR
  INTEGER :: NN, N, N1, I1, I2, K
  CHARACTER(LEN=ARGSIZEMAX), POINTER :: MYARGS1(:)

  myargs1 => null()

  IF( PRESENT( USE ) ) write( *, '("> ",A)' ) trim(use)
  IF( PRESENT( mnd ) ) THEN
    IF( mnd ) WRITE( *, * ) "[MANDATORY]"
  ENDIF 
  WRITE( *, * ) "* OPTION: [", TYPE, "]", " ", TRIM(key)
  READ( *, '(A)' ) str

! PRINT *, "STR = ",TRIM(STR)
  IF( trim(str) .NE. "" )  THEN
    IF( TYPE .EQ. 'FLAG' ) then
      nn = 0
    ELSE
      nn = xrd_countwords( str )
    ENDIF
    n  = ubound( myargs, 1 )
    n1 = n + nn + 1

!
! REALLOC MYARGS
!
    ALLOCATE( myargs1(0:n1) )
    myargs1(0:n) = myargs(0:n)
    DEALLOCATE( myargs )
    myargs => myargs1
    myargs(n+1) = key

!
! PARSE ARGUMENT LIST
!
    IF( TYPE .NE. 'FLAG' ) then
      k = 1
      i1 = 1
      loop_i1 : DO 
        DO
          IF( i1 .GT. len(str)) EXIT loop_i1
          IF( str(i1:i1) .NE. ' ' ) EXIT
          i1 = i1+1
        ENDDO
        i2 = i1+1
        DO
          IF( i2 .GT. len(str)) EXIT
          IF( str(i2:i2) .EQ. ' ' ) EXIT
          i2 = i2+1
        ENDDO
!PRINT *, I1, I2
        myargs(n+1+k) = str(i1:i2-1)
!PRINT *, K, TRIM(MYARGS(N+1+K))
        k = k+1
        i1 = i2+1
      ENDDO loop_i1
    ENDIF
  ENDIF

END SUBROUTINE addopt_shell

SUBROUTINE init_opt_seen()

  IF( .NOT. ASSOCIATED( opt_seen ) ) THEN
    nopt_seen = 0
    ALLOCATE( opt_seen( 32 ) )
  ENDIF

END SUBROUTINE init_opt_seen

SUBROUTINE grow_opt_seen()
  INTEGER(KIND=JPIM) :: N
  TYPE(xrd_opt), POINTER :: OPT_SEEN1(:)

  n = SIZE( opt_seen )
  IF( nopt_seen .GE. n ) THEN ! REALLOC DATA
    opt_seen1 => opt_seen
    ALLOCATE( opt_seen( 2 * n ) )
    opt_seen(1:nopt_seen) = opt_seen1(1:nopt_seen)
    DEALLOCATE( opt_seen1 )
  ENDIF

END SUBROUTINE grow_opt_seen

SUBROUTINE addopt( KEY, TYPE, USE )
  CHARACTER*(*), INTENT(IN) :: KEY, TYPE, USE
  OPTIONAL :: use

  CALL init_opt_seen()

  nopt_seen = nopt_seen + 1

  CALL grow_opt_seen()

  opt_seen(nopt_seen)%KEY  = key
  opt_seen(nopt_seen)%TYPE = TYPE

  IF( PRESENT( USE ) ) then
    opt_seen(nopt_seen)%USE  = use
  ELSE
    opt_seen(nopt_seen)%USE  = ''
  ENDIF

END SUBROUTINE addopt

SUBROUTINE initoptions( CDMESSAGE, KOPTMIN, KOPTMAX, CDARGS )
 CHARACTER(LEN=*),    OPTIONAL, INTENT (IN) :: CDMESSAGE
 INTEGER (KIND=JPIM), OPTIONAL, INTENT (IN) :: KOPTMIN, KOPTMAX
 CHARACTER (LEN=*),   OPTIONAL, INTENT (IN) :: CDARGS (0:)
 INTEGER(KIND=JPIM) :: N, I
 INTEGER(KIND=JPIM) :: IOPTMIN, IOPTMAX
 CHARACTER*32 :: STR

 IF (PRESENT (cdargs)) THEN
   n = ubound(cdargs, 1)
 ELSE
   n = xrd_iargc()
 ENDIF

 ioptmin = 0
 ioptmax = n
 IF (PRESENT (koptmin)) ioptmin = koptmin
 IF (PRESENT (koptmax)) ioptmax = koptmax

 n = ioptmax-ioptmin

 ALLOCATE( myargs(0:n) )
 DO i = 0, n
   IF (PRESENT (cdargs)) THEN
     myargs(i) = cdargs(ioptmin+i)
   ELSE
     CALL xrd_getarg( ioptmin+i, myargs(i) )
   ENDIF
 ENDDO

 IF( PRESENT( cdmessage ) ) THEN
  message_opt = cdmessage
 ELSE
  message_opt = ""
 ENDIF

 IF( n .EQ. 1 ) THEN
   CALL mygetarg( 1_jpim, str )
   IF( trim( str ) .EQ. '--help' ) THEN
     lhelp = .true.
     RETURN
   ELSE IF( trim( str ) .EQ. '--shell' ) THEN
     lshell = .true.
     RETURN
   ENDIF
 ENDIF

 lhelp = .false.
 ALLOCATE( check_args( n ) )
 check_args = .false.

END SUBROUTINE initoptions



SUBROUTINE checkoptions()
 INTEGER(KIND=JPIM) :: I, N, IS, NS, KS
 CHARACTER(LEN=ARGSIZEMAX) :: OPT, PROG
 LOGICAL(KIND=JPLM) :: PB
 CHARACTER(LEN=10) :: FMT
 CHARACTER(LEN=110) :: BUF

 CALL mygetarg( 0_jpim, prog )

 IF( lhelp ) THEN
   print *, "PROGRAM: ", trim(xrd_basename( prog ))
   IF( trim(message_opt) .NE. "" ) THEN
     ns = len(message_opt)
     DO is = 1, ns / 96
       ks = len( trim(message_opt(1+(is-1)*96:is*96)) )
       IF( ks .GT. 0 ) THEN
         IF( is .EQ. 1 ) THEN
           WRITE( *, '("    ")', advance = 'NO' )
         ELSE
           WRITE( *, '("  > ")', advance = 'NO' )
         ENDIF
         WRITE( fmt, '("(A",I2,")")' ) ks
         WRITE( *, fmt ) trim(message_opt(1+(is-1)*96:is*96))
       ENDIF
     ENDDO
   ENDIF
   DO i = 1, nopt_seen

     IF(opt_seen(i)%GROUP) THEN
       WRITE( *, * ) 
       IF( trim(opt_seen(i)%USE) .NE. "" ) &
         WRITE( *, * ) '* '//trim(opt_seen(i)%USE)
       cycle
     ENDIF

     buf = ""

     WRITE( buf, '(A32," = ",A15)' ) &
         trim(opt_seen(i)%KEY), &
         trim(opt_seen(i)%TYPE)

     IF( trim(opt_seen(i)%USE) .NE. '' ) THEN
       ns = len( opt_seen(i)%USE) 
       DO is = 1, ns / 48
         ks = len(trim(opt_seen(i)%USE(1+(is-1)*48:is*48)))
         IF( ks .GT. 0 ) THEN
           IF( is .EQ. 1 ) THEN
             buf = trim(buf)//" :   "//trim(opt_seen(i)%USE(1+(is-1)*48:is*48))
           ELSE
!                   000000000011111111112222222222333333333344444444445555555555
!                   012345678901234567890123456789012345678901234567890123456789
             buf = "                                                     > "&
                   //trim(opt_seen(i)%USE(1+(is-1)*48:is*48))
           ENDIF
           WRITE( *, '(A120)' ) buf
         ENDIF
       ENDDO
     ELSE
       WRITE( *, '(A120)' ) buf
       WRITE( *, * )
     ENDIF

   ENDDO
   stop
 ELSE IF( ASSOCIATED( check_args ) ) THEN
   n = SIZE( check_args )
   pb = .false.
   DO i = 1, n
     IF( .NOT. check_args(i) ) THEN
       CALL mygetarg( i, opt )
       IF( opt(1:2) .EQ. '--' ) THEN
         print *, 'INVALID OPTION: ', trim(opt)
         pb = .true.
         check_args(i) = .true.
       ENDIF
     ENDIF
   ENDDO

   DO i = 1, n
     IF( .NOT. check_args(i) ) THEN
       CALL mygetarg( i, opt )
       print *, 'GARBAGE IN OPTIONS:`', trim(opt), "'"
       pb = .true.
       EXIT
     ENDIF
   ENDDO

   IF( pb ) CALL xrd_exit(1_jpim)

   DEALLOCATE( check_args )
 ELSE IF( lshell ) THEN
   OPEN( 77, file = trim(prog)//'.sh', form = 'FORMATTED' )
   WRITE( 77, '("#!/bin/sh")' )
   WRITE( 77, * )
   WRITE( 77, '(A)', advance = 'NO' ) trim(prog)
   n = ubound( myargs, 1 )
   DO i = 1, n
     IF( myargs(i) .EQ. '--shell' ) cycle
     IF( myargs(i)(1:2) .EQ. '--' ) THEN
       WRITE( 77, '(" \")' )
       WRITE( 77, '("    ")', advance = 'NO' )
     ENDIF
     WRITE( 77, '(" ",A)', advance = 'NO' ) trim(myargs(i))
   ENDDO
   WRITE( 77, * )
   CLOSE(77)
 ENDIF



 IF( ASSOCIATED( opt_seen ) ) DEALLOCATE( opt_seen )
 IF( ASSOCIATED( myargs ) ) DEALLOCATE( myargs )
END SUBROUTINE checkoptions


SUBROUTINE check_mnd( KEY, MND, USE )
 CHARACTER(LEN=*),           INTENT(IN) :: KEY
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
 LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
!
 CHARACTER(LEN=ARGSIZEMAX) :: PROG

 IF( PRESENT( mnd ) ) THEN
   IF( mnd ) THEN
     CALL mygetarg( 0_jpim, prog )
     WRITE( *, '("PROGRAM: ",(A))' ) trim( prog )
     WRITE( *, '("ERROR:   OPTION `",(A),"'' IS MANDATORY")' ) trim( key )
     IF( PRESENT( USE ) ) write( *, '("         ",(A)," : ",(A))' ) trim( key ), trim( use )
     CALL xrd_exit(1_jpim)
   ENDIF
 ENDIF

END SUBROUTINE check_mnd

SUBROUTINE findargindex( KEY, I, N )
 CHARACTER(LEN=*),      INTENT(IN)  :: KEY
 INTEGER(KIND=JPIM), INTENT(OUT) :: I, N
 CHARACTER(LEN=ARGSIZEMAX) :: ARG

 n = myiargc()
 DO i = 1, n
   CALL mygetarg( i, arg )
   IF( trim( arg ) .EQ. trim( key ) ) RETURN
 ENDDO
 i = -1_jpim
END SUBROUTINE findargindex

SUBROUTINE findnextargindex( I, J )
 INTEGER(KIND=JPIM), INTENT(IN)  :: I
 INTEGER(KIND=JPIM), INTENT(OUT) :: J
!
 CHARACTER(LEN=ARGSIZEMAX) :: ARG
 INTEGER(KIND=JPIM) :: N

 n = myiargc()
 DO j = i+1, n
  CALL mygetarg( j, arg )
  IF( arg(1:2) .EQ. '--' ) EXIT
 ENDDO

END SUBROUTINE findnextargindex

SUBROUTINE getoptions( KEY, VAL, MND, USE )
!
 CHARACTER(LEN=*), INTENT(IN)  :: KEY
 CHARACTER(LEN=*), INTENT(INOUT) :: VAL
 LOGICAL(KIND=JPLM), INTENT(IN), OPTIONAL :: MND
 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: USE
!
 INTEGER(KIND=JPIM) :: I, N
 CHARACTER(LEN=ARGSIZEMAX) :: ARG
 LOGICAL(KIND=JPLM) :: LSHELL1
 LOGICAL(KIND=JPLM) :: FOUND

 lshell1 = lshell

 IF( lhelp ) THEN
   CALL addopt( key, 'STRING', USE )
   RETURN
 ELSE IF( lshell ) THEN
   lshell = .false.
   CALL addopt_shell( key, 'STRING', mnd, USE )
 ENDIF

 CALL findargindex( key, i, n )

 found = ( 0 .LT. i ) .AND. ( i .LT. n )

 IF( found ) THEN
   IF( ASSOCIATED( check_args ) ) THEN
     check_args(i)   = .true.
     check_args(i+1) = .true.
   ENDIF
   CALL mygetarg( i+1_jpim, val )
 ELSE
   arg = get_env_opt( key )
   found = arg .NE. ""
   IF( found ) val = arg
 ENDIF

 IF( .NOT. found ) &
   CALL check_mnd( key, mnd, USE )

 lshell = lshell1

END SUBROUTINE getoptions

SUBROUTINE getoptioni( KEY, VAL, MND, USE )
!
 CHARACTER(LEN=*),      INTENT(IN)  :: KEY
 INTEGER(KIND=JPIM), INTENT(INOUT) :: VAL
 LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
!
 CHARACTER(LEN=ARGSIZEMAX) :: SVAL
 INTEGER :: ERR
 LOGICAL(KIND=JPLM) :: LSHELL1

 lshell1 = lshell
 
 IF( lhelp ) THEN
   CALL addopt( key, 'INTEGER', USE )
   RETURN
 ELSE IF( lshell ) THEN
   lshell = .false.
   CALL addopt_shell( key, 'INTEGER', 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 getoptioni

SUBROUTINE getoptionr( KEY, VAL, MND, USE )
!
 CHARACTER(LEN=*),   INTENT(IN)  :: KEY
 REAL(KIND=JPRB), INTENT(INOUT) :: VAL
 LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
!
 CHARACTER(LEN=ARGSIZEMAX) :: SVAL
 INTEGER :: ERR
 LOGICAL(KIND=JPLM) :: 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 getoptionr

SUBROUTINE readaslfromstring( VAL, SVAL )
 CHARACTER(LEN=*), INTENT(OUT) :: VAL(:)
 CHARACTER(LEN=*), INTENT(IN) :: SVAL
!
 INTEGER(KIND=JPIM) :: I, J, K, N

 n = len( sval )

 i = 1
 k = 1
 do1 : DO 
   DO
     IF( i .GT. n ) EXIT do1
     IF( sval(i:i) .NE. ' ' ) EXIT
     i = i + 1
   ENDDO
   j = i
   DO
     IF( j .GT. n ) EXIT 
     IF( sval(j:j) .EQ. ' ' ) EXIT
     j = j + 1
   ENDDO

   val(k) = sval(i:j-1)
   i = j
   k = k + 1
 ENDDO do1


END SUBROUTINE readaslfromstring

SUBROUTINE readslfromstring( VAL, SVAL )
 CHARACTER(LEN=*), POINTER :: VAL(:)
 CHARACTER(LEN=*), INTENT(IN) :: SVAL
!
 INTEGER(KIND=JPIM) :: N

 n = xrd_countwords( sval )
 ALLOCATE( val( n ) )

 CALL readaslfromstring( val, sval )

END SUBROUTINE readslfromstring

SUBROUTINE readslfromfile( VAL, SVAL )
 CHARACTER(LEN=*), POINTER :: VAL(:)
 CHARACTER(LEN=*), INTENT(IN) :: SVAL
!
 INTEGER(KIND=JPIM) :: K, N
 INTEGER(KIND=JPIM) :: IOERR
 CHARACTER(LEN=4096) :: BUFFER

 OPEN( 77, file = trim(sval), form = 'FORMATTED', status = 'OLD', iostat = ioerr )
 IF( ioerr .NE. 0 ) THEN
   print '( "COULD NOT OPEN ",A, " FOR READING")', trim(sval)
   CALL xrd_exit(1_jpim)
 ENDIF
 n = 0_jpim
 DO 
   READ( 77, '(A)', end = 500 ) buffer
   n = n + xrd_countwords( buffer )
 ENDDO

 500 CONTINUE

 rewind( 77 )

 ALLOCATE( val( n ) )
 
 k = 1
 DO 
   READ( 77, '(A)', end = 600 ) buffer
   n = xrd_countwords( buffer )
   CALL readaslfromstring( val(k:k+n-1), buffer )
   k = k + n
 ENDDO

 600 CONTINUE


 CLOSE( 77 )
 
END SUBROUTINE readslfromfile

SUBROUTINE getoptionsl( KEY, VAL, MND, USE )
!
 CHARACTER(LEN=*), INTENT(IN) :: KEY
 CHARACTER(LEN=*), POINTER :: VAL(:)
 LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
!
 INTEGER(KIND=JPIM) :: I, J, K, N
 CHARACTER(LEN=ARGSIZEMAX) :: ARG
 CHARACTER(LEN=ARGSIZEMAX) :: SVAL
 LOGICAL(KIND=JPLM) :: LSHELL1
 LOGICAL(KIND=JPLM) :: FOUND

 lshell1 = lshell
 
 IF( lhelp ) THEN
   CALL addopt( key, 'STRING-LIST', USE )
   RETURN
 ELSE IF( lshell ) THEN
   lshell = .false.
   CALL addopt_shell( key, 'STRING-LIST', mnd, USE )
 ENDIF
 
 CALL findargindex( key, i, n )

 found = i >= 0

 IF( found ) THEN

   CALL findnextargindex( i, j )

   ALLOCATE( val( j - i - 1 ) )
   
   IF( ASSOCIATED( check_args ) ) &
     check_args(i) = .true.
   
   DO k = i+1, j-1
     IF( ASSOCIATED( check_args ) ) &
       check_args(k)   = .true.
     CALL mygetarg( k, arg )
     IF ((i+1.EQ.j-1) .AND. (arg(1:7).EQ.'file://')) THEN
       DEALLOCATE (val)
       arg = arg(8:)
       CALL readslfromfile( val, arg )
     ELSE
       val(k-i) = arg
     ENDIF
   ENDDO

 ENDIF
 
 IF(.NOT. found) THEN
   sval = get_env_opt( key )
   found = sval .NE. ""
   IF( found ) &
     CALL readslfromstring( val, sval )
 ENDIF

 IF( .NOT. found ) &
   CALL check_mnd( key, mnd, USE )

 lshell = lshell1

END SUBROUTINE getoptionsl

SUBROUTINE getoptionil( KEY, VAL, MND, USE )
!
 CHARACTER(LEN=*),      INTENT(IN) :: KEY
 INTEGER(KIND=JPIM), POINTER    :: VAL(:)
 LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
!
 CHARACTER(LEN=ARGSIZEMAX), POINTER :: SVAL(:)
 INTEGER(KIND=JPIM) :: I, N
 INTEGER :: ERR
 LOGICAL(KIND=JPLM) :: LSHELL1

 NULLIFY (sval)

 lshell1 = lshell

 IF( lhelp ) THEN
   CALL addopt( key, 'INTEGER-LIST', USE )
   RETURN
 ELSE IF( lshell ) THEN
   lshell = .false.
   CALL addopt_shell( key, 'INTEGER-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 getoptionil

SUBROUTINE getoptionrl( KEY, VAL, MND, USE )
!
 CHARACTER(LEN=*),   INTENT(IN) :: KEY
 REAL(KIND=JPRB), POINTER    :: VAL(:)
 LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
!
 CHARACTER(LEN=ARGSIZEMAX), POINTER :: SVAL(:)
 INTEGER(KIND=JPIM) :: I, N
 INTEGER :: ERR
 LOGICAL(KIND=JPLM) :: 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 getoptionrl

SUBROUTINE getoptionb( KEY, VAL, USE )
!
 CHARACTER(LEN=*), INTENT(IN)  :: KEY
 LOGICAL(KIND=JPLM), INTENT(INOUT) :: VAL
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
!
 LOGICAL(KIND=JPLM) :: LSHELL1
 LOGICAL(KIND=JPLM) :: FOUND
 CHARACTER(LEN=ARGSIZEMAX) :: SVAL
 INTEGER(KIND=JPIM) :: I, N
 
 lshell1 = lshell

 val = .false.

 IF( lhelp ) THEN
   CALL addopt( key, 'FLAG', USE )
   RETURN
 ELSE IF( lshell ) THEN
   lshell = .false.
   CALL addopt_shell( key, 'FLAG', .false._jplm, USE )
 ENDIF
 
 CALL findargindex( key, i, n )
 found = i > 0
 IF( found .AND. ASSOCIATED( check_args ) ) THEN
   check_args(i)   = .true.
   val = .true.
 ELSE
   sval = get_env_opt( key )
   IF( sval .NE. "" ) &
     READ( sval, * ) val
 ENDIF

 lshell = lshell1

END SUBROUTINE getoptionb

END MODULE xrd_getoptions