*----------------------------------------------------------------------- * UDIQNP / UDIQID / UDIQCP / UDIQVL / UDISVL *----------------------------------------------------------------------- SUBROUTINE UDIQNP(NCP) INTEGER NCP CHARACTER CP*(*) PARAMETER (NPARA = 7) PARAMETER (IUNDEF = -999) 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) / 'INDXMJ ' /, IX(1) / 3 / DATA CPARAS(2) / 'INDXMN ' /, IX(2) / 1 / DATA CPARAS(3) / 'ISOLID ' /, IX(3) / 1 / DATA CPARAS(4) / 'IDASH ' /, IX(4) / 3 / DATA CPARAS(5) / 'ICYCLE ' /, IX(5) / 2 / DATA CPARAS(6) / 'NLEV ' /, IX(6) / 12 / DATA CPARAS(7) / 'IUNDEF ' /, IX(7) / IUNDEF / * ---- LONG NAME ---- DATA CPARAL(1) / 'MAJOR_CONTOUR_INDEX' / DATA CPARAL(2) / 'MINOR_CONTOUR_INDEX' / DATA CPARAL(3) / 'POSITIVE_CONTOUR_TYPE' / DATA CPARAL(4) / 'NEGATIVE_CONTOUR_TYPE' / DATA CPARAL(5) / 'MAJOR_CONTOUR_CYCLE' / DATA CPARAL(6) / 'CONTOUR_LEVEL_NUMBER' / DATA CPARAL(7) / '----IUNDEF ' / DATA LFIRST / .TRUE. / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY UDIQID(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','UDIQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY UDIQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','UDIQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UDIQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','UDIQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UDIQVL(IDX, IPARA) IF (LFIRST) THEN CALL RTIGET('UD:', 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','UDIQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UDISVL(IDX, IPARA) IF (LFIRST) THEN CALL RTIGET('UD:', 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','UDISVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UDIQIN(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