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
|
SUBROUTINE OPT2C (PT,IEL,IPR,PR,RR)
C
LOGICAL KPUN
INTEGER B1,PT(2,1),COUNT,EID,EJECT,EST1,EST2,ETYP,HEADNG,
1 OUTTAP,IEL(1),IPR(1),IZ(100),NAME(2),NEOP(21),
2 SYSBUF,WDOPT(42),YCOR,ZCOR,MCB(7),IY(1),
3 TUBE,QUAD4,TRIM6,TRIA3
REAL PR(1),RR(1),Y(1),BLK,PCD(2,21),G(2,10),PARM(8)
CHARACTER UFM*23,UWM*25,UIM*29,SFM*25
COMMON /XMSSG / UFM,UWM,UIM,SFM
COMMON /BLANK / SKP1(2),COUNT,NCARD,SKP2,YCOR,B1,NELOP,NWDSE,
1 NWDSP,SKP3(2),EST1,SKP4,EST2,NELW,NPRW,NKLW,NTOTL,
2 CONV
COMMON /OPTPW2/ ZCOR,Z(100)
COMMON /ZZZZZZ/ CORE(1)
COMMON /NAMES / NRD,NOEOR,NWRT,NWEOR
COMMON /SYSTEM/ SYSBUF,OUTTAP,SKPS1(6),NLPP,SKPS2(2),NLINES,
1 SKPS3(78),LPCH
COMMON /GPTA1 / NTYPES,LAST,INCR,NE(1)
EQUIVALENCE (IZ(1),Z(1)), (EID,Z(1)), (CORE(1),PARM(1),MAX),
1 (G(1,1),IZ(100)), (G(1,10),IG10), (IPRNT,PARM(7)),
2 (IY(1),Y(1),PARM(8))
C EQUIVALENT ARE (IPR,PR)
C
C
C NOTE - CHANGE EQUIVALENCE IF AN ELEMENT TO BE OPTIMIZED HAS EST
C (EPT ONLY) ENTRIES BEYOND 100 WORDS.
C
DATA NAME / 4H OPT, 4H2C /
DATA NMES , YES,PLUS,BLK / 0, 4HYES , 4H+AAA, 4H /
DATA TUBE , QUAD4,TRIM6,TRIA3 / 3, 64 , 73, 83 /
DATA PCD /
1 4HPBAR,4H , 4HPELB,4HOW , 4HPIS2,4HD8 , 4HPQDM,4HEM ,
2 4HPQDM,4HEM1 , 4HPQDM,4HEM2 , 4HPQDP,4HLT , 4HPQUA,4HD1 ,
3 4HPQUA,4HD2 , 4HPROD,4H , 4HPSHE,4HAR , 4HPTRB,4HSC ,
4 4HPTRI,4HA1 , 4HPTRI,4HA2 , 4HPTRI,4HM6 , 4HPTRM,4HEM ,
5 4HPTRP,4HLT , 4HPTUB,4HE , 4HPSHE,4HLL , 4HPSHE,4HLL ,
6 4HYYYY,4H /
C
C POINTERS TO WORDS ON EST TO CONVERT. NEOP(ITP) IS POINTER INTO
C -WDOPT- ARRAY. THE -WDOPT- FIRST ENTRY FOR THE ELEMENT IS THE
C NUMBER OF ENTRIES ON -EST- TO CONVERT FOLLOWED BY THE WORD NUMBERS
C TO OPTIMIZE.
C
DATA NEOP / 21,30,39,15,15, 15,27,17,15,1, 6,12,8,6,35,
1 6,12, 4,41,41, 0/
DATA WDOPT /
C
C ROD (A,J)
1 2, 5,6
C
C TUBE (O.D.)
2, 1, 5
C
C SHEAR(T), TRMEM(T), TRIA2(T)
3, 1, 7
C
C TRIA1(T1,T2,I)
4, 3, 7,9,11
C
C TRBSC(T2,I),TRPLT(T2,I)
5, 2, 7,9
C
C QDMEM(T), QDMEM1(T), QDMEM2(T), QUAD2(T)
6, 1, 8
C
C QUAD1(T1,T2,I)
7, 3, 8,10,12
C
C BAR(A,J,I1,I2,I12)
8, 5, 17,18,19,20,33
C
C QDPLT(T2,I)
9, 2, 8,10
C
C ELBOW(A,J,I1,I2)
O, 4, 9,10,11,12
C
C TRIM6(T1,T3,T5)
1, 3, 10,11,12
C
C IS2D8(T)
2, 1, 13
C
C QUAD4(T), TRIA3(T) PSHELL ONLY
3, 1, 14
* /
C
C DETERMINE IF PROPTETY CARDS ARE TO BE PUNCHED
C
KPUN = .FALSE.
KOUNT = 0
HEADNG = 0
CH = 1.0
ICP = NTOTL
IF (COUNT.EQ.MAX .OR. CONV.EQ.2.0) KPUN =.TRUE.
IF (PARM(5) .NE. YES) KPUN = .FALSE.
IF (IPRNT .NE. 0) NLINES = NLPP
IE2 = 1
LEL = 0
C
C READ EST1 ELEMENT TYPE
C
10 CALL READ (*400,*360,EST1,ETYP,1,NOEOR,I)
CALL WRITE (EST2,ETYP,1,NOEOR)
ITP = IY(ETYP)
IF (ITP .EQ. 0) GO TO 20
IE1 = PT(1,ITP)
C
C CHECK IF CORE ELEMENTS SKIPPED BECAUSE TYPE NOT ON EST
C
IF (IE1 .GT. IE2) GO TO 60
IE2 = PT(1,ITP+1)
LEL = IEL(IE1)
IP1 = PT(2,ITP) - 1
IF (IE2 .GT. IE1) GO TO 40
C
C SKIP THIS ELEMENT TYPE. COPY RECORD TO EST2
C
20 J = 1
N = ZCOR
CALL READ (*30,*30,EST1,Z,ZCOR,NOEOR,N)
J = 0
30 CALL WRITE (EST2,Z(1),N,J)
IF (J) 10,20,10
C
C ELEMENT TYPE HAS CORE ENTRIES
C
40 CONTINUE
NWDS = INCR*(ETYP-1) + 12
NWDS = NE(NWDS)
NPCARD = 0
IF (NWDS .GT. ZCOR) CALL MESAGE (-8,ZCOR,NAME)
C
C READ ONE EST1 ELEMENT INTO CORE
C
50 CALL READ (*350,*340,EST1,Z,NWDS,NOEOR,I)
IF (EID-LEL) 55,80,60
C
C ELEMENT ID NOT IN CORE
C
55 CALL WRITE (EST2,IZ(1),NWDS,NOEOR)
GO TO 50
C
C ELEMENT IN CORE NOT ON EST
C
60 I = EJECT(2)
IF (I .EQ. 0) GO TO 68
IF (COUNT.EQ.MAX .OR. CONV.EQ.2.0) GO TO 66
WRITE (OUTTAP,65) COUNT
65 FORMAT (1H0,8X,45HPROPERTIES USED DURING INTERMEDIATE ITERATION,
1 I5, 10H BY OPTPR2/)
GO TO 68
66 WRITE (OUTTAP,67) COUNT
67 FORMAT (1H0,8X,38HPROPERTIES USED DURING FINAL ITERATION,
1 I5, 10H BY OPTPR2/)
68 WRITE (OUTTAP,70) SFM,ETYP,LEL,NAME
70 FORMAT (A25,' 2297, INCORRECT LOGIC FOR ELEMENT TYPE',I4,
1 ', ELEMENT',I8,2H (,2A4,2H).)
CALL MESAGE (-61,LEL,NAME)
C
C ELEMENT IN CORE - CONVERT THE ENTRIES
C
80 IPL = IEL(IE1+4) + IP1
IE1 = IE1 + NWDSE
LEL = IEL(IE1)
IF (IE1 .GT. IE2) LEL = 100000000
A = PR(IPL+4)
IF (A .GT. 0.0) GO TO 100
NMES = NMES + 1
IF (IPRNT.EQ.0 .OR. NMES.GT.100) GO TO 55
I = EJECT (2)
IF (I .EQ. 0) GO TO 88
IF (COUNT.EQ.MAX .OR. CONV.EQ.2.0) GO TO 84
WRITE (OUTTAP,65) COUNT
GO TO 88
84 WRITE (OUTTAP,65) COUNT
88 WRITE (OUTTAP,90) UIM,EID
90 FORMAT (A29,' 2305, OPTPR2 DETECTED NEGATIVE ALPHA FOR ELEMENT',
1 I8)
GO TO 55
C
100 LOCF = NEOP(ITP)
J = LOCF
K = WDOPT(LOCF)
IRR = (IPL+NWDSP)/NWDSP
IF (ABS(PARM(3)-1.0) .LT. 0.0001) CH = 0.25*RR(IRR) + 0.75
C = (A/(A+(1.0-A)*PARM(3)))**CH
IF (ETYP .NE. TRIM6) GO TO 105
C
C SPECIAL HANDLING FOR TRIM6
C IF THICKNESS-3 OR THICKNESS-5 IS ZERO, SET EQUAL TO THICKNESS-1
C
DO 102 JJ = 1,K
J = J +1
L = WDOPT(J)
IF (JJ.NE.K .AND. ABS(Z(L+1)).LT.1.E-7) Z(L+1) = Z(L)
PC = Y(ICP+JJ)
102 Z(L) = Z(L)*(PC/(PC+(1.0-PC)*PARM(3)))
ICP = ICP + 4
GO TO 115
C
105 DO 110 I = 1,K
J = J + 1
L = WDOPT(J)
110 Z(L) = C*Z(L)
IF (ETYP.NE.QUAD4 .AND. ETYP.NE.TRIA3) GO TO 112
Z(L+6) = 0.5*Z(L)
Z(L+7) = -0.5*Z(L)
112 IF (ETYP.EQ.TUBE .AND. Z(L).LT.2.*Z(L+1)) Z(L+1) = .5*Z(L)
115 CALL WRITE (EST2,Z(1),NWDS,NOEOR)
C
C PUNCH AND/OR PRINT PROPERTY CARDS
C
IF (IPRNT.EQ.0 .OR. IPR(IPL).LE.0) GO TO 50
GO TO (120,130,140,150,150,150,160,170,150,180,150,160,170,150,
1 180,150,160,190,170,170), ITP
C
C PBAR
C
120 K1 = 02222211
K2 = 22222222
K3 = 00000222
GO TO 250
C
C PELBOW
C
130 K1 = 02222211
K2 = 22222222
K3 = 22222222
GO TO 250
C
C PIS2D8
C
140 K1 = 00000211
GO TO 230
C
C PQDMEM, PQDMEM1, PQDMEM2, PQUAD2, PSHEAR, PTRIA2, PTRMEM
C
150 K1 = 00002211
GO TO 230
C
C PQDPLT, PTRBSC, PTRPLT
C
160 K1 = 22221211
GO TO 230
C
C PQUAD1, PTRIA1, PSHELL
C
170 K1 = 22121211
K2 = 00000022
GO TO 240
C
C PROD, PTRIM6
C
180 K1 = 00222211
GO TO 230
C
C PTUBE
C
190 K1 = 00022211
C
C OUTPUT THE CARD(S)
C
230 K2 = 0
240 K3 = 0
250 II = WDOPT(LOCF+1) - 4
KK = K1
G(1,1) = PCD(1,ITP)
G(2,1) = PCD(2,ITP)
IZ(II+2) = IPR(IPL)
IPR(IPL) =-IPR(IPL)
260 DO 270 I = 2,9
G(1,I) = BLK
G(2,I) = BLK
J = MOD(KK,10)
IF (J .EQ. 0) GO TO 270
IF (J .EQ. 1) CALL INT2A8 (*370,IZ(I+II),G(1,I))
IF (J .EQ. 2) CALL FP2A8 (*380, Z(I+II),G(1,I))
270 KK = KK/10
G(1,10) = BLK
G(2,10) = BLK
IF (K2.EQ.0 .OR. (K2.EQ.-1 .AND. K3.EQ.0) .OR. K3.EQ.-1) GO TO 320
KOUNT = KOUNT + 1
CALL INT2A8 (*375,KOUNT,G(1,10))
G(2,10) = G(1,10)
IG10 = KHRFN3(G(1,1),PLUS,-3,1)
IF (HEADNG .EQ. 0) GO TO 320
280 WRITE (OUTTAP,290) G
290 FORMAT (5X,10(2A4,1X))
IF (.NOT.KPUN) GO TO 300
WRITE (LPCH,295) G
295 FORMAT (20A4)
NCARD = NCARD + 1
C
C SET UP FOR CONTINUATION CARD(S)
C
300 IF (K2.EQ.0 .OR. (K2.EQ.-1 .AND. K3.EQ.0) .OR. K3.EQ.-1) GO TO 50
G(1,1) = G(1,10)
G(2,1) = G(2,10)
II = II + 8
IF (K2) 315,50,310
310 KK = K2
K2 = -1
GO TO 260
315 KK = K3
K3 = -1
GO TO 260
C
C PRINT HEADING
C
320 HEADNG = 1
IF (EJECT(1) .EQ. 0) GO TO 280
IF (COUNT.EQ.MAX .OR. CONV.EQ.2.0) GO TO 330
WRITE (OUTTAP,65) COUNT
GO TO 280
330 WRITE (OUTTAP,67) COUNT
GO TO 280
C
C EOR ON EST1
C
340 CALL WRITE (EST2,0,0,NWEOR)
IF (IE1-IE2) 60,10,10
C
C ERRORS
C
350 CALL MESAGE (-2,EST1,NAME)
360 CALL MESAGE (-3,EST1,NAME)
370 J = 370
GO TO 390
375 J = 375
I = KOUNT
GO TO 390
380 J = 380
390 WRITE (OUTTAP,395) J,G(1,1),G(2,1),I,II,IZ(I+II),Z(I+II)
395 FORMAT (16H0*** OPT2C/ERROR,I5,9X,5HELEM ,2A4,3I9,E10.4 )
GO TO 50
C
400 CALL EOF (EST2)
MCB(1) = EST1
CALL RDTRL(MCB)
MCB(1) = EST2
CALL WRTTRL(MCB)
RETURN
END
|
