1*-----------------------------------------------------------------------
2*     SWPQNP / SWPQID / SWPQCP / SWPQVL / SWPSVL
3*-----------------------------------------------------------------------
4*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
5*-----------------------------------------------------------------------
6      SUBROUTINE SWPQNP(NCP)
7
8      CHARACTER CP*(*)
9
10      PARAMETER (NPARA = 20)
11
12      INTEGER   ITYPE(NPARA)
13      CHARACTER CPARAS(NPARA)*8
14      CHARACTER CPARAL(NPARA)*40
15      CHARACTER CMSG*80
16
17      LOGICAL   LCHREQ
18
19      EXTERNAL  LCHREQ,LENC
20
21      SAVE
22
23*     / SHORT NAME /
24
25      DATA      CPARAS( 1) / 'MAXWNU  ' / , ITYPE( 1) / 1 /
26      DATA      CPARAS( 2) / 'IWS     ' / , ITYPE( 2) / 0 /
27      DATA      CPARAS( 3) / 'IPOSX   ' / , ITYPE( 3) / 1 /
28      DATA      CPARAS( 4) / 'IPOSY   ' / , ITYPE( 4) / 1 /
29      DATA      CPARAS( 5) / 'IWIDTH  ' / , ITYPE( 5) / 1 /
30      DATA      CPARAS( 6) / 'IHEIGHT ' / , ITYPE( 6) / 1 /
31      DATA      CPARAS( 7) / 'LWAIT   ' / , ITYPE( 7) / 2 /
32      DATA      CPARAS( 8) / 'LWAIT0  ' / , ITYPE( 8) / 2 /
33      DATA      CPARAS( 9) / 'LWAIT1  ' / , ITYPE( 9) / 2 /
34      DATA      CPARAS(10) / 'LKEY    ' / , ITYPE(10) / 2 /
35      DATA      CPARAS(11) / 'LDUMP   ' / , ITYPE(11) / 2 /
36      DATA      CPARAS(12) / 'LALT    ' / , ITYPE(12) / 2 /
37      DATA      CPARAS(13) / 'LCOLOR  ' / , ITYPE(13) / 2 /
38      DATA      CPARAS(14) / 'LSEP    ' / , ITYPE(14) / 2 /
39      DATA      CPARAS(15) / 'LPRINT  ' / , ITYPE(15) / 2 /
40      DATA      CPARAS(16) / 'LWND    ' / , ITYPE(16) / 2 /
41      DATA      CPARAS(17) / 'MODE    ' / , ITYPE(17) / 1 /
42      DATA      CPARAS(18) / 'NLNSIZE ' / , ITYPE(18) / 1 /
43      DATA      CPARAS(19) / 'ICLRMAP ' / , ITYPE(19) / 1 /
44      DATA      CPARAS(20) / 'LFGBG   ' / , ITYPE(20) / 2 /
45
46*     / LONG NAME /
47
48      DATA      CPARAL( 1) / '****MAXWNU  ' /
49      DATA      CPARAL( 2) / '****IWS     ' /
50      DATA      CPARAL( 3) / 'WINDOW_X_POS' /
51      DATA      CPARAL( 4) / 'WINDOW_Y_POS' /
52      DATA      CPARAL( 5) / 'WINDOW_WIDTH' /
53      DATA      CPARAL( 6) / 'WINDOW_HEIGHT' /
54      DATA      CPARAL( 7) / 'WAIT' /
55      DATA      CPARAL( 8) / 'WAIT_OPENING' /
56      DATA      CPARAL( 9) / 'WAIT_CLOSING' /
57      DATA      CPARAL(10) / 'KEYCLICK' /
58      DATA      CPARAL(11) / 'DUMP' /
59      DATA      CPARAL(12) / 'ALTERNATE' /
60      DATA      CPARAL(13) / 'ENABLE_COLOR_PS' /
61      DATA      CPARAL(14) / 'SEPARATE' /
62      DATA      CPARAL(15) / 'PRINT' /
63      DATA      CPARAL(16) / 'SHOW_WINDOW' /
64      DATA      CPARAL(17) / '****MODE    ' /
65      DATA      CPARAL(18) / '****NLNSIZE ' /
66      DATA      CPARAL(19) / 'COLORMAP_NUMBER' /
67      DATA      CPARAL(20) / '****LFGBG   ' /
68
69      NCP = NPARA
70
71      RETURN
72*-----------------------------------------------------------------------
73      ENTRY SWPQID(CP, IDX)
74
75      DO 10 N = 1, NPARA
76        IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN
77          IDX = N
78          RETURN
79        END IF
80   10 CONTINUE
81      CMSG = 'PARAMETER '''//CP(1:LENC(CP))//''' IS NOT DEFINED.'
82      CALL MSGDMP('E','SWPQID',CMSG)
83
84      RETURN
85*-----------------------------------------------------------------------
86      ENTRY SWPQCP(IDX, CP)
87
88      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
89        CP = CPARAS(IDX)
90      ELSE
91        CALL MSGDMP('E','SWPQCP','IDX IS OUT OF RANGE.')
92      END IF
93
94      RETURN
95*-----------------------------------------------------------------------
96      ENTRY SWPQCL(IDX, CP)
97
98      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
99        CP = CPARAL(IDX)
100      ELSE
101        CALL MSGDMP('E','SWPQCL','IDX IS OUT OF RANGE.')
102      END IF
103
104      RETURN
105*-----------------------------------------------------------------------
106      ENTRY SWPQIT(IDX, ITP)
107
108      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
109        ITP = ITYPE(IDX)
110      ELSE
111        CALL MSGDMP('E','SWPQIT','IDX IS OUT OF RANGE.')
112      END IF
113
114      RETURN
115*-----------------------------------------------------------------------
116      ENTRY SWPQVL(IDX, IPARA)
117
118      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
119        IF (ITYPE(IDX) .EQ. 1) THEN
120          CALL SWIQID(CPARAS(IDX), ID)
121          CALL SWIQVL(ID, IPARA)
122        ELSE IF (ITYPE(IDX) .EQ. 2) THEN
123          CALL SWLQID(CPARAS(IDX), ID)
124          CALL SWLQVL(ID, IPARA)
125        ELSE IF (ITYPE(IDX) .EQ. 3) THEN
126          CALL SWRQID(CPARAS(IDX), ID)
127          CALL SWRQVL(ID, IPARA)
128        END IF
129      ELSE
130         CALL MSGDMP('E','SWPQVL','IDX IS OUT OF RANGE.')
131      END IF
132
133      RETURN
134*-----------------------------------------------------------------------
135      ENTRY SWPSVL(IDX, IPARA)
136
137      IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN
138        IF (ITYPE(IDX) .EQ. 1) THEN
139          CALL SWIQID(CPARAS(IDX), ID)
140          CALL SWISVL(ID, IPARA)
141        ELSE IF (ITYPE(IDX) .EQ. 2) THEN
142          CALL SWLQID(CPARAS(IDX), ID)
143          CALL SWLSVL(ID, IPARA)
144        ELSE IF (ITYPE(IDX) .EQ. 3) THEN
145          CALL SWRQID(CPARAS(IDX), ID)
146          CALL SWRSVL(ID, IPARA)
147        END IF
148      ELSE
149        CALL MSGDMP('E','SWPSVL','IDX IS OUT OF RANGE.')
150      END IF
151
152      RETURN
153*-----------------------------------------------------------------------
154      ENTRY SWPQIN(CP, IN)
155
156      DO 20 N = 1, NPARA
157        IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN
158          IN = N
159          RETURN
160        END IF
161   20 CONTINUE
162
163      IN = 0
164
165      RETURN
166      END
167