*----------------------------------------------------------------------- * SWPQNP / SWPQID / SWPQCP / SWPQVL / SWPSVL *----------------------------------------------------------------------- SUBROUTINE SWPQNP(NCP) CHARACTER CP*(*) PARAMETER (NPARA = 16) 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) / 'MAXWNU ' / , ITYPE( 1) / 1 / DATA CPARAS( 2) / 'IWS ' / , ITYPE( 2) / 1 / DATA CPARAS( 3) / 'IPOSX ' / , ITYPE( 3) / 1 / DATA CPARAS( 4) / 'IPOSY ' / , ITYPE( 4) / 1 / DATA CPARAS( 5) / 'IWIDTH ' / , ITYPE( 5) / 1 / DATA CPARAS( 6) / 'IHEIGHT ' / , ITYPE( 6) / 1 / DATA CPARAS( 7) / 'LWAIT ' / , ITYPE( 7) / 2 / DATA CPARAS( 8) / 'LWAIT0 ' / , ITYPE( 8) / 2 / DATA CPARAS( 9) / 'LWAIT1 ' / , ITYPE( 9) / 2 / DATA CPARAS(10) / 'LKEY ' / , ITYPE(10) / 2 / DATA CPARAS(11) / 'LDUMP ' / , ITYPE(11) / 2 / DATA CPARAS(12) / 'LALT ' / , ITYPE(12) / 2 / DATA CPARAS(13) / 'LCOLOR ' / , ITYPE(13) / 2 / DATA CPARAS(14) / 'LSEP ' / , ITYPE(14) / 2 / DATA CPARAS(15) / 'LPRINT ' / , ITYPE(15) / 2 / DATA CPARAS(16) / 'NLNSIZE ' / , ITYPE(16) / 1 / * ---- LONG NAME ---- DATA CPARAL( 1) / '****MAXWNU ' / DATA CPARAL( 2) / '****IWS ' / DATA CPARAL( 3) / 'WINDOW_X_POS' / DATA CPARAL( 4) / 'WINDOW_Y_POS' / DATA CPARAL( 5) / 'WINDOW_WIDTH' / DATA CPARAL( 6) / 'WINDOW_HEIGHT' / DATA CPARAL( 7) / 'WAIT' / DATA CPARAL( 8) / 'WAIT_OPENING' / DATA CPARAL( 9) / 'WAIT_CLOSING' / DATA CPARAL(10) / 'KEYCLICK' / DATA CPARAL(11) / 'DUMP' / DATA CPARAL(12) / 'ALTERNATE' / DATA CPARAL(13) / 'ENABLE_COLOR_PS' / DATA CPARAL(14) / 'SEPARATE' / DATA CPARAL(15) / 'PRINT' / DATA CPARAL(16) / '****NLNSIZE ' / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY SWPQID(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','SWPQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY SWPQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','SWPQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY SWPQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','SWPQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY SWPQIT(IDX, ITP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN ITP = ITYPE(IDX) ELSE CALL MSGDMP('E','SWPQIT','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY SWPQVL(IDX, IPARA) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IF(ITYPE(IDX) .EQ. 1) THEN CALL SWIQID(CPARAS(IDX), ID) CALL SWIQVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 2) THEN CALL SWLQID(CPARAS(IDX), ID) CALL SWLQVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 3) THEN CALL SWRQID(CPARAS(IDX), ID) CALL SWRQVL(ID, IPARA) ENDIF ELSE CALL MSGDMP('E','SWPQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY SWPSVL(IDX, IPARA) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN IF(ITYPE(IDX) .EQ. 1) THEN CALL SWIQID(CPARAS(IDX), ID) CALL SWISVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 2) THEN CALL SWLQID(CPARAS(IDX), ID) CALL SWLSVL(ID, IPARA) ELSE IF(ITYPE(IDX) .EQ. 3) THEN CALL SWRQID(CPARAS(IDX), ID) CALL SWRSVL(ID, IPARA) ENDIF ELSE CALL MSGDMP('E','SWPSVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY SWPQIN(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