!-----------------------------------------------------------------------
!     REAL PARAMETER CONTROL
!-----------------------------------------------------------------------
!     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
!-----------------------------------------------------------------------
      SUBROUTINE GLRQNP(NCP)

      CHARACTER CP*(*)

      INTEGER,PARAMETER :: NPARA = 6
      REAL,PARAMETER :: RMAX=REAL(@REALMAX)
      REAL,PARAMETER :: RMIN=REAL(@REALMIN)

      REAL,DIMENSION(NPARA) :: RX
      LOGICAL   :: LW(NPARA), LCHREQ, LFIRST
      CHARACTER :: CPARAS(NPARA)*8
      CHARACTER :: CPARAL(NPARA)*40
      CHARACTER :: CMSG*80

      EXTERNAL  LCHREQ, LENC

      SAVE

!     / SHORT NAME /

      DATA CPARAS(1) / 'RMISS   ' /, RX(1) / 999.0 /
      DATA CPARAS(2) / 'RUNDEF  ' /, RX(2) / -999.0 /
      DATA CPARAS(3) / 'REPSL   ' /, RX(3) / @REPSL /
      DATA CPARAS(4) / 'RFACT   ' /, RX(4) / 1.0 /
      DATA CPARAS(5) / 'REALMAX ' /, RX(5) / RMAX /
      DATA CPARAS(6) / 'REALMIN ' /, RX(6) / RMIN /

!     / LONG NAME /

      DATA CPARAL(1) / 'MISSING_REAL     ' /, LW(1) / .TRUE. /
      DATA CPARAL(2) / 'UNDEFINED_REAL   ' /, LW(2) / .TRUE. /
      DATA CPARAL(3) / 'TRUNCATION_ERROR ' /, LW(3) / .FALSE. /
      DATA CPARAL(4) / 'TRUNCATION_FACTOR' /, LW(4) / .TRUE. /
      DATA CPARAL(5) / 'MAX_REAL         ' /, LW(5) / .FALSE. /
      DATA CPARAL(6) / 'MIN_REAL         ' /, LW(6) / .FALSE. /

      DATA      LFIRST / .TRUE. /


      NCP = NPARA

      RETURN
!-----------------------------------------------------------------------
      ENTRY GLRQID(CP, IDX)

      DO 10 N = 1, NPARA
        IF (LCHREQ(CP,CPARAS(N)) .OR. LCHREQ(CP,CPARAL(N))) THEN
          IDX = N
          RETURN
        END IF
 10   CONTINUE
      CMSG = 'PARAMETER '''//CP(1:LENC(CP))//''' IS NOT DEFINED.'
      CALL MSGDMP('E', 'GLRQID', CMSG)

      RETURN
!-----------------------------------------------------------------------
      ENTRY GLRQCP(IDX, CP)

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        CP = CPARAS(IDX)
      ELSE
        CALL MSGDMP('E', 'GLRQCP', 'IDX IS OUT OF RANGE.')
      END IF

      RETURN
!-----------------------------------------------------------------------
      ENTRY GLRQCL(IDX, CP)

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        CP = CPARAL(IDX)
      ELSE
        CALL MSGDMP('E', 'GLRQCL', 'IDX IS OUT OF RANGE.')
      END IF

      RETURN
!-----------------------------------------------------------------------
      ENTRY GLRQVL(IDX, RPARA)

      IF (LFIRST) THEN
        CALL RTRGET('GL', CPARAS, RX, NPARA)
        CALL RLRGET(CPARAL, RX, NPARA)
        LFIRST = .FALSE.
      END IF

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        RPARA = RX(IDX)
      ELSE
        CALL MSGDMP('E','GLRQVL','IDX IS OUT OF RANGE.')
      END IF

      RETURN
!-----------------------------------------------------------------------
      ENTRY GLRSVL(IDX, RPARA)

      IF (LFIRST) THEN
        CALL RTRGET('GL', CPARAS, RX, NPARA)
        CALL RLRGET(CPARAL, RX, NPARA)
        LFIRST = .FALSE.
      END IF

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        IF (LW(IDX)) THEN
          RX(IDX) = RPARA
          RETURN
        ELSE
          CMSG = 'PARAMETER'''//CPARAS(IDX)//''' CANNOT BE SET.'
          CALL MSGDMP('E', 'GLRQVL', CMSG)
        END IF
      ELSE
        CALL MSGDMP('E','GLRQVL','IDX IS OUT OF RANGE.')
      END IF

      RETURN
!-----------------------------------------------------------------------
      ENTRY GLRQIN(CP, IN)

      DO 20 N = 1, NPARA
        IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN
          IN = N
          RETURN
        END IF
   20 CONTINUE

      IN = 0

      RETURN
      END
