39
40
41
42 USE elbufdef_mod
44 use element_mod , only : nixc,nixtg
45
46
47
48#include "implicit_f.inc"
49
50
51
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "param_c.inc"
55#include "scr16_c.inc"
56#include "scr17_c.inc"
57#include "units_c.inc"
58
59
60
61 INTEGER ITAB(*), ITABG(*), LENG, IGEO(NPROPGI,*),
62 . IXC(NIXC,*), IXTG(NIXTG,*),IPARTC(*), IPARTTG(*),
63 . NODTAG(*) , DYNAIN_INDXC(*) ,DYNAIN_INDXTG(*),
64 . IPARG(NPARG,*),IPART(LIPART1,*)
65
66 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
68 . thke(*)
69 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
70
71
72
73 INTEGER I, N, JJ, IPRT, K, II
74 INTEGER NG, NEL, NFT, LFT, LLT, ITY, MLW, ITHK,IOFF,
75 . IPROP,ID_PROP,IERR , N4SHELL, N3SHELL, IGTYP, IGTYP0
76 INTEGER WORK(70000)
77 INTEGER , DIMENSION(:),ALLOCATABLE :: NPC , NPTG
78 INTEGER , DIMENSION(:,:),ALLOCATABLE :: CLEF
79 double precision THKN ,BETA
80 double precision , DIMENSION(:),ALLOCATABLE :: THKC , ,BETAC , BETATG
81 TYPE(G_BUFEL_) ,POINTER :: GBUF
82 CHARACTER*100 LINE
83
84
85
86
87
88 ALLOCATE(npc(8*numelc),stat=ierr)
89 ALLOCATE(nptg(7*numeltg),stat=ierr)
90 ALLOCATE(clef(2,
max(numelc,numeltg)),stat=ierr)
91 ALLOCATE(thkc(numelc),stat=ierr)
92 ALLOCATE(thktg(numeltg),stat=ierr)
93 ALLOCATE(betac(numelc),stat=ierr)
94 ALLOCATE(betatg(numeltg),stat=ierr)
95
96
97
98 jj = 0
99 ii = 0
100
101 IF(numelc/=0)THEN
102
103 DO ng=1,ngroup
104 ity =iparg(5,ng)
105 IF(ity==3) THEN
106 nel =iparg(2,ng)
107 nft =iparg(3,ng)
108 gbuf => elbuf_tab(ng)%GBUF
109 mlw =iparg(1,ng)
110 iprop =iparg(62,ng)
111 ithk =iparg(28,ng)
112 id_prop=igeo(1,iprop)
113 igtyp= iparg(38,ng)
114 IF(igtyp/= 1) igtyp = 2
115 lft=1
116 llt=nel
117
118 DO i=lft,llt
119 n = i + nft
120
121 iprt=ipartc(n)
122 IF(dynain_data%IPART_DYNAIN(iprt)==0)cycle
123
124 npc(jj+1) = ixc(nixc,n)
125 npc(jj+2) = itab(ixc(2,n))
126 npc(jj+3) = itab(ixc(3,n))
127 npc(jj+4) = itab(ixc(4,n))
128 npc(jj+5) = itab(ixc(5,n))
129 npc(jj+6) = ipart(4,iprt)
130 npc(jj+7) = nint(gbuf%OFF(i))
131 npc(jj+8) = igtyp
132 ii = ii + 1
133 IF (mlw /= 0 .AND. mlw /= 13) THEN
134 IF (ithk >0 ) THEN
135 thkc(ii) = gbuf%THK(i)
136 ELSE
137 thkc(ii) = thke(n)
138 END IF
139 ELSE
140 thkc(ii) = zero
141 ENDIF
142 jj = jj + 8
143
144 dynain_data%DYNAIN_NUMELC = dynain_data%DYNAIN_NUMELC+1
145
146 clef(1,dynain_data%DYNAIN_NUMELC)=igtyp
147 clef(2,dynain_data%DYNAIN_NUMELC)=ixc(nixc,n)
148
149 nodtag(ixc(2,n))=1
150 nodtag(ixc(3,n))=1
151 nodtag(ixc(4,n))=1
152 nodtag(ixc(5,n))=1
153
154 IF(igtyp /= 1) THEN
155 betac(ii) = (hundred80*acos(gbuf%BETAORTH(i)))/pi
156 ENDIF
157
158
159 END DO
160 END IF
161 END DO
162 END IF
163
164 DO n=1,dynain_data%DYNAIN_NUMELC
165 dynain_indxc(n)=n
166 END DO
167 CALL my_orders(0,work,clef,dynain_indxc,dynain_data%DYNAIN_NUMELC,2)
168
169
170
171
172
173 jj = 0
174 ii = 0
175 IF(numeltg/=0)THEN
176 DO ng=1,ngroup
177 ity =iparg(5,ng)
178 IF(ity==7) THEN
179 nel =iparg(2,ng)
180 nft =iparg(3,ng)
181 gbuf => elbuf_tab(ng)%GBUF
182 mlw =iparg(1,ng)
183 ithk =iparg(28,ng)
184 iprop =iparg(62,ng)
185 id_prop=igeo(1,iprop)
186 igtyp= iparg(38,ng)
187 IF(igtyp/= 1) igtyp = 2
188 lft=1
189 llt=nel
190
191 DO i=lft,llt
192 n = i + nft
193
194 iprt=iparttg(n)
195 IF(dynain_data%IPART_DYNAIN(iprt)==0)cycle
196
197 nptg(jj+1) = ixtg(nixtg,n)
198 nptg(jj+2) = itab(ixtg(2,n))
199 nptg(jj+3) = itab(ixtg(3,n))
200 nptg(jj+4) = itab(ixtg(4,n))
201 nptg(jj+5) = ipart(4,iprt)
202 nptg(jj+6) = nint(gbuf%OFF(i))
203 nptg(jj+7) = igtyp
204 ii = ii + 1
205 IF (mlw /= 0 .AND. mlw /= 13) THEN
206 IF (ithk >0 ) THEN
207 thktg(ii) = gbuf%THK(i)
208 ELSE
209 thktg(ii) = thke(n)
210 END IF
211 ELSE
212 thktg(ii) = zero
213 ENDIF
214 jj = jj + 7
215
216 dynain_data%DYNAIN_NUMELTG =dynain_data%DYNAIN_NUMELTG+1
217
218 clef(1,dynain_data%DYNAIN_NUMELTG)=igtyp
219 clef(2,dynain_data%DYNAIN_NUMELTG)=ixtg(nixtg,n)
220
221 nodtag(ixtg(2,n))=1
222 nodtag(ixtg(3,n))=1
223 nodtag(ixtg(4,n))=1
224
225 IF(igtyp /= 1) THEN
226 betatg(ii) = (hundred80*acos(gbuf%BETAORTH(i)))/pi
227 ENDIF
228
229 END DO
230 END IF
231 END DO
232 END IF
233
234
235 DO n=1,dynain_data%DYNAIN_NUMELTG
236 dynain_indxtg(n)=n
237 END DO
238 CALL my_orders(0,work,clef,dynain_indxtg,dynain_data%DYNAIN_NUMELTG,2)
239
240
241
242
243
244
245 igtyp0 = 0
246 DO n=1,dynain_data%DYNAIN_NUMELC
247 k=dynain_indxc(n)
248 jj=8*(k-1)
249 ioff=npc(jj+7)
250 igtyp = npc(jj+8)
251 thkn = thkc(k)
252 IF(ioff >= 1) THEN
253 IF(igtyp==1) THEN
254 IF(igtyp/=igtyp0) THEN
255 IF(dynain_data%ZIPDYNAIN==0) THEN
256 WRITE(iudynain,'(A)')'*ELEMENT_SHELL_THICKNESS'
257 WRITE(iudynain,'(A)')
258 . '$SHELLID PART_ID NOD1 NOD2 NOD3 NOD4'
259 WRITE(iudynain,'(A)')
260 . '$ THIC1 THIC2 THIC3 THIC4'
261 ELSE
262 WRITE(line,'(A)') '*ELEMENT_SHELL_THICKNESS'
264 WRITE(line,'(A)')
265 . '$SHELLID PART_ID NOD1 NOD2 NOD3 NOD4'
267 WRITE(line,'(A)')
268 . '$ THIC1 THIC2 THIC3 THIC4'
270 ENDIF
271 igtyp0 = igtyp
272 ENDIF
273
274 IF(dynain_data%ZIPDYNAIN==0) THEN
275 WRITE(iudynain,'(6I8)')
276 . npc(jj+1),npc(jj+6),npc(jj+2),npc(jj+3),npc(jj+4),npc(jj+5)
277 WRITE(iudynain,'(1p4g16.9)')
278 . THKN,THKN,THKN,THKN
279 ELSE
280 WRITE(LINE,'(6i8)')
281 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4),NPC(JJ+5)
282 CALL STRS_TXT50(LINE,100)
283 WRITE(LINE,'(1p4g16.9)')
284 . THKN,THKN,THKN,THKN
285 CALL STRS_TXT50(LINE,100)
286 ENDIF
287
288 ELSE
289 EXIT
290 ENDIF
291 ENDIF
292
293 END DO
294
295 N4SHELL = N
296
297 DO N=1,DYNAIN_DATA%DYNAIN_NUMELTG
298 K=DYNAIN_INDXTG(N)
299 JJ=7*(K-1)
300 IOFF=NPTG(JJ+6)
301 IGTYP = NPTG(JJ+7)
302 THKN = THKTG(K)
303 IF(IOFF >= 1) THEN
304 IF(IGTYP==1) THEN
305 IF(DYNAIN_DATA%ZIPDYNAIN==0) THEN
306 WRITE(IUDYNAIN,'(5i8)')
307 . NPTG(JJ+1),NPTG(JJ+5),NPTG(JJ+2),NPTG(JJ+3),NPTG(JJ+4)
308 WRITE(IUDYNAIN,'(1p3g16.9)')
309 . THKN,THKN,THKN
310 ELSE
311 WRITE(LINE,'(5i8)')
312 . NPTG(JJ+1),NPTG(JJ+5),NPTG(JJ+2),NPTG(JJ+3),NPTG(JJ+4)
313 CALL STRS_TXT50(LINE,100)
314 WRITE(LINE,'(1p3g16.9)')
315 . THKN,THKN,THKN
316 CALL STRS_TXT50(LINE,100)
317 ENDIF
318 ELSE
319 EXIT
320 ENDIF
321 ENDIF
322 END DO
323 N3SHELL = N
324
325
326
327 IGTYP0 = 1
328 DO N=N4SHELL,DYNAIN_DATA%DYNAIN_NUMELC
329 K=DYNAIN_INDXC(N)
330 JJ=8*(K-1)
331 IOFF=NPC(JJ+7)
332 IGTYP = NPC(JJ+8)
333 THKN = THKC(K)
334 BETA = BETAC(K)
335 IF(IOFF >= 1) THEN
336 IF(IGTYP/=IGTYP0) THEN
337 IGTYP0 = IGTYP
338 IF(DYNAIN_DATA%ZIPDYNAIN==0) THEN
339 WRITE(IUDYNAIN,'(a)')'*element_shell_thickness_beta'
340 WRITE(IUDYNAIN,'(a)')
341 . '$shellid part_id nod1 nod2 nod3 nod4'
342 WRITE(IUDYNAIN,'(a)')
343 . '$ thic1 thic2 thic3 thic4 beta'
344 ELSE
345 WRITE(LINE,'(a)') '*element_shell_thickness_beta'
346 CALL STRS_TXT50(LINE,100)
347 WRITE(LINE,'(a)')
348 . '$shellid part_id nod1 nod2 nod3 nod4'
349 CALL STRS_TXT50(LINE,100)
350 WRITE(LINE,'(a)')
351 . '$ thic1 thic2 thic3 thic4 '
352 CALL STRS_TXT50(LINE,100)
353 ENDIF
354 ENDIF
355 IF(DYNAIN_DATA%ZIPDYNAIN==0) THEN
356 WRITE(IUDYNAIN,'(6i8)')
357 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4),NPC(JJ+5)
358 WRITE(IUDYNAIN,'(1p5g16.9)')
359 . THKN,THKN,THKN,THKN,BETA
360 ELSE
361 WRITE(LINE,'(6i8)')
362 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4),NPC(JJ+5)
363 CALL STRS_TXT50(LINE,100)
364 WRITE(LINE,'(1p5g16.9)')
365 . THKN,THKN,THKN,THKN,BETA
366 CALL STRS_TXT50(LINE,100)
367 ENDIF
368 ENDIF
369
370 END DO
371
372
373 DO N=N3SHELL,DYNAIN_DATA%DYNAIN_NUMELTG
374 K=DYNAIN_INDXTG(N)
375 JJ=7*(K-1)
376 IOFF=NPTG(JJ+6)
377 THKN = THKTG(K)
378 BETA = BETATG(K)
379 IF(IOFF >= 1) THEN
380 IF(DYNAIN_DATA%ZIPDYNAIN==0) THEN
381 WRITE(IUDYNAIN,'(5i8)')
382 . NPTG(JJ+1),NPTG(JJ+5),NPTG(JJ+2),NPTG(JJ+3),NPTG(JJ+4)
383 WRITE(IUDYNAIN,'(1p3g16.9,16x,1pg16.9)')
384 . THKN,THKN,THKN,BETA
385 ELSE
386 WRITE(LINE,'(5i8)')
387 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4)
388 CALL STRS_TXT50(LINE,100)
389 WRITE(LINE,'(1p3g16.9,16x,1pg16.9)')
390 . THKN,THKN,THKN,BETA
391 CALL STRS_TXT50(LINE,100)
392 ENDIF
393 ENDIF
394 END DO
395
396
397
398
399
400 DEALLOCATE(NPC,NPTG,CLEF,THKC,THKTG,BETAC,BETATG)
401
402
403 RETURN
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
subroutine strs_txt50(text, length)
1.15.0