*-----------------------------------------------------------------------
*     UCPQNP / UCPQID / UCPQCP / UCPQVL / UCPSVL
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE UCPQNP(NCP)

      CHARACTER CP*(*)

      PARAMETER (NPARA = 5)

      INTEGER   ITYPE(NPARA)
      LOGICAL   LCHREQ
      CHARACTER CPARAS(NPARA)*8
      CHARACTER CPARAL(NPARA)*40
      CHARACTER CMSG*80

      EXTERNAL  LCHREQ,LENC

      SAVE

*     / SHORT NAME /

      DATA      CPARAS( 1) / 'NDAY    ' /, ITYPE( 1) / 1 /
      DATA      CPARAS( 2) / 'NCHAR   ' /, ITYPE( 2) / 1 /
      DATA      CPARAS( 3) / 'LOWER   ' /, ITYPE( 3) / 2 /
      DATA      CPARAS( 4) / 'DFACT   ' /, ITYPE( 4) / 3 /
      DATA      CPARAS( 5) / 'IUNDEF  ' /, ITYPE( 5) / 1 /

*     / LONG  NAME /

      DATA      CPARAL( 1) / 'DAY_INTERVAL' /
      DATA      CPARAL( 2) / 'MONTH_NAME_LENGTH' /
      DATA      CPARAL( 3) / 'MONTH_NAME_LOWER'  /
      DATA      CPARAL( 4) / '****DFACT' /
      DATA      CPARAL( 5) / '----IUNDEF' /


      NCP = NPARA

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPQID(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','UCPQID',CMSG)

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPQCP(IDX, CP)

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

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPQCL(IDX, CP)

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

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPQIT(IDX, ITP)

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        ITP = ITYPE(IDX)
      ELSE
        CALL MSGDMP('E','UCPQIT','IDX IS OUT OF RANGE.')
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPQVL(IDX, IPARA)

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        IF (ITYPE(IDX) .EQ. 1) THEN
          CALL UCIQID(CPARAS(IDX), ID)
          CALL UCIQVL(ID, IPARA)
        ELSE IF (ITYPE(IDX) .EQ. 2) THEN
          CALL UCLQID(CPARAS(IDX), ID)
          CALL UCLQVL(ID, IPARA)
        ELSE IF (ITYPE(IDX) .EQ. 3) THEN
          CALL UCRQID(CPARAS(IDX), ID)
          CALL UCRQVL(ID, IPARA)
        END IF
      ELSE
         CALL MSGDMP('E','UCPQVL','IDX IS OUT OF RANGE.')
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPSVL(IDX, IPARA)

      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
        IF (ITYPE(IDX) .EQ. 1) THEN
          CALL UCIQID(CPARAS(IDX), ID)
          CALL UCISVL(ID, IPARA)
        ELSE IF (ITYPE(IDX) .EQ. 2) THEN
          CALL UCLQID(CPARAS(IDX), ID)
          CALL UCLSVL(ID, IPARA)
        ELSE IF (ITYPE(IDX) .EQ. 3) THEN
          CALL UCRQID(CPARAS(IDX), ID)
          CALL UCRSVL(ID, IPARA)
        END IF
      ELSE
        CALL MSGDMP('E','UCPSVL','IDX IS OUT OF RANGE.')
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY UCPQIN(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
