*----------------------------------------------------------------------- * UUPQNP / UUPQID / UUPQCP / UUPQVL / UUPSVL *----------------------------------------------------------------------- SUBROUTINE UUPQNP(NCP) CHARACTER CP*(*) PARAMETER (NPARA = 3) CHARACTER CPARAS(NPARA)*8 CHARACTER CPARAL(NPARA)*8 INTEGER ITYPE(NPARA) CHARACTER CMSG*80 LOGICAL LCHREQ EXTERNAL LCHREQ,LENC SAVE * ---- SHORT NAME ---- DATA CPARAS(1) / 'UMIN ' /, ITYPE(1) / 3 / DATA CPARAS(2) / 'UMAX ' /, ITYPE(2) / 3 / DATA CPARAS(3) / 'UREF ' /, ITYPE(3) / 3 / * ---- LONG NAME ---- DATA CPARAL(1) / '****UMIN ' / DATA CPARAL(2) / '****UMAX ' / DATA CPARAL(3) / '****UREF ' / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY UUPQID(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','UUPQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY UUPQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','UUPQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UUPQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','UUPQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UUPQIT(IDX, ITP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN ITP = ITYPE(IDX) ELSE CALL MSGDMP('E','UUPQIT','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UUPQVL(IDX, IPARA) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IF(ITYPE(IDX) .EQ. 1) THEN CALL UUIQID(CPARAS(IDX), ID) CALL UUIQVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 2) THEN CALL UULQID(CPARAS(IDX), ID) CALL UULQVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 3) THEN CALL UURQID(CPARAS(IDX), ID) CALL UURQVL(ID, IPARA) ENDIF ELSE CALL MSGDMP('E','UUPQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UUPSVL(IDX, IPARA) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IF(ITYPE(IDX) .EQ. 1) THEN CALL UUIQID(CPARAS(IDX), ID) CALL UUISVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 2) THEN CALL UULQID(CPARAS(IDX), ID) CALL UULSVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 3) THEN CALL UURQID(CPARAS(IDX), ID) CALL UURSVL(ID, IPARA) ENDIF ELSE CALL MSGDMP('E','UUPSVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UUPQIN(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