*-----------------------------------------------------------------------
*     GET EXTERNAL PARAMETER FROM 'DCLRC' FILE
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2016 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE RPNXFL

      LOGICAL   LPARA
      CHARACTER CPFIX*(*), CP*(*), CVAL*(*)

      PARAMETER (NPARA = 100)

      LOGICAL   LCHREQ, LFROMC
      CHARACTER CPARA(NPARA)*80,CX(NPARA)*80,CDSN*1024,
     +          CLINE*80,CPX*16,
     +          CADJ*32,CSEP*1,CCOM*1,CDIV*1,CSEPX*1,CCOMX*1,CDIVX*1

      EXTERNAL  LCHREQ, LENC, IUFOPN, IFROMC, LFROMC, RFROMC

      SAVE

      DATA      CSEPX / '_' /, CCOMX / '*' /, CDIVX / ' ' /

      CALL OSGENV('DCLENVCHAR',CSEP)
      IF (CSEP.EQ.' ') CSEP=CSEPX

      CALL OSGENV('DCLCOMCHAR',CCOM)
      IF (CCOM.EQ.' ') CCOM=CCOMX

      CALL OSGENV('DCLDIVCHAR',CDIV)
      IF (CDIV.EQ.' ') CDIV=CDIVX

      CALL GLQFNM('DCLRC',CDSN)
      IF (CDSN .EQ. ' ') RETURN

      IU = IUFOPN()
      IF (IU .EQ. 0) RETURN

      OPEN(IU, FILE = CDSN, FORM = 'FORMATTED')
      REWIND(IU)

      NN = 0
   10 CONTINUE
      READ(IU, '(A)', IOSTAT = IOS) CLINE
      IF (IOS.EQ.0) THEN
        IF (CLINE(1:1).NE.CCOM) THEN
          NN = NN + 1
          IF (NN .GT. NPARA) THEN
            CALL MSGDMP('E','RTNXFL',
     +           'NUMBER OF INPUT PARAMETERS IS TOO LARGE (>100).')
          END IF
          IDB = INDEX(CLINE,CDIV)
          CPARA(NN) = CLINE(1:IDB-1)
          CX(NN) = CLINE(IDB+1:LENC(CLINE))
          CALL CLADJ(CX(NN))
        END IF
      END IF
      IF (IOS.EQ.0) GO TO 10

      CLOSE(IU)

      RETURN
*-----------------------------------------------------------------------
*     GET INTEGER PARAMETER WITH SHORT NAME
*-----------------------------------------------------------------------
      ENTRY RTIXFL(CPFIX, CP, IPARA)

      CPX = CPFIX(1:LENC(CPFIX))//CSEP//CP

      DO 20 N = 1, NN
        IF (LCHREQ(CPX, CPARA(N))) THEN
          CADJ = CX(N)
          CALL CLADJ(CADJ)
          IPARA = IFROMC(CADJ)
          RETURN
        END IF
   20 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET LOGICAL PARAMETER WITH SHORT NAME
*-----------------------------------------------------------------------
      ENTRY RTLXFL(CPFIX, CP, LPARA)

      CPX = CPFIX(1:LENC(CPFIX))//CSEP//CP

      DO 30 N = 1, NN
        IF (LCHREQ(CPX, CPARA(N))) THEN
          CADJ = CX(N)
          CALL CLADJ(CADJ)
          LPARA = LFROMC(CADJ)
          RETURN
        END IF
   30 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET REAL PARAMETER WITH SHORT NAME
*-----------------------------------------------------------------------
      ENTRY RTRXFL(CPFIX, CP, RPARA)

      CPX = CPFIX(1:LENC(CPFIX))//CSEP//CP

      DO 40 N = 1, NN
        IF (LCHREQ(CPX, CPARA(N))) THEN
          CADJ = CX(N)
          CALL CLADJ(CADJ)
          RPARA = RFROMC(CADJ)
          RETURN
        END IF
   40 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET CHARACTER PARAMETER WITH SHORT NAME
*-----------------------------------------------------------------------
      ENTRY RTCXFL(CPFIX, CP, CVAL)

      CPX=CPFIX(1:LENC(CPFIX))//CSEP//CP

      DO 50 N = 1, NN
        IF (LCHREQ(CPX, CPARA(N))) THEN
          CVAL = CX(N)
          RETURN
        END IF
   50 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET INTEGER PARAMETER WITH LONG NAME
*-----------------------------------------------------------------------
      ENTRY RLIXFL(CP, IPARA)

      DO 60 N = 1,NN
        IF (LCHREQ(CP, CPARA(N))) THEN
          CADJ = CX(N)
          CALL CLADJ(CADJ)
          IPARA = IFROMC(CADJ)
          RETURN
        END IF
   60 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET LOGICAL PARAMETER WITH LONG NAME
*-----------------------------------------------------------------------
      ENTRY RLLXFL(CP, LPARA)

      DO 70 N = 1, NN
        IF (LCHREQ(CP,CPARA(N))) THEN
          CADJ = CX(N)
          CALL CLADJ(CADJ)
          LPARA = LFROMC(CADJ)
          RETURN
        END IF
   70 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET REAL PARAMETER WITH LONG NAME
*-----------------------------------------------------------------------
      ENTRY RLRXFL(CP, RPARA)

      DO 80 N = 1, NN
        IF (LCHREQ(CP,CPARA(N))) THEN
          CADJ=CX(N)
          CALL CLADJ(CADJ)
          RPARA = RFROMC(CADJ)
          RETURN
        END IF
   80 CONTINUE

      RETURN
*-----------------------------------------------------------------------
*     GET CHARACTER PARAMETER WITH LONG NAME
*-----------------------------------------------------------------------
      ENTRY RLCXFL(CP, CVAL)

      DO 90 N = 1, NN
        IF (LCHREQ(CP, CPARA(N))) THEN
          CVAL = CX(N)
          RETURN
        END IF
   90 CONTINUE

      RETURN
      END
