1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
|
SUBROUTINE CMCASE
C
C THIS SUBROUTINE PROCESSES THE CASE CONTROL DATA BLOCK
C
EXTERNAL ORF
LOGICAL IAUTO,TRAN,CONECT,LF(3),LONLY,SRCH
INTEGER CASECC,BUF2,STEP,Z,CNAM,RESTCT,COMBO,OUTT,AUTO,
1 ORF,NCNAM(2),IHD(96),IBITS(32),CONSET,MNEM(11),
2 SNAM(7,2),IDIR(3),COMP(7,2),SYMT(7),TRANS(7),
3 ISYM(15,2),AAA(2),PORA,PAPP
DIMENSION AZ(1)
CHARACTER UFM*23
COMMON /XMSSG / UFM
COMMON /CMB001/ JUNK(8),CASECC
COMMON /CMB002/ BUF1,BUF2,JUNK1(6),OUTT
COMMON /CMB003/ COMBO(7,5),CONSET,IAUTO,TOLER,NPSUB,CONECT,TRAN,
1 MCON,RESTCT(7,7),ISORT,ORIGIN(7,3),IPRINT
COMMON /CMB004/ TDAT(6),NIPNEW,CNAM(2),LONLY
COMMON /ZZZZZZ/ Z(1)
COMMON /OUTPUT/ ITITL(96),IHEAD(96)
COMMON /SYSTEM/ XXX,IOT,MUNK(6),NLPP,JUNK3(2),LINE,JUNK2(2),
1 IDAT(3)
COMMON /BLANK / STEP,IDRY,PORA
EQUIVALENCE (Z(1),AZ(1))
DATA NMNEM / 11 /, IDIR/ 1HX, 1HY, 1HZ /, AUTO/ 4HAUTO / ,
1 AAA / 4HCMCA, 4HSE /
DATA MNEM / 4HOPTS, 4HSORT, 4HNAMC, 4HNAMS, 4HTOLE, 4HCONN,
1 4HCOMP, 4HTRAN, 4HSYMT, 4HSEAR, 4HOUTP/
DATA ISYM / 4,2,1,6,6,5,5,3,3,6*7,1HX,1HY,1HZ,2HXY,2HYX,2HXZ,
1 2HZX,2HYZ,2HZY,3HXYZ,3HXZY,3HYXZ,3HYZX,3HZXY,
2 3HZYX /
DATA IHD / 74*4H , 4H SUM , 4HMARY , 4H OF , 4HCASE ,
1 4H CON , 4HTROL , 4H FOR , 4H COM , 4HBINE ,
2 4H OPE , 4HRATI , 4HON , 10*4H /
DATA NHEQSS/ 4HEQSS /
DATA PAPP , LOAP,LODS/ 4HPAPP , 4HLOAP , 4HLODS /
C
C OPEN CASECC DATA BLOCK AND READ INTO OPEN CORE
C
SRCH = .FALSE.
IERR = 0
DO 10 I = 1,96
IHEAD(I) = IHD(I)
10 CONTINUE
IFILE = CASECC
CALL OPEN (*580,CASECC,Z(BUF2),0)
NREC = STEP
IF (NREC .EQ. 0) GO TO 30
DO 20 I = 1,NREC
CALL FWDREC (*580,CASECC)
20 CONTINUE
30 CALL READ (*570,*590,CASECC,Z(1),5,0,NNN)
I = 2
NWDSCC = Z(I )
NPSUB = Z(I+1)
CALL READ (*570,*40,CASECC,Z(1),NWDSCC,1,NNN)
40 JJ = 0
KK = 0
IPRINT = 0
C
C INITIALIZE COMBO AND RESTCT ARRAYS
C
DO 70 I = 1,7
DO 50 J = 1,5
COMBO(I,J) = 0
50 CONTINUE
DO 60 J = 1,7
RESTCT(I,J) = 0
60 CONTINUE
70 CONTINUE
C
C INITIALIZE COMP,TRANS,AND SYMT ARRAYS
C
CONECT = .FALSE.
TRAN = .FALSE.
DO 90 I = 1,7
SYMT(I) = 0
TRANS(I)= 0
DO 80 J = 1,2
COMP(I,J) = 0
80 CONTINUE
90 CONTINUE
DO 100 I = 1,3
LF(I) = .FALSE.
100 CONTINUE
CNAM(1) = 0
CNAM(2) = 0
C
C PROCESS CASE CONTROL MNEMONICS
C
DO 350 I = 1,NWDSCC,3
DO 110 J = 1,NMNEM
IF (Z(I) .NE. MNEM(J)) GO TO 110
GO TO (120,130,160,170,180,190,200,220,230,260,290), J
110 CONTINUE
GO TO 350
120 IAUTO = .FALSE.
IF (Z(I+1) .EQ. AUTO) IAUTO = .TRUE.
GO TO 350
C
130 DO 140 L = 1,3
IF (Z(I+1) .EQ. IDIR(L)) GO TO 150
140 CONTINUE
ISORT = 1
GO TO 350
150 ISORT = L
GO TO 350
C
160 IF (LF(1)) GO TO 300
LF(1) = .TRUE.
CNAM(1) = Z(I+1)
CNAM(2) = Z(I+2)
GO TO 350
C
170 JJ = JJ + 1
SNAM(JJ,1) = Z(I+1)
SNAM(JJ,2) = Z(I+2)
GO TO 350
C
180 IF (LF(2)) GO TO 300
LF(2) = .TRUE.
TOLER = AZ(I+2)
GO TO 350
C
190 IF (LF(3)) GO TO 300
LF(3) = .TRUE.
CONSET = Z(I+2)
CONECT = .TRUE.
GO TO 350
C
200 KK = KK + 1
COMP(KK,1) = Z(I+1)
COMP(KK,2) = Z(I+2)
DO 210 LINDX = 1,NPSUB
IF (Z(I+1).EQ.SNAM(LINDX,1) .AND. Z(I+2).EQ.SNAM(LINDX,2))
1 GO TO 350
210 CONTINUE
WRITE (OUTT,630) UFM,Z(I+1),Z(I+2)
IERR = 1
GO TO 350
C
220 TRANS(KK) = Z(I+2)
TRAN = .TRUE.
GO TO 350
C
230 DO 240 L = 1,15
IF (Z(I+1) .EQ. ISYM(L,2)) GO TO 250
240 CONTINUE
IERR = 1
WRITE (OUTT,620) UFM,Z(I+1),COMP(KK,1),COMP(KK,2)
GO TO 350
250 SYMT(KK) = ISYM(L,1)
GO TO 350
C
260 DO 270 L = 1,NPSUB
IF (Z(I+1).EQ.SNAM(L,1) .AND. Z(I+2).EQ.SNAM(L,2)) GO TO 280
270 CONTINUE
WRITE (OUTT,630) UFM,Z(I+1),Z(I+2)
IERR = 1
GO TO 350
280 SRCH = .TRUE.
RESTCT(LINDX,L) = 1
RESTCT(L,LINDX) = 1
GO TO 350
C
290 IPRINT = ORF(IPRINT,Z(I+2))
GO TO 350
C
300 GO TO (350,350,310,350,320,330) , J
310 WRITE (OUTT,740) UFM
GO TO 340
320 WRITE (OUTT,750) UFM
GO TO 340
330 WRITE (OUTT,760) UFM
340 IERR = 1
350 CONTINUE
C
C IF NO SEARCH OPTIONS SPECIFIED - SEARCH ALL POSSIBLE CONNECTIONS
C
IF (SRCH) GO TO 370
DO 360 I = 1,7
DO 360 J = 1,7
360 RESTCT(I,J) = 1
370 CONTINUE
DO 400 I = 1,NPSUB
DO 380 J = 1,NPSUB
IF (SNAM(I,1).EQ.COMP(J,1) .AND. SNAM(I,2).EQ.COMP(J,2)) GO TO 390
380 CONTINUE
COMBO(I,1) = SNAM(I,1)
COMBO(I,2) = SNAM(I,2)
COMBO(I,3) = 0
COMBO(I,4) = 0
GO TO 400
390 COMBO(I,1) = SNAM(I,1)
COMBO(I,2) = SNAM(I,2)
COMBO(I,3) = TRANS(J)
COMBO(I,4) = SYMT(J)
400 CONTINUE
CALL CLOSE (CASECC,1)
CALL PAGE
WRITE (OUTT,690) NPSUB
IF (IAUTO) WRITE (OUTT,700)
IF (.NOT. IAUTO) WRITE (OUTT,710)
IF (.NOT.(IAUTO .OR. CONECT)) GO TO 550
410 IF (CONECT) WRITE (OUTT,720) CONSET
IF (CNAM(1).EQ.0 .AND. CNAM(2).EQ.0) GO TO 560
WRITE (OUTT,640) CNAM
CALL FDSUB (CNAM,ITEST)
IF (ITEST .NE. -1) GO TO 500
IF (PORA .EQ. PAPP) GO TO 540
420 IF (.NOT.LF(2)) GO TO 530
WRITE (OUTT,670) TOLER
CALL DECODE (IPRINT,IBITS,NFLG)
IF (NFLG .EQ. 0) IBITS(1) = 0
IF (NFLG .EQ. 0) GO TO 440
DO 430 I = 1,NFLG
IBITS(I) = IBITS(I) + 1
430 CONTINUE
440 CONTINUE
WRITE (OUTT,810) (IBITS(KDH),KDH=1,NFLG )
450 DO 480 I = 1,NPSUB
WRITE (OUTT,770) I,COMBO(I,1),COMBO(I,2)
NCNAM(1) = COMBO(I,1)
NCNAM(2) = COMBO(I,2)
CALL SFETCH (NCNAM,NHEQSS,3,ITEST)
IF (ITEST .EQ. 4) WRITE (OUTT,780) UFM,NCNAM
IF (ITEST .EQ. 4) IDRY = -2
IF (COMBO(I,3) .NE. 0) WRITE (OUTT,790) COMBO(I,3)
IF (COMBO(I,4) .EQ. 0) GO TO 480
DO 460 MJ = 1,15
IF (COMBO(I,4) .EQ. ISYM(MJ,1)) GO TO 470
460 CONTINUE
470 WRITE (OUTT,800) ISYM(MJ,2)
480 CONTINUE
490 IF (IERR .EQ. 1) IDRY = -2
GO TO 610
500 LITM = LODS
IF (PORA .EQ. PAPP) LITM = LOAP
CALL SFETCH (CNAM,LITM,3,ITEST)
LONLY = .FALSE.
IF (ITEST .EQ. 3) GO TO 520
IF (PORA .EQ. PAPP) GO TO 510
WRITE (OUTT,650) UFM
IERR = 1
GO TO 420
C
C OPTIONS PA YET LOAP ITEM ALREADY EXISTS
C
510 WRITE (OUTT,820) UFM,CNAM
IERR = 1
GO TO 490
C
C NEW LODS ONLY DEFINED
C
520 LONLY = .TRUE.
RETURN
C
530 WRITE (OUTT,660) UFM
IERR = 1
GO TO 450
C
C OPTIONS PA YET SUBSTRUCTURE DOES NOT EXIST
C
540 WRITE (OUTT,830) UFM,CNAM
IERR = 1
GO TO 490
550 WRITE (OUTT,680) UFM
IERR = 1
GO TO 410
560 WRITE (OUTT,730) UFM
IERR = 1
GO TO 490
570 IMSG = -2
GO TO 600
580 IMSG = -1
GO TO 600
590 IMSG = -3
600 CALL MESAGE (IMSG,IFILE,AAA)
610 CONTINUE
RETURN
C
620 FORMAT (A23,' 6505, THE SYMMETRY OPTION ',A4,
1 ' CONTAINS AN INVALID SYMBOL.')
630 FORMAT (A23,' 6506, THE COMPONENT SUBSTRUCTURE ',2A4,
1 ' IS NOT ONE OF THOSE ON THE COMBINE CARD.')
640 FORMAT (/10X,38HTHE RESULTANT PSEUDOSTRUCTURE NAME IS ,2A4)
650 FORMAT (A23,' 6508, THE NAME SPECIFIED FOR THE RESULTANT ',
1 'PSEUDOSTRUCTURE', /32X,'ALREADY EXISTS ON THE SOF.')
660 FORMAT (A23,' 6504, A TOLERANCE MUST BE SPECIFIED FOR A COMBINE ',
1 'OPERATION.')
670 FORMAT (/10X,32HTHE TOLERANCE ON CONNECTIONS IS ,E15.6)
680 FORMAT (A23,' 6501, THE MANUAL COMBINE OPTION HAS BEEN SPECIFIED',
1 ', BUT NO CONNECTION SET WAS GIVEN.')
690 FORMAT (/10X,'THIS JOB STEP WILL COMBINE ',I1,' PSEUDOSTRUCTURES')
700 FORMAT (/10X,40HCONNECTIONS ARE GENERATED AUTOMATICALLY. )
710 FORMAT (/10X,35HCONNECTIONS ARE SPECIFIED MANUALLY. )
720 FORMAT (/10X,25HTHE CONNECTION SET ID IS ,I8)
730 FORMAT (A23,' 6502, NO NAME HAS BEEN SPECIFIED FOR THE RESULTANT',
1 ' COMBINED PSEUDOSTRUCTURE.')
740 FORMAT (A23,' 6519, REDUNDANT NAMES FOR RESULTANT PSEUDOSTRUCTURE'
1, ' HAVE BEEN SPECIFIED.')
750 FORMAT (A23,' 6520, REDUNDANT VALUES FOR TOLER HAVE BEEN ',
1 'SPECIFIED.')
760 FORMAT (A23,' 6512, REDUNDANT CONNECTION SET ID S HAVE BEEN ',
1 'SPECIFIED.')
770 FORMAT (/10X, 27HCOMPONENT SUBSTRUCTURE NO. ,I1,8H NAME = ,2A4)
780 FORMAT (A23,' 6507, THE SUBSTRUCTURE ',2A4,' DOES NOT EXIST ON ',
1 'THE SOF FILE')
790 FORMAT (/15X, 15HTRANS SET ID = ,I8)
800 FORMAT (15X,22HSYMMETRY DIRECTIONS = ,A4)
810 FORMAT (/10X,30HTHE PRINT CONTROL OPTIONS ARE ,25I3)
820 FORMAT (A23,' 6533, OPTIONS PA HAS BEEN SPECIFIED BUT THE LOAP ',
1 'ITEM ALREADY EXISTS FOR SUBSTRUCTURE ',2A4)
830 FORMAT (A23,' 6534, OPTIONS PA HAS BEEN SPECIFIED BUT THE ',
1 'SUBSTRUCTURE ',2A4,' DOES NOT EXIST.', /30X,
2 'YOU CANNOT APPEND SOMETHING TO NOTHING.')
END
|
