*----------------------------------------------------------------------- * UEIQNP / UEIQID / UEIQCP / UEIQVL / UEISVL *----------------------------------------------------------------------- SUBROUTINE UEIQNP(NCP) INTEGER NCP CHARACTER CP*(*) PARAMETER (NPARA = 5) INTEGER IX(NPARA) LOGICAL LCHREQ, LFIRST CHARACTER CPARAS(NPARA)*8 CHARACTER CPARAL(NPARA)*40 CHARACTER CMSG*80 EXTERNAL LCHREQ, LENC SAVE * ---- SHORT NAME ---- DATA CPARAS(1) / 'IPAT ' /, IX(1) / 1201 / DATA CPARAS(2) / 'NLEV ' /, IX(2) / 12 / DATA CPARAS(3) / 'ITPAT ' /, IX(3) / 999 / DATA CPARAS(4) / 'ICOLOR1 ' /, IX(4) / 15 / DATA CPARAS(5) / 'ICOLOR2 ' /, IX(5) / 94 / * ---- LONG NAME ---- DATA CPARAL(1) / 'DEFAULT_SHADE_PATTERN' / DATA CPARAL(2) / '****NLEV ' / DATA CPARAL(3) / 'AUTO_SHADE_PATTERN' / DATA CPARAL(4) / 'SHADE_COLOR_MIN' / DATA CPARAL(5) / 'SHADE_COLOR_MAX' / DATA LFIRST / .TRUE. / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY UEIQID(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','UEIQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY UEIQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','UEIQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEIQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','UEIQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEIQVL(IDX, IPARA) IF (LFIRST) THEN CALL RTIGET('UE:', CPARAS, IX, NPARA) CALL RLIGET(CPARAL, IX, NPARA) LFIRST=.FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IPARA = IX(IDX) ELSE CALL MSGDMP('E','UEIQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEISVL(IDX, IPARA) IF (LFIRST) THEN CALL RTIGET('UE:', CPARAS, IX, NPARA) CALL RLIGET(CPARAL, IX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IX(IDX) = IPARA ELSE CALL MSGDMP('E','UEISVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UEIQIN(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