*----------------------------------------------------------------------- * UURQNP / UURQID / UURQCP / UURQVL / UURSVL *----------------------------------------------------------------------- SUBROUTINE UURQNP(NCP) INTEGER NCP CHARACTER CP*(*) PARAMETER (NPARA = 3) PARAMETER (RUNDEF = -999.) REAL RX(NPARA), RPARA LOGICAL LCHREQ, LFIRST CHARACTER CPARAS(NPARA)*8 CHARACTER CPARAL(NPARA)*40 CHARACTER CMSG*80 EXTERNAL LCHREQ, LENC SAVE * ---- SHORT NAME ---- DATA CPARAS(1) / 'UMIN ' /, RX(1) / RUNDEF / DATA CPARAS(2) / 'UMAX ' /, RX(2) / RUNDEF / DATA CPARAS(3) / 'UREF ' /, RX(3) / 0.0 / * ---- LONG NAME ---- DATA CPARAL(1) / '****UMIN ' / DATA CPARAL(2) / '****UMAX ' / DATA CPARAL(3) / '****UREF ' / DATA LFIRST / .TRUE. / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY UURQID(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','UURQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY UURQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','UURQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UURQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','UURQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UURQVL(IDX, RPARA) IF (LFIRST) THEN CALL RTRGET('UU:', CPARAS, RX, NPARA) CALL RLRGET(CPARAL, RX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN RPARA = RX(IDX) ELSE CALL MSGDMP('E','UURQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UURSVL(IDX, RPARA) IF (LFIRST) THEN CALL RTRGET('UU:', CPARAS, RX, NPARA) CALL RLRGET(CPARAL, RX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN RX(IDX) = RPARA ELSE CALL MSGDMP('E','UURSVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UURQIN(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