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
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
|
SUBROUTINE CMRD2F (KODE)
C
C THIS SUBROUTINE CALCULATES THE FINAL STRUCTURAL MATRICES FOR THE
C CMRED2 MODULE.
C
C INPUT DATA
C GINO - KBB - STIFFNESS PARTITION MATRIX
C KIB - KIB STIFFNESS PATTITION MATRIX
C HIE - HIE PARTITION MATRIX
C KII - KII PARTITION MATRIX
C HGH - HORG PARTITION MATRIX
C MAA - MASS INPUT MATRIX
C BAA - DAMPING INPUT MATRIX
C K4AA - STIFFNESS INPUT MATRIX
C PAA - LOADS INPUT MATRIX
C SOF - GIMS - G TRANSFORMATION MATRIX
C
C OUTPUT DATA
C GINO - KHH - STIFFNESS MATRIX
C MHH - MASS MATRIX
C BHH - DAMPING MATRIX
C K4HH - K4HH MATRIX
C PHH - LOADS MATRIX
C SOF - KMTX - STIFFNESS MATRIX
C MMTX - MASS MATRIX
C PVEC - LOADS MATRIX
C PAPP - APPENDED LOADS MATRIX
C BMTX - DAMPING MATRIX
C K4MX - K4MX STIFFNESS MATRIX
C
C PARAMETERS
C INPUT- POPT - LOADS OPTION FLAG
C GBUF - GINO BUFFERS
C INFILE - INPUT FILE NUMBERS
C OTFILE - OUTPUT FILE NUMBERS
C ISCR - SCRATCH FILE NUMBERS
C KORLEN - LENGTH OF OPEN CORE
C KORBGN - BEGINNING ADDRESS OF OPEN CORE
C OLDNAM - NAME OF SUBSTRUCTURE BEING REDUCED
C OTHERS-PAA - LOADS INPUT FILE NUMBER
C KHH - STIFFNESS OUTPUT FILE NUMBER
C POVE - LOADS OUTPUT FILE NUMBER
C UPRT - PARTITION VECTOR FILE NUMBER
C ZEROMB - ZERO PARTITION FILE NUMBER
C KBB - KBB INPUT FILE NUMBER
C ZEROBM - ZERO PARTITION MATRIX
C KIB - KIB INPUT FILE NUMBER
C KII - KII INPUT FILE NUMBER
C KBARBB - KBARBB FILE NU BER
C GIB - GIB INPUT FILE NUMBER
C KMM - KMM FILE NUMBER
C HGH - HORG INPUT FILE NUMBER
C
LOGICAL SYMTRY,MODES,PONLY
INTEGER DRY,POPT,GBUF1,SBUF1,SBUF2,SBUF3,OTFILE,OLDNAM,Z,
1 T,SIGNAB,SIGNC,PREC,SCR,TYPIN,TYPOUT,UN,UB,UI,
2 FUSET,PREC3,PAA,HIM,POVE,UPRT,GIB,GIBBAR,HGHBAR,
3 HGH,USETMR,CMRED2,PAPP,BLANKS,DBLKOR,HIMBAR,EQST
DOUBLE PRECISION DZ
DIMENSION MODNAM(2),ITRLR1(7),ITRLR2(7),ITRLR3(7),ISUB(4),
1 ITMLST(12),ITMNAM(2),RZ(1),DZ(1)
CHARACTER UFM*23
COMMON /XMSSG / UFM
COMMON /BLANK / IDUM1,DRY,POPT,GBUF1,IDUM2(2),SBUF1,SBUF2,SBUF3,
1 INFILE(11),OTFILE(6),ISCR(11),KORLEN,KORBGN,
2 OLDNAM(2),NEWNAM(2),SYMTRY,IDUM6(4),MODES,
3 IDUM7(4),PONLY,LSTZWD
COMMON /ZZZZZZ/ Z(1)
COMMON /MPYADX/ ITRLRA(7),ITRLRB(7),ITRLRC(7),ITRLRD(7),NZ,T,
1 SIGNAB,SIGNC,PREC,SCR
COMMON /PACKX / TYPIN,TYPOUT,IROW,NROW,INCR
COMMON /BITPOS/ IDUM4(9),UN,IDUM5(10),UB,UI
COMMON /PATX / LCORE,NSUB(3),FUSET
COMMON /SYSTEM/ IDUM3,IPRNTR
COMMON /MPY3TL/ JTRLRA(7),JTRLRB(7),JTRLRE(7),JTRLRC(7),JSCR(3),
1 LKORE,ICODE,PREC3
EQUIVALENCE (EQST,INFILE(5)),(USETMR,INFILE(6)),
1 (PAA,INFILE(11)),(KHH,OTFILE(1)),(POVE,OTFILE(6)),
2 (KBB,ISCR(1)),(KIB,ISCR(2)),(KII,ISCR(4)),
3 (HIM,ISCR(10)),(UPRT,ISCR(1)),(HIMBAR,ISCR(8)),
4 (KBARBB,ISCR(5)),(KMM,ISCR(6)),(GIB,ISCR(3)),
5 (GIBBAR,ISCR(11)),(HGHBAR,ISCR(9)),(HGH,ISCR(8)),
6 (RPRTN,ISCR(1)),(RZ(1),Z(1)),(DZ(1),Z(1))
DATA MODNAM/ 4HCMRD,4H2F /, PAPP / 4HPAPP/, BLANKS/ 4H /
DATA CMRED2/ 26 /
DATA ITMLST/ 4HKMTX,4HHORG,4HHLFT,4HMMTX,4HBMTX,4HK4MX,4HPVEC,
1 4HPAPP,4HPOVE,4HGIMS,4HPOAP,4HUPRT/
C
C SELECT OPERATION MODE
C
IF (DRY .EQ. -2) RETURN
IF (PONLY .OR. DRY.EQ.0) GO TO 90
C
C SET UP NEW SUBSTRUCTURE
C
IF (MODES) GO TO 1
NUMB = 1
CALL SETLVL (NEWNAM,NUMB,OLDNAM,ITEST,CMRED2)
IF (ITEST .EQ. 8) GO TO 290
C
C CHECK FOR STIFFNESS MATRIX GENERATION
C
1 ITRLR1(1) = KHH
CALL RDTRL (ITRLR1)
IF (ITRLR1(1) .LT. 0) GO TO 90
C
C FORM PRELIMINARY STIFFNESS CALCULATION
C
C T
C ** ** ** ** ** ** ** **
C * * * * * * * *
C * KBARBB * = * KBB * + * GIB(BAR) * * KIB *
C * * * * * * * *
C ** ** ** ** ** ** ** **
C
ITRLR1(1) = KBB
CALL RDTRL (ITRLR1)
IF (SYMTRY) GO TO 2
ITRLR2(1) = GIBBAR
CALL RDTRL (ITRLR2)
GO TO 4
2 ITEM = ITMLST(10)
CALL SOFTRL (OLDNAM,ITEM,ITRLR2)
ITEST = ITRLR2(1)
ITMNAM(1) = OLDNAM(1)
ITMNAM(2) = OLDNAM(2)
IF (ITEST .NE. 1) GO TO 200
CALL MTRXI (GIB,OLDNAM,ITEM,0,ITEST)
IF (ITEST .NE. 1) GO TO 200
ITRLR2(1) = GIB
4 ITRLR3(1) = KIB
CALL RDTRL (ITRLR3)
DO 10 I = 1,7
ITRLRA(I) = ITRLR2(I)
ITRLRB(I) = ITRLR3(I)
10 ITRLRC(I) = ITRLR1(I)
IFORM = 1
IPRC = 1
ITYP = 0
IF (ITRLRA(5).EQ.2 .OR. ITRLRA(5).EQ.4) IPRC = 2
IF (ITRLRB(5).EQ.2 .OR. ITRLRB(5).EQ.4) IPRC = 2
IF (ITRLRC(5).EQ.2 .OR. ITRLRC(5).EQ.4) IPRC = 2
IF (ITRLRA(5) .GE. 3) ITYP = 2
IF (ITRLRB(5) .GE. 3) ITYP = 2
IF (ITRLRC(5) .GE. 3) ITYP = 2
ITYPE = IPRC + ITYP
CALL MAKMCB (ITRLRD,KBARBB,ITRLR1(3),IFORM,ITYPE)
T = 1
SIGNAB = 1
SIGNC = 1
PREC = 0
SCR = ISCR(7)
SCR = ISCR(1)
CALL SOFCLS
DBLKOR = KORBGN/2 + 1
NZ = LSTZWD - (2*DBLKOR - 1)
CALL MPYAD (DZ(DBLKOR),DZ(DBLKOR),DZ(DBLKOR))
CALL WRTTRL (ITRLRD)
KBAROW = ITRLRD(3)
KCOL = ITRLRD(2)
C
C FORM PRELIMINARY STIFFNESS CALCULATION
C
C T
C ** ** ** ** ** ** ** **
C * * * * * * * *
C * KMM * = * HIM(BAR) * * KII * * HIM *
C * * * * * * * *
C ** ** ** ** ** ** ** **
C
ITRLR1(1) = KII
ITRLR2(1) = HIM
CALL RDTRL (ITRLR1)
CALL RDTRL (ITRLR2)
DO 20 I = 1,7
ITRLRA(I) = ITRLR1(I)
ITRLRB(I) = ITRLR2(I)
20 ITRLRC(I) = 0
IFORM = 2
IPRC = 1
ITYP = 0
IF (ITRLRA(5).EQ.2 .OR. ITRLRA(5).EQ.4) IPRC = 2
IF (ITRLRB(5).EQ.2 .OR. ITRLRB(5).EQ.4) IPRC = 2
IF (ITRLRA(5) .GE. 3) ITYP = 2
IF (ITRLRB(5) .GE. 3) ITYP = 2
ITYPE = IPRC + ITYP
CALL MAKMCB (ITRLRD,ISCR(2),ITRLR2(3),IFORM,ITYPE)
PREC = 0
T = 0
SIGNAB= 1
SIGNC = 1
SCR = ISCR(1)
CALL MPYAD (DZ(DBLKOR),DZ(DBLKOR),DZ(DBLKOR))
CALL WRTTRL (ITRLRD)
ITRLR1(1) = HIM
IF (.NOT.SYMTRY) ITRLR1(1) = HIMBAR
CALL RDTRL (ITRLR1)
DO 30 I = 1,7
ITRLRA(I) = ITRLR1(I)
30 ITRLRB(I) = ITRLRD(I)
IFORM = 1
IPRC = 1
ITYP = 0
IF (ITRLRA(5).EQ.2 .OR. ITRLRA(5).EQ.4) IPRC = 2
IF (ITRLRB(5).EQ.2 .OR. ITRLRB(5).EQ.4) IPRC = 2
IF (ITRLRA(5) .GE. 3) ITYP = 2
IF (ITRLRB(5) .GE. 3) ITYP = 2
ITYPE = IPRC + ITYP
CALL MAKMCB (ITRLRD,KMM,ITRLR1(2),IFORM,ITYPE)
T = 1
PREC = 0
CALL MPYAD (DZ(DBLKOR),DZ(DBLKOR),DZ(DBLKOR))
CALL WRTTRL (ITRLRD)
KMMROW = ITRLRD(3)
KMMCOL = ITRLRD(2)
C
C GENERATE MERGE PARTITION VECTOR
C
NROW = KCOL + KMMCOL
DO 80 I = 1,NROW
RZ(KORBGN+I-1) = 0.0
IF (I .GT. KCOL) RZ(KORBGN+I-1) = 1.0
80 CONTINUE
TYPIN = 1
TYPOUT = 1
IROW = 1
INCR = 1
IFORM = 7
CALL MAKMCB (ITRLR1,RPRTN,NROW,IFORM,TYPIN)
CALL GOPEN (RPRTN,Z(GBUF1),1)
CALL PACK (RZ(KORBGN),RPRTN,ITRLR1)
CALL CLOSE (RPRTN,1)
CALL WRTTRL (ITRLR1)
C
C FORM STIFFNESS MATRIX
C
C ** **
C * . *
C ** ** * KBARBB . 0 *
C * * * . *
C * KHH * = *..............*
C * * * . *
C ** ** * 0 . KMM *
C * . *
C ** **
C
ISUB(1) = KCOL
ISUB(2) = KMMCOL
ISUB(3) = KBAROW
ISUB(4) = KMMROW
ITYPE = 1
CALL GMMERG (KHH,KBARBB,0,0,KMM,RPRTN,RPRTN,ISUB,ITYPE,Z(KORBGN),
1 KORLEN)
C
C STORE KHH AS KMTX ON SOF
C
CALL SOFOPN (Z(SBUF1),Z(SBUF2),Z(SBUF3))
CALL MTRXO (KHH,NEWNAM,ITMLST(1),0,ITEST)
ITEM = ITMLST(1)
ITMNAM(1) = NEWNAM(1)
ITMNAM(2) = NEWNAM(2)
IF (ITEST .NE. 3) GO TO 200
C
C LOCATE HGH MATRIX
C KODE .EQ. 0, BOTH HORG, HLFT ON SOF
C KODE .EQ. 1, HORG CALCULATED, HLFT ON SOF
C KODE .EQ. 2, HORG ON SOF, HLFT CALCULATED
C KODE .EQ. 3, BOTH HORG, HLFT CALCULATED
C
90 ITEM = ITMLST(2)
ITMNAM(1) = OLDNAM(1)
ITMNAM(2) = OLDNAM(2)
CALL MTRXI (HGH,OLDNAM,ITEM,0,ITEST)
IF (ITEST .NE. 1) GO TO 200
IF (KODE.GT.1 .OR. SYMTRY) GO TO 100
ITEM = ITMLST(3)
CALL MTRXI (HGHBAR,OLDNAM,ITEM,0,ITEST)
IF (ITEST .NE. 1) GO TO 200
100 SIGNAB = 1
SIGNC = 1
SCR = ISCR(1)
DBLKOR = KORBGN/2 + 1
NZ = LSTZWD - (2*DBLKOR - 1)
ITMNAM(1) = NEWNAM(1)
ITMNAM(2) = NEWNAM(2)
C
C GENERATE MATRICES REQUESTED
C I .EQ. 2, GENERATE MHH MATRIX
C I .EQ. 3, GENERATE BHH MATRIX
C I .EQ. 4, GENERATE K4HH MATRIX
C I .EQ. 5, GENERATE PHH MATRIX
C
DO 180 I = 2,5
ITRLR1(1) = INFILE(I+6)
CALL RDTRL (ITRLR1)
IF (ITRLR1(1) .LT. 0) GO TO 180
CALL SOFCLS
C
C CALCULATE MATRIX REQUIRED
C
C T
C ** ** ** ** ** ** ** **
C * * * * * * * *
C * (M,B,K4)HH * = * HGH(BAR) * * (M,B,K4)AA * * HGH *
C * * * * * * * *
C ** ** ** ** ** ** ** **
C
C T
C ** ** ** ** ** **
C * * * * * *
C * PHH * = * HGH(BAR) * * PAA *
C * * * * * *
C ** ** ** ** ** **
C
ITRLR2(1) = HGH
CALL RDTRL (ITRLR2)
IF (I .EQ. 5) GO TO 112
DO 110 J = 1,7
ITRLRA(J) = ITRLR1(J)
ITRLRB(J) = ITRLR2(J)
110 ITRLRC(J) = 0
IFORM = 2
IF (ITRLR1(3) .EQ. ITRLR2(2)) IFORM = 1
IPRC = 1
ITYP = 0
IF (ITRLR1(5).EQ.2 .OR. ITRLR1(5).EQ.4) IPRC = 2
IF (ITRLR2(5).EQ.2 .OR. ITRLR2(5).EQ.4) IPRC = 2
IF (ITRLR1(5) .GE. 3) ITYP = 2
IF (ITRLR2(5) .GE. 3) ITYP = 2
ITYPE = IPRC + ITYP
CALL MAKMCB (ITRLRD,ISCR(2),ITRLR1(3),IFORM,ITYPE)
PREC = 0
T = 0
SIGNAB= 1
SIGNC = 1
SCR = ISCR(1)
CALL MPYAD (DZ(DBLKOR),DZ(DBLKOR),DZ(DBLKOR))
CALL WRTTRL (ITRLRD)
ITEM = ITMLST(I+2)
GO TO 116
112 DO 114 J = 1,7
114 ITRLRD(J) = ITRLR1(J)
ITEM = ITMLST(7)
IF (POPT .EQ. PAPP) ITEM = ITMLST(8)
116 ITRLR2(1) = HGH
IF (.NOT. SYMTRY) ITRLR2(1) = HGHBAR
CALL RDTRL (ITRLR2)
DO 120 J = 1,7
ITRLRA(J) = ITRLR2(J)
120 ITRLRB(J) = ITRLRD(J)
IFORM = 1
IPRC = 1
ITYP = 0
IF (ITRLRD(5).EQ.2 .OR. ITRLRD(5).EQ.4) IPRC = 2
IF (ITRLR2(5).EQ.2 .OR. ITRLR2(5).EQ.4) IPRC = 2
IF (ITRLRD(5) .GE. 3) ITYP = 2
IF (ITRLR2(5) .GE. 3) ITYP = 2
ITYPE = IPRC + ITYP
CALL MAKMCB (ITRLRD,OTFILE(I),ITRLR2(2),IFORM,ITYPE)
T = 1
PREC = 0
CALL MPYAD (DZ(DBLKOR),DZ(DBLKOR),DZ(DBLKOR))
CALL WRTTRL (ITRLRD)
C
C STORE MATRIX ON SOF
C I .EQ. 2, STORE MHH AS MMTX
C I .EQ. 3, STORE BHH AS BMTX
C I .EQ. 4, STORE K4HH AS K4MX
C I .EQ. 5, STORE PHH AS PVEC OR PAPP
C
CALL SOFOPN (Z(SBUF1),Z(SBUF2),Z(SBUF3))
CALL MTRXO (OTFILE(I),NEWNAM,ITEM,0,ITEST)
IF (ITEST .NE. 3) GO TO 200
180 CONTINUE
C
C TEST FOR LOAD PROCESSING
C
IF (POPT .EQ. BLANKS) GO TO 190
ITMNAM(1) = OLDNAM(1)
ITMNAM(2) = OLDNAM(2)
IF (.NOT.PONLY) GO TO 184
ITRLR1(1) = EQST
CALL RDTRL (ITRLR1)
NSUB(1) = ITRLR1(6)
NSUB(2) = ITRLR1(7)
ITEM = ITMLST(12)
CALL MTRXI (UPRT,OLDNAM,ITEM,0,ITEST)
IF (ITEST .NE. 1) GO TO 200
GO TO 188
C
C PARTITION PAA VECTOR
C
184 LCORE = KORLEN
FUSET = USETMR
CALL CALCV (UPRT,UN,UI,UB,Z(KORBGN))
188 CALL GMPRTN (PAA,POVE,0,0,0,0,UPRT,NSUB(1),NSUB(2),Z(KORBGN),
1 KORLEN)
C
C SAVE POVE AS POVE OR POAP ON SOF
C
IF (MODES) GO TO 190
ITEM = ITMLST(9)
IF (POPT .EQ. PAPP) ITEM = ITMLST(11)
CALL MTRXO (POVE,OLDNAM,ITEM,0,ITEST)
IF (ITEST .NE. 3) GO TO 200
190 CONTINUE
RETURN
C
C PROCESS MODULE ERRORS
C
200 GO TO (210,210,210,220,230,250), ITEST
210 WRITE (IPRNTR,900) UFM,MODNAM,ITEM,ITMNAM
DRY = -2
RETURN
C
220 IMSG = -2
GO TO 240
230 IMSG = -3
240 CALL SMSG (IMSG,ITEM,ITMNAM)
RETURN
C
250 WRITE (IPRNTR,901) UFM,MODNAM,ITEM,ITMNAM
DRY = -2
RETURN
C
290 WRITE (IPRNTR,902) UFM
DRY = -2
RETURN
C
900 FORMAT (A23,' 6211, MODULE ',2A4,' - ITEM ',A4,
1 ' OF SUBSTRUCTURE ',2A4,' HAS ALREADY BEEN WRITTEN.')
901 FORMAT (A23,' 6632, MODULE ',2A4,' - NASTRAN MATRIX FILE FOR I/O',
1 ' OF SOF ITEM ',A4,', SUBSTRUCTURE ',2A4,', IS PURGED.')
902 FORMAT (A23,' 6518, ONE OF THE COMPONENT SUBSTRUCTURES HAS BEEN ',
1 'USED IN A PREVIOUS COMBINE OR REDUCE.')
C
END
|
