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
|
SUBROUTINE PIDCK (PFILE,GEOM2,NOPID,Z)
C
C THIS ROUTINE CHECKS THE UNIQUNESS OF PROPERTY IDS FOR ALL ELEMENTS
C THAT HAVE PID FIELDS
C
C IT SHOULD BE CALLED ONLY ONCE BY IFP
C IT DOES NOT OPEN NOR CLOSE ANY GINO FILE.
C
C DESIGN REQUIREMENT -
C
C IF PID IS REFERENCED BY AN ELEMENT, THE PID MUST RESIDE ON THE
C THIRD FIELD OF THE ELEMENT INPUT CARD.
C INPUT FILES - GEOM2 AND PROPERTY FILE (EPT).
C
C THIS VERSION INCLUDES SPECIAL HANDLING OF THE CQUAD4 AND CTRIA3
C ELEMENTS WHICH USE AND SHARE MORE THAN ONE STANDARD PROPERTY CARD.
C THE PROPERTY TYPE IDS OF THE PSHELL, PCOMP, PCOMP1 AND PCOMP2
C MUST NOT BE INTERRUPTED BY ANOTHER PROPERTY TYPE. (I.E. NO OTHER
C PROPERTY TYPE SHOULD HAVE AN ID PLACED IN BETWEEN 5502 THRU 5802).
C NOTICE THAT THE PSHELL CARD HAS FIXED LENGTH WHILE THE 3 PCOMPI
C CARDS HAVE VARIABLE LENGTH.
C
C WRITTEN BY G.CHAN/UNISYS, SEPT. 1983
C
LOGICAL ABORT
INTEGER PFILE, GEOM2, Z(1), NAME(2),
1 FLAG, X(3), QUAD4, PSHELL,
2 PCOMP(3)
CHARACTER UFM*23, UWM*25, UIM*29
COMMON /XMSSG / UFM, UWM, UIM
COMMON /SYSTEM/ IBUF, NOUT, ABORT, SKIP(42),
1 KDUM(9)
COMMON /GPTA1 / NELEM, LAST, INCR, NE(1)
DATA QUAD4 , PSHELL, PCOMP /
1 5408 , 5802, 5502, 5602, 5702 /
DATA NAME / 4HPIDC, 4HK /
C
C UPDATE /GPTA1/ IF DUMMY ELEMENTS ARE PRESENT
C
DO 90 I = 1,9
IF (KDUM(I) .EQ. 0) GO TO 90
K = KDUM(I)
NG = K/10000000
NC = (K-NG*10000000)/10000
NP = (K-NG*10000000 - NC*10000)/10
K = (51+I)*INCR
NE(K+ 6) = 2 + NG + NC
NE(K+ 9) = 2 + NP
NE(K+10) = NG
90 CONTINUE
C
C CREATE A PROPERTY ID TABLE IN Z FROM /GPTA1/ DATA BLOCK FOR THOSE
C ELEMENTS THAT HAVE PROPERTY CARDS
C 4 WORDS PER ENTRY
C WORD 1, PROPERTY TYPE CODE (EPT-ID)
C WORD 2, LENGTH OF PROPERTY CARD (EPTWDS)
C WORD 3, ELEMENT TYPE CODE (ECT-ID)
C WORD 4, LENGTH OF ELEMENT CARD (ECTWDS), PLUS POINTER TO GPTA1
C
II = 0
DO 100 I = 1,LAST,INCR
IF (NE(I+6) .EQ. 0) GO TO 100
Z(II+1) = NE(I+6)
Z(II+2) =-NE(I+8)
Z(II+3) = NE(I+3)
Z(II+4) = NE(I+5)*10000 + I
II = II + 4
100 CONTINUE
C
C ADD 3 MORE PROPERTY CARDS (PCOMP, PCOMP1, PCOMP2) FOR CQUAD4 (64)
C AND CTRIA3
C NOTE - THESE THREE ARE OPEN-ENDED, AND WE SET WORD 2 TO -8888
C - WE GIVE THEM LOCALLY NEW QUAD4 IDS IN THE 3RD WORD, SO THAT
C ELEMENT CQUAD4 AND ELEMENT CTRIA3 WILL PICK THEM UP VIA
C THE PSEHLL DATA LATER.
C
I = (64-1)*INCR + 1
IF (NE(I+3) .NE. QUAD4) CALL MESAGE (-37,0,NAME)
DO 105 J = 1,3
Z(II+1) = PCOMP(J)
Z(II+2) = -8888
Z(II+3) = QUAD4 - J
Z(II+4) = NE(I+5)*10000 + I
II = II + 4
105 CONTINUE
C
C SORT THIS 4-ENTRY Z-TABLE BY THE FIRST WORD.
C SET WORD 2 TO -9999 IF ELEMENT USES THE SAME PROPERTY CARD AS THE
C PREVIOUS ELEMENT.
C
I4 = II/4
CALL SORT (0,0,4,1,Z,II)
DO 110 I = 5,II,4
IF (Z(I) .EQ. Z(I-4)) Z(I+1) = -9999
110 CONTINUE
C
C READ FROM PFILE ALL PID INTO REMAINING CORE. REPLACE WORD 2 IN THE
C Z-TABLE BY PID BEGIN-ENDING POINTERS
C
JJ = II + 1
IF (NOPID .EQ. 1) GO TO 210
CALL REWIND (PFILE)
120 CALL FWDREC (*360,PFILE)
130 CALL READ (*190,*190,PFILE,X,3,0,FLAG)
C 2147483647 = 2**31-1
IF (X(1) .EQ. 2147483647) GO TO 190
CALL BISLOC (*120,X(1),Z,4,I4,K)
140 KP1 = K + 1
IF (Z(KP1) .NE. -9999) GO TO 150
K = K - 4
GO TO 140
150 NWDS = -Z(KP1)
IF (NWDS .LE. 0) GO TO 120
KOMP = 0
IF (NWDS .NE. 8888) GO TO 155
KOMP = 1
NWDS = 8
155 Z(KP1) = (JJ*10000) + (JJ-1)
JB = JJ
160 CALL READ (*360,*130,PFILE,Z(JJ),NWDS,0,FLAG)
IF (KOMP .EQ. 0) GO TO 167
165 CALL READ (*360,*130,PFILE,J,1,0,FLAG)
IF (J .NE. -1) GO TO 165
167 JE = MOD(Z(KP1),10000)
IF (JE .LT. JB) GO TO 180
DO 170 J = JB,JE
IF (Z(JJ) .EQ. Z(J)) GO TO 160
170 CONTINUE
180 Z(KP1) = Z(KP1) + 1
JJ = JJ + 1
GO TO 160
190 CALL REWIND (PFILE)
JJ = JJ - 1
IF (JJ .LE. II) NOPID = -1
C
C RESET THE PSHELL POINTERS TO INCLUDE THE PCOMP GROUP IDS.
C MAKE SURE THIS GROUP ARE ALL TOGETHER, NOT SEPERATED BY OTHER
C PROPERTY CARD
C THERE ARE 2 PSHELL CARDS, ONE FROM CQUAD4 AND ONE FROM CTRIA3,
C MAKE SURE THE FIRST PSHELL POINTER IS USED
C
CALL BISLOC (*210,PSHELL,Z,4,I4,KP1)
IF (Z(KP1+1) .EQ. -9999) KP1 = KP1 - 4
IF (Z(KP1- 4).NE.PCOMP(3) .OR. Z(KP1-8).NE.PCOMP(2) .OR.
1 Z(KP1-12).NE.PCOMP(1)) GO TO 380
J = Z(KP1+1)
IF (J .LE. 0) J = 0
JB = J/10000
JE = MOD(J,10000)
IF (JB .EQ. 0) JB = 9999999
DO 200 I = 1,3
CALL BISLOC (*370,PCOMP(I),Z,4,I4,K)
IF (Z(K+1) .LE. 0) GO TO 200
J = Z(K+1)/10000
K = MOD(Z(K+1),10000)
IF (J .LT. JB) JB = J
IF (K .GT. JE) JE = K
200 CONTINUE
IF (JB .NE. 9999999) Z(KP1+1) = (JB*10000) + JE
C
C RESET POINTERS FOR THOSE PROPERTY ID COMMON TO MORE THAN ONE TYPE
C OF ELEMENTS, AND
C MOVE THE THIRD ENTRY IN THE Z-TABLE TO FIRST, FOR ELEMENT SORT
C
210 DO 220 I = 1,II,4
Z(I) = Z(I+2)
J = I + 1
IF (Z(J) .GT. 0) GO TO 220
IF (Z(J) .EQ. -9999) Z(J) = Z(J-4)
220 CONTINUE
CALL SORT (0,0,4,1,Z,II)
C
C READ IN CONNECTING ELEMENTS, ONE BY ONE, FROM GEOM2 FILE, AND
C CHECK THE EXISTENCE OF THE PROPERTY ID IF IT IS SPECIFIED.
C
KK = JJ + 1
CALL REWIND (GEOM2)
230 CALL FWDREC (*360,GEOM2)
240 CALL READ (*300,*300,GEOM2,X,3,0,FLAG)
CALL BISLOC (*230,X(1),Z,4,I4,K)
NWDS = Z(K+3)/10000
IF (NWDS .LE. 0) GO TO 230
J = Z(K+1)
IF (J .LE. 0) GO TO 270
JB = J/10000
JE = MOD(J,10000)
250 CALL READ (*360,*240,GEOM2,Z(KK),NWDS,0,FLAG)
JJ1 = Z(KK+1)
DO 260 J = JB,JE
IZ = IABS(Z(J))
IF (JJ1 .NE. IZ) GO TO 260
Z(J) = -IZ
GO TO 250
260 CONTINUE
CALL MESAGE (30,10,Z(KK))
ABORT = .TRUE.
GO TO 250
270 J = MOD(Z(K+3),10000)
CALL MESAGE (30,11,NE(J))
ABORT = .TRUE.
GO TO 230
300 CALL REWIND (GEOM2)
IF (ABORT .OR. NOPID.NE.0) GO TO 350
C
C PREPARE AN ACTIVE PROPERTY ID LIST FOR SUBROUTINE MATCK
C
J = II + 1
II = 1
DO 320 I = J,JJ
IF (Z(I) .GE. 0) GO TO 310
II = II + 1
Z(II) = -Z(I)
GO TO 320
310 Z(KK) = Z(I)
KK = KK + 1
320 CONTINUE
Z(1) = II
C
C Z(2,...II) CONTAINS A LIST OF ACTIVE PROPERTY IDS, UN-SORTED,
C REFERENCED BY ELEMENTS IN GEOM2 FILE. Z(1) = LENGTH OF THIS LIST
C
JJ1 = JJ + 1
KK = KK - 1
IF (KK .LT. JJ1) RETURN
WRITE (NOUT,330) UIM
330 FORMAT (A29,', THE FOLLOWING PROPERTY IDS ARE PRESENT BUT NOT ',
1 'USED -')
WRITE (NOUT,340) (Z(J),J=JJ1,KK)
340 FORMAT (/5X,12I9)
RETURN
C
C SET Z(1) TO ZERO IF NO ACTIVE PROPERTY LIST EXISTS.
C
350 Z(1) = 0
RETURN
C
360 J = -2
GO TO 400
370 WRITE (NOUT,375)
375 FORMAT ('0*** CAN NOT LOCATE PSHELL OR PCOMP DATA IN /GPTA1/')
GO TO 390
380 WRITE (NOUT,385) Z(KP1),PSHELL,Z(KP1-4),PCOMP(3),
1 Z(KP1-8),PCOMP(2),Z(KP1-12),PCOMP(1)
385 FORMAT ('0*** ERROR IN /GPTA1/ PCOMP ARRANGEMENT',(/3X,2I7))
390 J = -37
400 CALL MESAGE (J,0,NAME)
RETURN
END
|
