*----------------------------------------------------------------------- * UCPQNP / UCPQID / UCPQCP / UCPQVL / UCPSVL *----------------------------------------------------------------------- SUBROUTINE UCPQNP(NCP) CHARACTER CP*(*) PARAMETER (NPARA = 5) CHARACTER CPARAS(NPARA)*8 CHARACTER CPARAL(NPARA)*40 INTEGER ITYPE(NPARA) CHARACTER CMSG*80 LOGICAL LCHREQ 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) ENDIF 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) ENDIF 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 ENDIF 20 CONTINUE IN = 0 RETURN END