OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_c_strafg.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.f
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| get_q4l ../engine/source/output/sta/stat_c_strafg.F
29!|| get_t3l ../engine/source/output/sta/stat_c_strafg.F
30!|| layini ../engine/source/elements/shell/coque/layini.F
31!|| shell2g ../engine/source/output/sta/stat_c_strafg.F
32!|| spmd_rgather9_dp ../engine/source/mpi/interfaces/spmd_outp.F
33!|| spmd_stat_pgather ../engine/source/mpi/output/spmd_stat.F
34!|| strs_txt50 ../engine/source/output/sta/sta_txt.F
35!|| tab_strs_txt50 ../engine/source/output/sta/sta_txt.F
36!||--- uses -----------------------------------------------------
37!|| drape_mod ../engine/share/modules/drape_mod.F
38!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
39!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
40!|| stack_mod ../engine/share/modules/stack_mod.F
41!||====================================================================
42 SUBROUTINE stat_c_strafg(ELBUF_TAB,
43 1 X ,IPARG ,IPM ,IGEO ,IXC ,
44 2 IXTG ,WA,WAP0 ,IPARTC, IPARTTG,
45 3 IPART_STATE,STAT_INDXC,STAT_INDXTG,THKE,SIZP0,
46 4 GEO ,STACK,DRAPE_SH4N,DRAPE_SH3N,DRAPEG)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE elbufdef_mod
51 USE stack_mod
52 USE drape_mod
53 USE my_alloc_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "param_c.inc"
65#include "units_c.inc"
66#include "scr14_c.inc"
67#include "scr16_c.inc"
68#include "task_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER SIZLOC,SIZP0
73 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
74 . IPARG(NPARG,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
75 . IPARTC(*), IPARTTG(*), IPART_STATE(*),
76 . stat_indxc(*), stat_indxtg(*)
77 my_real
78 . thke(*),x(3,*),geo(*)
79 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
80 TYPE (STACK_PLY) :: STACK
81 TYPE (drape_) :: drape_sh4n(numelc_drape), drape_sh3n(numeltg_drape)
82 TYPE (DRAPEG_) :: DRAPEG
83 double precision WA(*),WAP0(*)
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I,J,K,N,II,JJ,LEN, IOFF, NG, NEL, NFT, ITY, LFT, NPT,
88 . LLT, MLW, ISTRAIN,ID, IPRT0, IPRT,NPG,IPG,IE,NPTR,NPTS,G_STRA,
89 . ITHK,KK(8),NF1,IGTYP,IREL,IHBE,NLAY,IBID0,MAT_1,PID_1,ILAY,NF3,
90 . SEDRAPE,NUMEL_DRAPE
91 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA
92 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA_P0
93 double precision
94 . THK, EM, EB, H1, H2, H3
95 CHARACTER*100 DELIMIT,LINE
96 TYPE(g_bufel_) ,POINTER :: GBUF
97 TYPE(l_bufel_) ,POINTER :: LBUF
98 TYPE(BUF_LAY_) ,POINTER :: BUFLY
99 INTEGER LAYNPT_MAX,NLAY_MAX,ISUBSTACK,IPT_ALL,NPTT,IT,IPT,NPT_ALL,MPT
100 my_real,
101 . DIMENSION(:),POINTER :: strain
102 my_real
103 . qt(9,mvsiz),straing(6),zh,thkp ,thk0(mvsiz)
104 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY
105 my_real, DIMENSION(:) , ALLOCATABLE :: THKLY
106 my_real, DIMENSION(:,:) , ALLOCATABLE :: posly,thk_ly
107
108C-----------------------------------------------
109 DATA delimit(1:60)
110 ./'#---1----|----2----|----3----|----4----|----5----|----6----|'/
111 DATA delimit(61:100)
112 ./'----7----|----8----|----9----|----10---|'/
113C-----------------------------------------------
114C 4-NODE SHELLS
115C-----------------------------------------------
116 CALL my_alloc(ptwa,max(stat_numelc ,stat_numeltg))
117 ALLOCATE(ptwa_p0(0:max(1,stat_numelc_g,stat_numeltg_g)))
118C-----------------------------------------------
119 jj = 0
120 IF(stat_numelc==0) GOTO 200
121
122 ie=0
123 DO ng=1,ngroup
124 ity =iparg(5,ng)
125 IF (ity == 3) THEN
126 gbuf => elbuf_tab(ng)%GBUF
127 mlw =iparg(1,ng)
128 nel =iparg(2,ng)
129 nft =iparg(3,ng)
130 npt = iparg(6,ng)
131 ithk =iparg(28,ng)
132 nptr = elbuf_tab(ng)%NPTR
133 npts = elbuf_tab(ng)%NPTS
134 nlay = elbuf_tab(ng)%NLAY
135 ihbe =iparg(23,ng)
136 igtyp= iparg(38,ng)
137 isubstack=iparg(71,ng)
138 npg = nptr*npts
139 IF (ihbe == 23 .AND. gbuf%G_STRPG>gbuf%G_STRA) npg=4
140 IF (ihbe == 23 .AND. npg/=4) cycle
141 lft=1
142 llt=nel
143 g_stra = gbuf%G_STRA
144 nf1 = nft+1
145 IF (ihbe>10.OR.igtyp==16.OR.ishfram ==0) THEN
146 irel=0
147 ELSEIF (ishfram ==1) THEN
148 irel=2
149 ELSE
150 irel=1
151 END IF
152!
153 DO j=1,8 ! length max of GBUF%G_STRA = 8
154 kk(j) = nel*(j-1)
155 ENDDO
156!
157 ibid0 = 0
158 mat_1 = ixc(1,nf1)
159 pid_1 = ixc(6,nf1)
160 IF (ithk >0 ) THEN
161 thk0(lft:llt) = gbuf%THK(lft:llt)
162 ELSE
163 thk0(lft:llt) = thke(lft+nft:llt+nft)
164 END IF
165 ! Npt_max
166 laynpt_max = 1
167 IF(igtyp == 51 .OR. igtyp == 52) THEN
168 DO ilay=1, nlay
169 laynpt_max = max(laynpt_max , elbuf_tab(ng)%BUFLY(ilay)%NPTT)
170 ENDDO
171 ENDIF
172 nlay_max = max(nlay,npt, elbuf_tab(ng)%NLAY)
173 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
174 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
175 matly = 0
176 thkly = zero
177 posly = zero
178 thk_ly = zero
179 numel_drape = numelc_drape
180 sedrape = scdrape
181 CALL layini(elbuf_tab(ng),lft ,llt ,geo ,igeo ,
182 . mat_1 ,pid_1 ,thkly ,matly ,posly ,
183 . igtyp ,ibid0 ,ibid0 ,nlay ,npt ,
184 . isubstack,stack ,drape_sh4n ,nft ,thke ,
185 . nel ,thk_ly ,drapeg%INDX_SH4N ,sedrape,numel_drape)
186 CALL get_q4l(lft ,llt ,ixc(1,nf1),x ,gbuf%OFF,irel ,qt )
187 npt_all = 0
188 DO ilay=1,nlay
189 npt_all = npt_all + elbuf_tab(ng)%BUFLY(ilay)%NPTT
190 ENDDO
191 mpt = max(1,npt_all)
192 IF (npt==0) mpt=0
193c--------------------
194 DO i=lft,llt
195 n = i + nft
196
197 iprt=ipartc(n)
198 IF(ipart_state(iprt)==0)cycle
199
200 jj = jj + 1
201 IF (mlw /= 0 .AND. mlw /= 13) THEN
202 wa(jj) = gbuf%OFF(i)
203 ELSE
204 wa(jj) = zero
205 ENDIF
206 jj = jj + 1
207 wa(jj) = iprt
208 jj = jj + 1
209 wa(jj) = ixc(nixc,n)
210 jj = jj + 1
211C----
212 wa(jj) = mpt
213 jj = jj + 1
214 wa(jj) = npg
215 jj = jj + 1
216 IF (mlw /= 0 .AND. mlw /= 13) THEN
217 wa(jj) = thk0(i)
218 ELSE
219 wa(jj) = zero
220 ENDIF
221 thkp = wa(jj)
222c Strain in Gauss points
223 IF (mlw == 0 .or. mlw == 13) THEN
224 DO ipg=1,npg
225 DO j=1,14
226 jj = jj + 1
227 wa(jj)=zero
228 END DO
229 END DO
230 ELSEIF (npt==0 .AND. g_stra /= 0) THEN
231 IF (npg > 1) THEN
232 strain => gbuf%STRPG
233 ELSE
234 strain => gbuf%STRA
235 ENDIF
236C------first point Z=0 7 real to print npg w/ QEPH
237 DO ipg=1,npg
238 k = (ipg-1)*nel*g_stra
239 straing(1:2)=strain(kk(1:2)+i+k)
240 straing(3:5)=half*strain(kk(3:5)+i+k)
241 CALL shell2g(straing,qt(1,i))
242C
243 DO j=1,6
244 jj = jj + 1
245 wa(jj) = straing(j)
246 END DO
247 jj = jj + 1
248 wa(jj) = zero
249 END DO
250C------2nd point Z=0.5-> 1.0(LSD) 7 real
251 DO ipg=1,npg
252 k = (ipg-1)*nel*g_stra
253 zh = half*thkp
254 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
255 straing(3)=half*straing(3)
256 straing(4:5)=half*strain(kk(4:5)+i+k)
257 CALL shell2g(straing,qt(1,i))
258C
259 DO j=1,6
260 jj = jj + 1
261 wa(jj) = straing(j)
262 END DO
263 jj = jj + 1
264 wa(jj) = one
265 END DO
266 ELSEIF (g_stra /= 0) THEN
267 IF (npg > 1) THEN
268 strain => gbuf%STRPG
269 ELSE
270 strain => gbuf%STRA
271 ENDIF
272 ipt_all = 0
273 DO ilay =1,nlay
274 bufly => elbuf_tab(ng)%BUFLY(ilay)
275 nptt = bufly%NPTT
276 DO it=1,nptt
277 ipt = ipt_all + it
278C--
279 DO ipg=1,npg
280 k = (ipg-1)*nel*g_stra
281 zh = posly(i,ipt)*thkp
282 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
283 straing(3)=half*straing(3)
284 straing(4:5)=half*strain(kk(4:5)+i+k)
285 CALL shell2g(straing,qt(1,i))
286C
287 DO j=1,6
288 jj = jj + 1
289 wa(jj) = straing(j)
290 END DO
291 jj = jj + 1
292 wa(jj) = posly(i,ipt)*two
293 END DO
294 END DO !IT=1,NPTT
295 ipt_all = ipt_all + nptt
296 END DO !ILAY =1,NLAY
297 END IF
298
299 ie=ie+1
300C pointeur de fin de zone dans WA
301 ptwa(ie)=jj
302c
303 ENDDO ! I=LFT,LLT
304 DEALLOCATE(matly, thkly, posly, thk_ly)
305 END IF ! ITY==3
306 ENDDO ! NG=1,NGROUP
307
308 200 CONTINUE
309
310 IF(nspmd == 1)THEN
311 ptwa_p0(0)=0
312 DO n=1,stat_numelc
313 ptwa_p0(n)=ptwa(n)
314 END DO
315 len=jj
316 DO j=1,len
317 wap0(j)=wa(j)
318 END DO
319 ELSE
320C construit les pointeurs dans le tableau global WAP0
321 CALL spmd_stat_pgather(ptwa,stat_numelc,ptwa_p0,stat_numelc_g)
322 len = 0
323 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
324 END IF
325
326 IF(ispmd==0.AND.len>0) THEN
327
328 iprt0=0
329 DO n=1,stat_numelc_g
330
331C retrouve le nieme elt dans l'ordre d'id croissant
332 k=stat_indxc(n)
333C retrouve l'adresse dans WAP0
334 j=ptwa_p0(k-1)
335
336 ioff = nint(wap0(j + 1))
337 IF(ioff >= 1)THEN
338 iprt = nint(wap0(j + 2))
339 IF(iprt /= iprt0)THEN
340 IF (izipstrs == 0) THEN
341 WRITE(iugeo,'(A)') delimit
342 WRITE(iugeo,'(A)')'/INISHE/STRA_F/GLOB'
343 WRITE(iugeo,'(A)')
344 .'#------------------------ REPEAT --------------------------'
345 WRITE(iugeo,'(A)')
346 . '# SHELLID NPT NPG THK'
347 WRITE(iugeo,'(A/A/A)')
348 .'# REPEAT I=1,NPG :',
349 .'# E11, E22, E33,',
350 .'# E12, E23, E31, T,'
351 WRITE(iugeo,'(A)')
352 .'#---------------------- END REPEAT ------------------------'
353 WRITE(iugeo,'(A)') delimit
354 ELSE
355 WRITE(line,'(A)') delimit
356 CALL strs_txt50(line,100)
357 WRITE(line,'(A)')'/INISHE/STRA_F/GLOB'
358 CALL strs_txt50(line,100)
359 WRITE(line,'(A)')
360 .'#------------------------ REPEAT --------------------------'
361 CALL strs_txt50(line,100)
362 WRITE(line,'(A)')
363 . '# SHELLID NPT NPG THK'
364 CALL strs_txt50(line,100)
365 WRITE(line,'(A)')'# REPEAT I=1,NPG :'
366 CALL strs_txt50(line,100)
367 WRITE(line,'(A)')'# E11, E22, E33,'
368 CALL strs_txt50(line,100)
369 WRITE(line,'(A)')'# E12, E23, E31, T '
370 CALL strs_txt50(line,100)
371 WRITE(line,'(A)')
372 .'#---------------------- END REPEAT ------------------------'
373 CALL strs_txt50(line,100)
374 WRITE(line,'(A)') delimit
375 CALL strs_txt50(line,100)
376 ENDIF
377 iprt0=iprt
378 END IF
379 id = nint(wap0(j + 3))
380 npt = nint(wap0(j + 4))
381 npg = nint(wap0(j + 5))
382 thk = wap0(j + 6)
383 j = j + 6
384 IF (izipstrs == 0) THEN
385 WRITE(iugeo,'(3I10,1PE20.13)')id,npt,npg,thk
386 ELSE
387 WRITE(line,'(3I10,1PE20.13)')id,npt,npg,thk
388 CALL strs_txt50(line,100)
389 ENDIF
390 IF (npt == 0) THEN
391 DO ipg=1,npg
392 IF (izipstrs == 0) THEN
393 WRITE(iugeo,'(1P3E20.13)')(wap0(j + k),k=1,3)
394 WRITE(iugeo,'(1P4E20.13)')(wap0(j + k),k=4,7)
395 ELSE
396 CALL tab_strs_txt50(wap0(1),3,j,sizp0,3)
397 CALL tab_strs_txt50(wap0(4),4,j,sizp0,4)
398 ENDIF
399 j = j + 7
400 END DO
401C----- 2nd point
402 DO ipg=1,npg
403 IF (izipstrs == 0) THEN
404 WRITE(iugeo,'(1p3e20.13)')(WAP0(J + K),K=1,3)
405 WRITE(IUGEO,'(1p4e20.13)')(WAP0(J + K),K=4,7)
406 ELSE
407 CALL TAB_STRS_TXT50(WAP0(1),3,J,SIZP0,3)
408 CALL TAB_STRS_TXT50(WAP0(4),4,J,SIZP0,4)
409 ENDIF
410 J = J + 7
411 END DO
412 ELSE
413 DO IT=1,NPT
414 DO IPG=1,NPG
415 IF (IZIPSTRS == 0) THEN
416 WRITE(IUGEO,'(1p3e20.13)')(WAP0(J + K),K=1,3)
417 WRITE(IUGEO,'(1p4e20.13)')(WAP0(J + K),K=4,7)
418 ELSE
419 CALL TAB_STRS_TXT50(WAP0(1),3,J,SIZP0,3)
420 CALL TAB_STRS_TXT50(WAP0(4),4,J,SIZP0,4)
421 ENDIF
422 J = J + 7
423 END DO
424 END DO
425 ENDIF
426 END IF
427C
428 ENDDO
429 ENDIF
430C-----------------------------------------------
431C 3-NODE SHELLS
432C-----------------------------------------------
433 JJ = 0
434 IF (STAT_NUMELTG==0) GOTO 300
435 IE=0
436
437 DO NG=1,NGROUP
438 ITY =IPARG(5,NG)
439 IF (ITY == 7) THEN
440 GBUF => ELBUF_TAB(NG)%GBUF
441 G_STRA = GBUF%G_STRA
442 MLW =IPARG(1,NG)
443 NEL =IPARG(2,NG)
444 NFT =IPARG(3,NG)
445 NPT = IPARG(6,NG)
446 ITHK = IPARG(28,NG)
447 IHBE =IPARG(23,NG)
448 IGTYP= IPARG(38,NG)
449 ISUBSTACK=IPARG(71,NG)
450 NPTR = ELBUF_TAB(NG)%NPTR
451 NPTS = ELBUF_TAB(NG)%NPTS
452 NLAY = ELBUF_TAB(NG)%NLAY
453 NPG = NPTR*NPTS
454 LFT=1
455 LLT=NEL
456 NF1 = NFT+1
457 IF (IHBE>=30) THEN
458 IREL=0
459 ELSE
460 IREL=2
461 END IF
462!
463 DO J=1,8 ! length max of GBUF%G_STRA = 8
464 KK(J) = NEL*(J-1)
465 ENDDO
466!
467 IBID0 = 0
468 MAT_1 = IXTG(1,NF1)
469 PID_1 = IXTG(NIXTG-1,NF1)
470 IF (ITHK >0 ) THEN
471 THK0(LFT:LLT) = GBUF%THK(LFT:LLT)
472 ELSE
473 NF3 = NFT+NUMELC
474 THK0(LFT:LLT) = THKE(LFT+NF3:LLT+NF3)
475 END IF
476 ! Npt_max
477 LAYNPT_MAX = 1
478.OR. IF(IGTYP == 51 IGTYP == 52) THEN
479 DO ILAY=1, NLAY
480 LAYNPT_MAX = MAX(LAYNPT_MAX , ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT)
481 ENDDO
482 ENDIF
483 NLAY_MAX = MAX(NLAY,NPT, ELBUF_TAB(NG)%NLAY)
484 ALLOCATE(MATLY(MVSIZ*NLAY_MAX), THKLY(MVSIZ*NLAY_MAX*LAYNPT_MAX),
485 . POSLY(MVSIZ,NLAY_MAX*LAYNPT_MAX),THK_LY(NEL,NLAY_MAX*LAYNPT_MAX))
486 MATLY = 0
487 THKLY = ZERO
488 POSLY = ZERO
489 THK_LY = ZERO
490 NUMEL_DRAPE = NUMELTG_DRAPE
491 SEDRAPE = STDRAPE
492 CALL LAYINI(ELBUF_TAB(NG),LFT ,LLT ,GEO ,IGEO ,
493 . MAT_1 ,PID_1 ,THKLY ,MATLY ,POSLY ,
494 . IGTYP ,IBID0 ,IBID0 ,NLAY ,NPT ,
495 . ISUBSTACK,STACK ,DRAPE_SH3N ,NFT ,THKE ,
496 . NEL ,THK_LY ,DRAPEG%INDX_SH3N,SEDRAPE,NUMEL_DRAPE)
497 CALL GET_T3L(LFT ,LLT ,IXTG(1,NF1),X ,GBUF%OFF,
498 . IREL ,QT )
499 NPT_ALL = 0
500 DO ILAY=1,NLAY
501 NPT_ALL = NPT_ALL + ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
502 ENDDO
503 MPT = MAX(1,NPT_ALL)
504 IF (NPT==0) MPT=0
505c--------------------
506 DO I=LFT,LLT
507 N = I + NFT
508
509 IPRT=IPARTTG(N)
510 IF(IPART_STATE(IPRT)==0)CYCLE
511
512
513 JJ = JJ + 1
514.AND. IF (MLW /= 0 MLW /= 13) THEN
515 WA(JJ) = GBUF%OFF(I)
516 ELSE
517 WA(JJ) = ZERO
518 ENDIF
519 JJ = JJ + 1
520 WA(JJ) = IPRT
521 JJ = JJ + 1
522 WA(JJ) = IXTG(NIXTG,N)
523 JJ = JJ + 1
524 WA(JJ) = MPT
525 JJ = JJ + 1
526 WA(JJ) = NPG
527 JJ = JJ + 1
528.AND. IF (MLW /= 0 MLW /= 13) THEN
529 WA(JJ) = THK0(I)
530 ELSE
531 WA(JJ) = ZERO
532 ENDIF
533 THKP = WA(JJ)
534
535c Strain in Gauss points
536.or. IF (MLW == 0 MLW == 13) THEN
537 DO IPG=1,NPG
538 DO J=1,14
539 JJ = JJ + 1
540 WA(JJ) = ZERO
541 END DO
542 END DO
543.AND. ELSEIF (NPT==0 G_STRA /= 0) THEN
544 IF (NPG > 1) THEN
545 STRAIN => GBUF%STRPG
546 ELSE
547 STRAIN => GBUF%STRA
548 ENDIF
549C------first point Z=0 7 real
550 DO IPG=1,NPG
551 K = (IPG-1)*NEL*G_STRA
552 STRAING(1:2)=STRAIN(KK(1:2)+I+K)
553 STRAING(3:5)=HALF*STRAIN(KK(3:5)+I+K)
554 CALL SHELL2G(STRAING,QT(1,I))
555C
556 DO J=1,6
557 JJ = JJ + 1
558 WA(JJ) = STRAING(J)
559 END DO
560 JJ = JJ + 1
561 WA(JJ) = ZERO
562 END DO
563C------2nd point Z=0.5-> 1.0(LSD) 7 real
564 DO IPG=1,NPG
565 K = (IPG-1)*NEL*G_STRA
566 ZH = 1.0*THKP
567 STRAING(1:3)=STRAIN(KK(1:3)+I+K)+ZH*STRAIN(KK(6:8)+I+K)
568 STRAING(3)=HALF*STRAING(3)
569 STRAING(4:5)=HALF*STRAIN(KK(4:5)+I+K)
570 CALL SHELL2G(STRAING,QT(1,I))
571C
572 DO J=1,6
573 JJ = JJ + 1
574 WA(JJ) = STRAING(J)
575 END DO
576 JJ = JJ + 1
577 WA(JJ) = ONE
578 END DO
579 ELSEIF (G_STRA > 0) THEN
580 IF (NPG > 1) THEN
581 STRAIN => GBUF%STRPG
582 ELSE
583 STRAIN => GBUF%STRA
584 ENDIF
585 IPT_ALL = 0
586 DO ILAY =1,NLAY
587 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
588 NPTT = BUFLY%NPTT
589 DO IT=1,NPTT
590 IPT = IPT_ALL + IT
591C--
592 DO IPG=1,NPG
593 K = (IPG-1)*NEL*G_STRA
594 ZH = POSLY(I,IPT)*THKP
595 STRAING(1:3)=STRAIN(KK(1:3)+I+K)+ZH*STRAIN(KK(6:8)+I+K)
596 STRAING(3)=HALF*STRAING(3)
597 STRAING(4:5)=HALF*STRAIN(KK(4:5)+I+K)
598 CALL SHELL2G(STRAING,QT(1,I))
599C
600 DO J=1,6
601 JJ = JJ + 1
602 WA(JJ) = STRAING(J)
603 END DO
604 JJ = JJ + 1
605 WA(JJ) = POSLY(I,IPT)*TWO
606 END DO
607 END DO !IT=1,NPTT
608 IPT_ALL = IPT_ALL + NPTT
609 END DO !ILAY =1,NLAY
610.or. END IF ! IF (MLW == 0 MLW == 13)
611
612 IE=IE+1
613C pointeur de fin de zone
614 PTWA(IE)=JJ
615c
616 ENDDO ! I=LFT,LLT
617 DEALLOCATE(MATLY, THKLY, POSLY, THK_LY)
618 END IF ! ITY==7
619 ENDDO ! NG=1,NGROUP
620
621 300 CONTINUE
622
623 IF(NSPMD == 1)THEN
624 LEN=JJ
625 DO J=1,LEN
626 WAP0(J)=WA(J)
627 END DO
628 PTWA_P0(0)=0
629 DO N=1,STAT_NUMELTG
630 PTWA_P0(N)=PTWA(N)
631 END DO
632 ELSE
633C construit les pointeurs dans le tableau global WAP0
634 CALL SPMD_STAT_PGATHER(PTWA,STAT_NUMELTG,PTWA_P0,STAT_NUMELTG_G)
635 LEN = 0
636 CALL SPMD_RGATHER9_DP(WA,JJ,WAP0,SIZP0,LEN)
637 END IF
638
639.AND. IF(ISPMD==0LEN>0) THEN
640
641 IPRT0=0
642 DO N=1,STAT_NUMELTG_G
643
644C retrouve le nieme elt dans l'ordre d'id croissant
645 K=STAT_INDXTG(N)
646C retrouve l'adresse dans WAP0
647 J=PTWA_P0(K-1)
648
649 IOFF = NINT(WAP0(J + 1))
650 IF(IOFF >= 1)THEN
651 IPRT = NINT(WAP0(J + 2))
652 IF(IPRT /= IPRT0)THEN
653 IF (IZIPSTRS == 0) THEN
654 WRITE(IUGEO,'(a)') DELIMIT
655 WRITE(IUGEO,'(a)')'/inish3/stra_f/glob'
656 WRITE(IUGEO,'(a)')
657 .'#------------------------ REPEAT --------------------------'
658 WRITE(iugeo,'(A)')
659 . '# SH3NID NPT NPG THK'
660 WRITE(iugeo,'(A/A/A)')
661 .'# REPEAT I=1,NPG :',
662 .'# E11, E22, E33,',
663 .'# E12, E23, E31, T '
664 WRITE(iugeo,'(A)')
665 .'#---------------------- END REPEAT ------------------------'
666 WRITE(iugeo,'(A)') delimit
667 ELSE
668 WRITE(line,'(A)') delimit
669 CALL strs_txt50(line,100)
670 WRITE(line,'(A)')'/INISH3/STRA_F/GLOB'
671 CALL strs_txt50(line,100)
672 WRITE(line,'(A)')
673 .'#------------------------ REPEAT --------------------------'
674 CALL strs_txt50(line,100)
675 WRITE(line,'(A)')
676 . '# SH3NID NPT NPG THK'
677 CALL strs_txt50(line,100)
678 WRITE(line,'(A)')'# REPEAT I=1,NPG :'
679 CALL strs_txt50(line,100)
680 WRITE(line,'(A)')'# E11, E22, E33,'
681 CALL strs_txt50(line,100)
682 WRITE(line,'(A)')'# E12, E23, E31, T '
683 CALL strs_txt50(line,100)
684 WRITE(line,'(A)')
685 .'#---------------------- END REPEAT ------------------------'
686 CALL strs_txt50(line,100)
687 WRITE(line,'(A)') delimit
688 CALL strs_txt50(line,100)
689 END IF
690 iprt0=iprt
691 END IF
692 id = nint(wap0(j + 3))
693 npt = nint(wap0(j + 4))
694 npg = nint(wap0(j + 5))
695 thk = wap0(j + 6)
696 j = j + 6
697 IF (izipstrs == 0) THEN
698 WRITE(iugeo,'(3I10,1PE20.13)')id,npt,npg,thk
699 ELSE
700 WRITE(line,'(3I10,1PE20.13)')id,npt,npg,thk
701 CALL strs_txt50(line,100)
702 ENDIF
703 IF (npt == 0) THEN
704 DO ipg=1,npg
705 IF (izipstrs == 0) THEN
706 WRITE(iugeo,'(1P3E20.13)')(wap0(j + k),k=1,3)
707 WRITE(iugeo,'(1P4E20.13)')(wap0(j + k),k=4,7)
708 ELSE
709 CALL tab_strs_txt50(wap0(1),3,j,sizp0,3)
710 CALL tab_strs_txt50(wap0(4),4,j,sizp0,4)
711 ENDIF
712 j = j + 7
713 END DO
714C----- 2nd point
715 DO ipg=1,npg
716 IF (izipstrs == 0) THEN
717 WRITE(iugeo,'(1P3E20.13)')(wap0(j + k),k=1,3)
718 WRITE(iugeo,'(1P4E20.13)')(wap0(j + k),k=4,7)
719 ELSE
720 CALL tab_strs_txt50(wap0(1),3,j,sizp0,3)
721 CALL tab_strs_txt50(wap0(4),4,j,sizp0,4)
722 ENDIF
723 j = j + 7
724 END DO
725 ELSE
726 DO it=1,npt
727 DO ipg=1,npg
728 IF (izipstrs == 0) THEN
729 WRITE(iugeo,'(1P3E20.13)')(wap0(j + k),k=1,3)
730 WRITE(iugeo,'(1P4E20.13)')(wap0(j + k),k=4,7)
731 ELSE
732 CALL tab_strs_txt50(wap0(1),3,j,sizp0,3)
733 CALL tab_strs_txt50(wap0(4),4,j,sizp0,4)
734 ENDIF
735 j = j + 7
736 END DO
737 END DO
738 ENDIF
739 END IF
740
741 ENDDO
742 ENDIF
743
744c----------
745 DEALLOCATE(ptwa)
746 DEALLOCATE(ptwa_p0)
747c-----------
748 RETURN
749 END
750!||====================================================================
751!|| get_q4l ../engine/source/output/sta/stat_c_strafg.F
752!||--- called by ------------------------------------------------------
753!|| dynain_c_strag ../engine/source/output/dynain/dynain_c_strag.F
754!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.F
755!||--- calls -----------------------------------------------------
756!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
757!||====================================================================
758 SUBROUTINE get_q4l(JFT ,JLT ,IXC ,X ,OFFG ,
759 . IREL ,VQ )
760C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
761#include "implicit_f.inc"
762c-----------------------------------------------
763c g l o b a l p a r a m e t e r s
764c-----------------------------------------------
765#include "mvsiz_p.inc"
766C-----------------------------------------------
767C D U M M Y A R G U M E N T S
768C-----------------------------------------------
769 INTEGER IXC(NIXC,*),JFT,JLT,IREL
770 my_real
771 . X(3,*), OFFG(*),VQ(3,3,MVSIZ)
772C-----------------------------------------------
773C L O C A L V A R I A B L E S
774C-----------------------------------------------
775 INTEGER I,J,K,L
776 INTEGER IXCTMP2,IXCTMP3,IXCTMP4,IXCTMP5
777 my_real
778 . RX(MVSIZ),RY(MVSIZ),RZ(MVSIZ),SX(MVSIZ),SY(MVSIZ),
779 . R11(MVSIZ),R12(MVSIZ),R13(MVSIZ),R21(MVSIZ),R22(MVSIZ),
780 . r23(mvsiz),r31(mvsiz),r32(mvsiz),r33(mvsiz),
781 . sz(mvsiz),deta1(mvsiz)
782C----------------------------------------------
783 DO i=jft,jlt
784 ixctmp2=ixc(2,i)
785 ixctmp3=ixc(3,i)
786 ixctmp4=ixc(4,i)
787 ixctmp5=ixc(5,i)
788
789 rx(i)=x(1,ixctmp3)+x(1,ixctmp4)-x(1,ixctmp2)-x(1,ixctmp5)
790 sx(i)=x(1,ixctmp4)+x(1,ixctmp5)-x(1,ixctmp2)-x(1,ixctmp3)
791 ry(i)=x(2,ixctmp3)+x(2,ixctmp4)-x(2,ixctmp2)-x(2,ixctmp5)
792 sy(i)=x(2,ixctmp4)+x(2,ixctmp5)-x(2,ixctmp2)-x(2,ixctmp3)
793 rz(i)=x(3,ixctmp3)+x(3,ixctmp4)-x(3,ixctmp2)-x(3,ixctmp5)
794 sz(i)=x(3,ixctmp4)+x(3,ixctmp5)-x(3,ixctmp2)-x(3,ixctmp3)
795 ENDDO
796C----------------------------
797C LOCAL SYSTEM
798C----------------------------
799 CALL clskew3(jft,jlt,irel,
800 . rx, ry, rz,
801 . sx, sy, sz,
802 . r11,r12,r13,r21,r22,r23,r31,r32,r33,deta1,offg )
803 DO i=jft,jlt
804 vq(1,1,i)=r11(i)
805 vq(2,1,i)=r21(i)
806 vq(3,1,i)=r31(i)
807 vq(1,2,i)=r12(i)
808 vq(2,2,i)=r22(i)
809 vq(3,2,i)=r32(i)
810 vq(1,3,i)=r13(i)
811 vq(2,3,i)=r23(i)
812 vq(3,3,i)=r33(i)
813 ENDDO
814C
815 RETURN
816 END
817!||====================================================================
818!|| get_t3l ../engine/source/output/sta/stat_c_strafg.F
819!||--- called by ------------------------------------------------------
820!|| dynain_c_strag ../engine/source/output/dynain/dynain_c_strag.F
821!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.F
822!||--- calls -----------------------------------------------------
823!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
824!||====================================================================
825 SUBROUTINE get_t3l(JFT ,JLT ,IXTG ,X ,OFFG ,
826 . IREL ,VQ )
827C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
828#include "implicit_f.inc"
829c-----------------------------------------------
830c g l o b a l p a r a m e t e r s
831c-----------------------------------------------
832#include "mvsiz_p.inc"
833C-----------------------------------------------
834C D U M M Y A R G U M E N T S
835C-----------------------------------------------
836 INTEGER IXTG(NIXTG,*),JFT,JLT,IREL
837 my_real
838 . X(3,*), OFFG(*),VQ(3,3,MVSIZ)
839C-----------------------------------------------
840C L O C A L V A R I A B L E S
841C-----------------------------------------------
842 INTEGER I,J,K,L
843 INTEGER I2,I3,I1
844 my_real
845 . RX(MVSIZ),RY(MVSIZ),RZ(MVSIZ),SX(MVSIZ),SY(MVSIZ),
846 . R11(MVSIZ),R12(MVSIZ),R13(MVSIZ),R21(MVSIZ),R22(MVSIZ),
847 . R23(MVSIZ),R31(MVSIZ),R32(MVSIZ),R33(MVSIZ),
848 . sz(mvsiz),deta1(mvsiz)
849C----------------------------------------------
850 DO i=jft,jlt
851 i1=ixtg(2,i)
852 i2=ixtg(3,i)
853 i3=ixtg(4,i)
854
855 rx(i)=x(1,i2)-x(1,i1)
856 ry(i)=x(2,i2)-x(2,i1)
857 rz(i)=x(3,i2)-x(3,i1)
858 sx(i)=x(1,i3)-x(1,i1)
859 sy(i)=x(2,i3)-x(2,i1)
860 sz(i)=x(3,i3)-x(3,i1)
861 ENDDO
862C----------------------------
863C LOCAL SYSTEM
864C----------------------------
865 CALL clskew3(jft,jlt,irel,
866 . rx, ry, rz,
867 . sx, sy, sz,
868 . r11,r12,r13,r21,r22,r23,r31,r32,r33,deta1,offg )
869 DO i=jft,jlt
870 vq(1,1,i)=r11(i)
871 vq(2,1,i)=r21(i)
872 vq(3,1,i)=r31(i)
873 vq(1,2,i)=r12(i)
874 vq(2,2,i)=r22(i)
875 vq(3,2,i)=r32(i)
876 vq(1,3,i)=r13(i)
877 vq(2,3,i)=r23(i)
878 vq(3,3,i)=r33(i)
879 ENDDO
880C
881 RETURN
882 END
883!||====================================================================
884!|| shell2g ../engine/source/output/sta/stat_c_strafg.F
885!||--- called by ------------------------------------------------------
886!|| dynain_c_strag ../engine/source/output/dynain/dynain_c_strag.F
887!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.F
888!|| stat_c_strsfg ../engine/source/output/sta/stat_c_strsfg.F
889!||====================================================================
890 SUBROUTINE shell2g(EPS,QT)
891C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
892#include "implicit_f.inc"
893c-----------------------------------------------
894C-----------------------------------------------
895C D u m m y A r g u m e n t s
896C-----------------------------------------------
897 my_real
898 . eps(6),qt(3,3)
899C------------------------------------------------------
900C L o c a l V a r i a b l e s
901C-----------------------------------------------
902 INTEGER I
903 my_real
904 . txx,tyy,tzz,txy,tyz,tzx,uxx,uyy,uzz,uxy,uyz,uzx,a,b,c
905C--convention input EPS : exx,eyy,exy,eyz,ezx,0; output exx,eyy,ezz,exy,eyz,ezx
906 txx = eps(1)
907 tyy = eps(2)
908 tzz = zero
909 txy = eps(3)
910 tyz = eps(4)
911 tzx = eps(5)
912C
913 a = qt(1,1)*txx + qt(1,2)*txy + qt(1,3)*tzx
914 b = qt(1,1)*txy + qt(1,2)*tyy + qt(1,3)*tyz
915 c = qt(1,1)*tzx + qt(1,2)*tyz + qt(1,3)*tzz
916 uxx = a*qt(1,1) + b*qt(1,2) + c*qt(1,3)
917 uxy = a*qt(2,1) + b*qt(2,2) + c*qt(2,3)
918 uzx = a*qt(3,1) + b*qt(3,2) + c*qt(3,3)
919 a = qt(2,1)*txx + qt(2,2)*txy + qt(2,3)*tzx
920 b = qt(2,1)*txy + qt(2,2)*tyy + qt(2,3)*tyz
921 c = qt(2,1)*tzx + qt(2,2)*tyz + qt(2,3)*tzz
922 uyy = a*qt(2,1) + b*qt(2,2) + c*qt(2,3)
923 uyz = a*qt(3,1) + b*qt(3,2) + c*qt(3,3)
924 a = qt(3,1)*txx + qt(3,2)*txy + qt(3,3)*tzx
925 b = qt(3,1)*txy + qt(3,2)*tyy + qt(3,3)*tyz
926 c = qt(3,1)*tzx + qt(3,2)*tyz + qt(3,3)*tzz
927 uzz = a*qt(3,1) + b*qt(3,2) + c*qt(3,3)
928C
929 eps(1) = uxx
930 eps(2) = uyy
931 eps(3) = uzz
932 eps(4) = uxy
933 eps(5) = uyz
934 eps(6) = uzx
935C
936 RETURN
937 END
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
my_real
#define my_real
Definition cppsort.cpp:32
layini
subroutine layini(elbuf_str, jft, jlt, geo, igeo, mat, pid, thkly, matly, posly, igtyp, ixfem, ixlay, nlay, npt, isubstack, stack, drape, nft, thk, nel, ratio_thkly, indx_drape, sedrape, numel_drape)
Definition layini.F:47
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
drape_mod::numeltg_drape
integer numeltg_drape
Definition drape_mod.F:92
drape_mod::scdrape
integer scdrape
Definition drape_mod.F:92
drape_mod::numelc_drape
integer numelc_drape
Definition drape_mod.F:92
stack_mod
Definition stack_mod.F:72
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1015
spmd_stat_pgather
subroutine spmd_stat_pgather(ptv, ptlen, ptv_p0, ptlen_p0)
Definition spmd_stat.F:53
strs_txt50
subroutine strs_txt50(text, length)
Definition sta_txt.F:87
tab_strs_txt50
subroutine tab_strs_txt50(wap0, cpt, j, sizp0, nbpline)
Definition sta_txt.F:127
get_t3l
subroutine get_t3l(jft, jlt, ixtg, x, offg, irel, vq)
Definition stat_c_strafg.F:827
get_q4l
subroutine get_q4l(jft, jlt, ixc, x, offg, irel, vq)
Definition stat_c_strafg.F:760
stat_c_strafg
subroutine stat_c_strafg(elbuf_tab, x, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, ipart_state, stat_indxc, stat_indxtg, thke, sizp0, geo, stack, drape_sh4n, drape_sh3n, drapeg)
Definition stat_c_strafg.F:47
shell2g
subroutine shell2g(eps, qt)
Definition stat_c_strafg.F:891
drape_mod::drape_
Definition drape_mod.F:71