*----------------------------------------------------------------------- * UEPQNP / UEPQID / UEPQCP / UEPQVL / UEPSVL *----------------------------------------------------------------------- SUBROUTINE UEPQNP(NCP) CHARACTER CP*(*) PARAMETER (NPARA = 8) 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) / 'LTONE ' /, ITYPE(1) / 2 / DATA CPARAS(2) / 'IPAT ' /, ITYPE(2) / 1 / DATA CPARAS(3) / 'RLEV ' /, ITYPE(3) / 3 / DATA CPARAS(4) / 'LBOUND ' /, ITYPE(4) / 2 / DATA CPARAS(5) / 'NLEV ' /, ITYPE(5) / 1 / DATA CPARAS(6) / 'ITPAT ' /, ITYPE(6) / 1 / DATA CPARAS(7) / 'ICOLOR1 ' /, ITYPE(7) / 1 / DATA CPARAS(8) / 'ICOLOR2 ' /, ITYPE(8) / 1 / * ---- LONG NAME ---- DATA CPARAL(1) / 'ENABLE_AUTO_SHADE_LEVEL' / DATA CPARAL(2) / 'DEFAULT_SHADE_PATTERN' / DATA CPARAL(3) / 'DEFAULT_SHADE_THRESHOLD' / DATA CPARAL(4) / '????LBOUND ' / DATA CPARAL(5) / '****NLEV ' / DATA CPARAL(6) / 'AUTO_SHADE_PATTERN' / DATA CPARAL(7) / 'SHADE_COLOR_MIN' / DATA CPARAL(8) / 'SHADE_COLOR_MAX' / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY UEPQID(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','UEPQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY UEPQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','UEPQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEPQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','UEPQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEPQIT(IDX, ITP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN ITP = ITYPE(IDX) ELSE CALL MSGDMP('E','UEPQIT','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEPQVL(IDX, IPARA) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IF(ITYPE(IDX) .EQ. 1) THEN CALL UEIQID(CPARAS(IDX), ID) CALL UEIQVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 2) THEN CALL UELQID(CPARAS(IDX), ID) CALL UELQVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 3) THEN CALL UERQID(CPARAS(IDX), ID) CALL UERQVL(ID, IPARA) ENDIF ELSE CALL MSGDMP('E','UEPQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEPSVL(IDX, IPARA) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IF(ITYPE(IDX) .EQ. 1) THEN CALL UEIQID(CPARAS(IDX), ID) CALL UEISVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 2) THEN CALL UELQID(CPARAS(IDX), ID) CALL UELSVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 3) THEN CALL UERQID(CPARAS(IDX), ID) CALL UERSVL(ID, IPARA) ENDIF ELSE CALL MSGDMP('E','UEPSVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEPQIN(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