OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dynain_c_strag.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dynain_c_strag (elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, dynain_data, dynain_indxc, dynain_indxtg, sizp0, geo, stack, drape_sh4n, drape_sh3n, x, thke, drapeg)

Function/Subroutine Documentation

◆ dynain_c_strag()

subroutine dynain_c_strag ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
double precision, dimension(*) wa,
double precision, dimension(*) wap0,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
type (dynain_database), intent(inout) dynain_data,
integer, dimension(*) dynain_indxc,
integer, dimension(*) dynain_indxtg,
integer sizp0,
geo,
type (stack_ply) stack,
type (drape_), dimension(numelc_drape) drape_sh4n,
type (drape_), dimension(numeltg_drape) drape_sh3n,
x,
thke,
type (drapeg_) drapeg )

Definition at line 42 of file dynain_c_strag.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
52 USE stack_mod
53 USE drape_mod
54 USE state_mod
55 use element_mod , only : nixc,nixtg
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "mvsiz_p.inc"
65#include "param_c.inc"
66#include "units_c.inc"
67#include "task_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER SIZP0
72 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
73 . IPARG(NPARG,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
74 . IPARTC(*), IPARTTG(*),DYNAIN_INDXC(*), DYNAIN_INDXTG(*)
75 my_real
76 . geo(npropg,*) , x(*) , thke(*)
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
78 TYPE (STACK_PLY) :: STACK
79 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE),DRAPE_SH3N(NUMELTG_DRAPE)
80 TYPE (DRAPEG_) :: DRAPEG
81 double precision WA(*),WAP0(*)
82 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I, J, K, N, JJ, LEN, IOFF, IE, NG, NEL, NFT, LFT, NPT,
87 . LLT,ITY,MLW,IH,IHBE, ID, IPRT0, IPRT,IR,IS,IT,
88 . NPG,IPG,MPT,IPT,NPTR,NPTS,NPTT,NLAY,L_PLA,ITHK,
89 . IGTYP,NPT_ALL,IL,KK(8),LARGE,IREP,IPID,IVISC,
90 . IPMAT,IXFEM,IXLAY,ISUBSTACK,IPTT,IS_WRITTEN,
91 , LAYNPT_MAX,NLAY_MAX,IERR,
92 . JDIR,ILAY,J1,J2,IREL,G_STRA,IPT_ALL,SEDRAPE,NUMEL_DRAPE
93 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY !!
94 my_real, DIMENSION(:) , ALLOCATABLE :: thkly !!
95 my_real, DIMENSION(:,:) , ALLOCATABLE :: posly,thk_ly
96 INTEGER , DIMENSION(:),ALLOCATABLE :: PTWA, PTWA_P0
97 INTEGER MAT(MVSIZ),PID(MVSIZ)
98 CHARACTER*80 DELIMIT
99 CHARACTER*100 LINE
100 my_real
101 . sig(6)
102 my_real,
103 . DIMENSION(:),POINTER :: strain
104 my_real
105 . qt(9,mvsiz),straing(6),zh,thkp ,thk0(mvsiz)
106 TYPE(G_BUFEL_) ,POINTER :: GBUF
107
108
109C-----------------------------------------------
110
111 DATA delimit(1:48)
112 ./'$--1---|---2---|---3---|---4---|---5---|---6---|'/
113 DATA delimit(49:80)
114 ./'---7---|---8---|---9---|---10--|'/
115C=======================================================================
116
117C-----------------------
118C Allocation Tabs
119C-----------------------
120 ALLOCATE(ptwa(max(dynain_data%DYNAIN_NUMELC ,
121 . dynain_data%DYNAIN_NUMELTG)),stat=ierr)
122 ALLOCATE(ptwa_p0(0:max(1,dynain_data%DYNAIN_NUMELC_G,
123 . dynain_data%DYNAIN_NUMELTG_G)),stat=ierr)
124C*********************************************
125C 4-NODE SHELLS
126C*********************************************
127 jj = 0
128C
129 ie=0
130 IF (dynain_data%DYNAIN_NUMELC/=0) THEN
131 DO ng=1,ngroup
132 ity = iparg(5,ng)
133 IF (ity == 3) THEN
134 gbuf => elbuf_tab(ng)%GBUF
135 mlw = iparg(1,ng)
136 nel = iparg(2,ng)
137 nft = iparg(3,ng)
138 mpt = iparg(6,ng)
139 ihbe = iparg(23,ng)
140 ithk = iparg(28,ng)
141 igtyp= iparg(38,ng)
142 ixfem = iparg(54,ng)
143 isubstack=iparg(71,ng)
144 ixlay = 0 ! standard element
145 ipid = ixc(6,nft+1)
146 irep = igeo(6,ipid)
147 nptr = elbuf_tab(ng)%NPTR
148 npts = elbuf_tab(ng)%NPTS
149 nptt = elbuf_tab(ng)%NPTT
150 nlay = elbuf_tab(ng)%NLAY
151 npg = nptr*npts
152 npt = nlay*nptt
153 IF (ihbe == 23 .AND. gbuf%G_STRPG>gbuf%G_STRA) npg=4
154 IF (ihbe == 23 .AND. npg/=4) cycle
155 lft=1
156 llt=nel
157
158 g_stra = gbuf%G_STRA
159
160!
161 DO j=1,8 ! length max of GBUF%G_STRA = 8
162 kk(j) = nel*(j-1)
163 ENDDO
164!
165C
166C pre counting of all NPTT (especially for PID_51)
167C
168 ! Npt_max
169 laynpt_max = 1
170 IF (igtyp == 51 .OR. igtyp == 52 ) THEN
171 npt_all = 0
172 DO il=1,nlay
173 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
174 laynpt_max = max(laynpt_max , elbuf_tab(ng)%BUFLY(il)%NPTT)
175 ENDDO
176 mpt = max(1,npt_all)
177 ENDIF
178
179 nlay_max = max(nlay,npt, elbuf_tab(ng)%NLAY)
180 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
181 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
182 matly = 0
183 thkly = zero
184 posly = zero
185 thk_ly = zero
186 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
187
188 DO i=lft,llt
189 mat(i)=ixc(1,nft+i)
190 pid(i)=ixc(6,nft+i)
191 ENDDO
192
193C-------------------------------------------------
194C RELATIVE POSITION OF INTEGRATION POINTS
195C POSLY between -0.5, 0.5 : need to multiply by 2 for LSDYNA
196C------------------------------------------------
197 IF (ithk >0 ) THEN
198 thk0(lft:llt) = gbuf%THK(lft:llt)
199 ELSE
200 thk0(lft:llt) = thke(lft:llt)
201 END IF
202 numel_drape = numelc_drape
203 sedrape = scdrape
204 CALL layini(
205 . elbuf_tab(ng),lft ,llt ,geo ,igeo ,
206 . mat ,pid ,thkly ,matly ,posly ,
207 . igtyp ,ixfem ,ixlay ,nlay ,npt ,
208 . isubstack ,stack ,drape_sh4n ,nft ,thke ,
209 . nel ,thk_ly ,drapeg%INDX_SH4N,sedrape,numel_drape)
210
211C-------------------------------------------------------
212C ELEMENT LOCAL FRAME : for rotation local -> Global
213C-------------------------------------------------------
214 IF (ihbe>10.OR.igtyp==16.OR.ishfram ==0) THEN
215 irel=0
216 ELSEIF (ishfram ==1) THEN
217 irel=2
218 ELSE
219 irel=1
220 END IF
221 CALL get_q4l(lft ,llt ,ixc(1,nft+1),x ,gbuf%OFF,irel ,qt )
222
223C-------------------------------------------------------
224C- Loop over 4 node shell elements
225C-------------------------------------------------------
226 DO i=lft,llt
227 n = i + nft
228 iprt=ipartc(n)
229 IF (dynain_data%IPART_DYNAIN(iprt)==0) cycle
230 jj = jj + 1
231 IF (mlw /= 0 .AND. mlw /= 13) THEN
232 wa(jj) = gbuf%OFF(i)
233 ELSE
234 wa(jj) = zero
235 ENDIF
236 jj = jj + 1
237 wa(jj) = ixc(nixc,n)
238 jj = jj + 1
239 IF (mpt == 0) THEN ! global integration
240 wa(jj) = 3 ! Membrane - Lower - Upper
241 ELSE
242 wa(jj) = mpt ! Integration points
243 ENDIF
244 jj = jj + 1
245 wa(jj) = npg ! Gauss Points
246 jj = jj + 1
247 wa(jj) = one ! LARGE
248
249 thkp = thk0(i)
250c---------
251
252 IF (mlw == 0 .or. mlw == 13) THEN
253 DO ipg=1,npg
254 jj = jj + 1
255 wa(jj) = zero
256 DO j=1,7 ! STRAIN + POS
257 jj = jj + 1
258 wa(jj) = zero
259 ENDDO
260 ENDDO
261 ELSEIF (mpt==0 .AND. g_stra /= 0) THEN
262
263 IF (npg > 1) THEN
264 strain => gbuf%STRPG
265 ELSE
266 strain => gbuf%STRA
267 ENDIF
268
269! LOWER
270 DO ipg=1,npg
271 k = (ipg-1)*nel*g_stra
272 zh = -half*thkp
273
274 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
275 straing(3)=half*straing(3)
276 straing(4:5)=half*strain(kk(4:5)+i+k)
277
278 CALL shell2g(straing,qt(1,i))
279
280 DO j=1,6
281 jj = jj + 1
282 wa(jj) = straing(j)
283 END DO
284 jj = jj + 1
285 wa(jj) = -one
286 ENDDO
287
288! MEMBRANE
289 DO ipg=1,npg
290 k = (ipg-1)*nel*g_stra
291
292 straing(1:2)=strain(kk(1:2)+i+k)
293 straing(3:5)=half*strain(kk(3:5)+i+k)
294
295 CALL shell2g(straing,qt(1,i))
296
297 DO j=1,6
298 jj = jj + 1
299 wa(jj) = straing(j)
300 END DO
301 jj = jj + 1
302 wa(jj) = zero
303 ENDDO
304
305! Upper
306 DO ipg=1,npg
307 k = (ipg-1)*nel*g_stra
308 zh = half*thkp
309
310 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
311 straing(3)=half*straing(3)
312 straing(4:5)=half*strain(kk(4:5)+i+k)
313
314 CALL shell2g(straing,qt(1,i))
315
316 DO j=1,6
317 jj = jj + 1
318 wa(jj) = straing(j)
319 END DO
320 jj = jj + 1
321 wa(jj) = one
322 ENDDO
323
324
325 ELSEIF (g_stra /= 0) THEN
326
327 IF (npg > 1) THEN
328 strain => gbuf%STRPG
329 ELSE
330 strain => gbuf%STRA
331 ENDIF
332
333
334 ipt_all = 0
335 DO ilay =1,nlay
336 nptt = elbuf_tab(ng)%BUFLY(ilay)%NPTT
337 DO it=1,nptt
338 ipt = ipt_all + it
339C--
340 DO ipg=1,npg
341 k = (ipg-1)*nel*g_stra
342 zh = posly(i,ipt)*thkp
343 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
344 straing(3)=half*straing(3)
345 straing(4:5)=half*strain(kk(4:5)+i+k)
346
347 CALL shell2g(straing,qt(1,i))
348C
349 DO j=1,6
350 jj = jj + 1
351 wa(jj) = straing(j)
352 END DO
353 jj = jj + 1
354 wa(jj) = posly(i,ipt)*two
355 END DO
356 END DO !IT=1,NPTT
357 ipt_all = ipt_all + nptt
358 END DO !ILAY =1,NLAY
359
360 ENDIF
361C
362 ie=ie+1
363C Pointer last position of shell IE in WA
364 ptwa(ie)=jj
365 ENDDO ! DO I=LFT,LLT
366
367c------- end loop over 4 node shell elements
368 DEALLOCATE(matly, thkly, posly, thk_ly)
369 ENDIF ! ITY == 3
370 ENDDO ! NG = 1, NGROUP
371 ENDIF ! DYNAIN_NUMEL /= 0
372
373c-----------------------------------------------------------------------
374c 4N SHELLS - WRITE
375c-----------------------------------------------------------------------
376 IF (nspmd == 1) THEN
377C recopying for code simplification
378 ptwa_p0(0)=0
379 DO n=1,dynain_data%DYNAIN_NUMELC
380 ptwa_p0(n)=ptwa(n)
381 ENDDO
382 len=jj
383 DO j=1,len
384 wap0(j)=wa(j)
385 ENDDO
386 ELSE
387C Global pointers WAP0
388 CALL spmd_stat_pgather(ptwa,dynain_data%DYNAIN_NUMELC,ptwa_p0,dynain_data%DYNAIN_NUMELC_G)
389 len = 0
390 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
391 ENDIF
392c-------------------------------------
393 is_written = 0
394 IF (ispmd == 0.AND.len > 0) THEN
395 IF(dynain_data%ZIPDYNAIN==0) THEN
396 WRITE(iudynain,'(A)') delimit
397 WRITE(iudynain,'(A)')'*INITIAL_STRAIN_SHELL'
398 WRITE(iudynain,'(A)')
399 . '$ SHELLID NPG NBINT LARGE '
400 WRITE(iudynain,'(A)')
401 . '$ IF(NPT == 0), REPEAT I=1,NPG :'
402 WRITE(iudynain,'(A)')
403 . '$ IF(NPT /= 0) REPEAT K=1,NPT : REPEAT I=1,NPG :'
404 WRITE(iudynain,'(A)')
405 . '$ EPSXX EPSYY EPSZZ EPSXY EPSYZ EPSZX T'
406 WRITE(iudynain,'(A)') delimit
407 ELSE
408 WRITE(line,'(A)') delimit
409 CALL strs_txt50(line,100)
410 WRITE(line,'(A)')'*INITIAL_STRAIN_SHELL'
411 CALL strs_txt50(line,100)
412 WRITE(line,'(A)')
413 . '$ SHELLID NPG NBINT LARGE '
414 CALL strs_txt50(line,100)
415 WRITE(line,'(A)')
416 . '$ IF(NPT == 0), REPEAT I=1,NPG :'
417 CALL strs_txt50(line,100)
418 WRITE(line,'(A)')
419 . '$ IF(NPT /= 0) REPEAT K=1,NPT : REPEAT I=1,NPG :'
420 CALL strs_txt50(line,100)
421 WRITE(line,'(A)')
422 . '$ EPSXX EPSYY EPSZZ EPSXY EPSYZ EPSZX T'
423 CALL strs_txt50(line,100)
424 WRITE(line,'(A)') delimit
425 CALL strs_txt50(line,100)
426 ENDIF
427 is_written = 1
428 DO n=1,dynain_data%DYNAIN_NUMELC_G
429C Retrieving shell ID in increasing order
430 k=dynain_indxc(n)
431C Adress in WAP0
432 j=ptwa_p0(k-1)
433
434 ioff = nint(wap0(j + 1))
435 IF (ioff >= 1) THEN
436c
437 id = nint(wap0(j + 2))
438 npt = nint(wap0(j + 3))
439 npg = nint(wap0(j + 4))
440 large = nint(wap0(j + 5))
441
442 j = j + 5
443 IF(dynain_data%ZIPDYNAIN==0) THEN
444 WRITE(iudynain,'(4I8)')id,npg,npt,large
445 ELSE
446 WRITE(line,'(4I8)')id,npg,npt,large
447 CALL strs_txt50(line,100)
448 ENDIF
449 IF (npt == 0) THEN
450 DO ipg=1,npg
451 IF(dynain_data%ZIPDYNAIN==0) THEN
452 WRITE(iudynain,'(1P5G16.9)')(wap0(jj + k),k=1,3)
453 WRITE(iudynain,'(1P3G16.9)')(wap0(jj + k),k=6,7)
454 ELSE
455 WRITE(line,'(1P5G16.9)')(wap0(jj + k),k=1,3)
456 CALL strs_txt50(line,100)
457 WRITE(line,'(1P3G16.9)')(wap0(jj + k),k=6,7)
458 CALL strs_txt50(line,100)
459 ENDIF
460 j = j + 7
461 ENDDO
462 ELSE
463 DO ipt=1,npt
464 DO ipg=1,npg
465 IF(dynain_data%ZIPDYNAIN==0) THEN
466 WRITE(iudynain,'(1P5G16.9)')(wap0(j + k),k=1,5)
467 WRITE(iudynain,'(1P3G16.9)')(wap0(j + k),k=6,7)
468 ELSE
469 WRITE(line,'(1P5G16.9)')(wap0(j + k),k=1,5)
470 CALL strs_txt50(line,100)
471 WRITE(line,'(1P3G16.9)')(wap0(j + k),k=6,7)
472 CALL strs_txt50(line,100)
473 ENDIF
474 j = j + 7
475 ENDDO
476 ENDDO
477
478 ENDIF ! IF (NPT == 0)
479 ENDIF ! IF (IOFF >= 1)
480 ENDDO ! DO N=1,DYNAIN_NUMELC_G
481 ENDIF ! IF (ISPMD == 0.AND.LEN > 0)
482
483C***********************************************
484C 3-NODE SHELLS
485C***********************************************
486
487 jj = 0
488 ie=0
489C
490 IF(dynain_data%DYNAIN_NUMELTG/=0) THEN
491 DO ng=1,ngroup
492 ity = iparg(5,ng)
493 IF (ity == 7) THEN
494 gbuf => elbuf_tab(ng)%GBUF
495 mlw = iparg(1,ng)
496 nel = iparg(2,ng)
497 nft = iparg(3,ng)
498 mpt = iparg(6,ng)
499 ihbe = iparg(23,ng)
500 ithk = iparg(28,ng)
501 igtyp= iparg(38,ng)
502 ipid = ixtg(5,nft+1)
503 irep = igeo(6,ipid)
504 nptr = elbuf_tab(ng)%NPTR
505 npts = elbuf_tab(ng)%NPTS
506 nptt = elbuf_tab(ng)%NPTT
507 nlay = elbuf_tab(ng)%NLAY
508 npg = nptr*npts
509 npt = nlay*nptt
510 lft=1
511 llt=nel
512
513 g_stra = gbuf%G_STRA
514!
515 DO j=1,8 ! length max of GBUF%G_STRA = 8
516 kk(j) = nel*(j-1)
517 ENDDO
518!
519C
520C pre counting of all NPTT (especially for PID_51)
521C
522 ! Npt_max
523 laynpt_max = 1
524 IF (igtyp == 51 .OR. igtyp == 52 ) THEN
525 npt_all = 0
526 DO k=1,nlay
527 npt_all = npt_all + elbuf_tab(ng)%BUFLY(k)%NPTT
528 laynpt_max = max(laynpt_max , elbuf_tab(ng)%BUFLY(k)%NPTT)
529 ENDDO
530 mpt = max(1,npt_all)
531 ENDIF
532
533 nlay_max = max(nlay,npt, elbuf_tab(ng)%NLAY)
534 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
535 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
536 matly = 0
537 thkly = zero
538 posly = zero
539 thk_ly = zero
540 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
541
542 DO i=lft,llt
543 mat(i)=ixtg(1,nft+i)
544 pid(i)=ixtg(5,nft+i)
545 ENDDO
546C-------------------------------------------------
547C RELATIVE POSITION OF INTEGRATION POINTS
548C POSLY between -0.5, 0.5 : need to multiply by 2 for LSDYNA
549C------------------------------------------------
550 IF (ithk >0 ) THEN
551 thk0(lft:llt) = gbuf%THK(lft:llt)
552 ELSE
553 thk0(lft:llt) = thke(lft:llt)
554 END IF
555 numel_drape = numeltg_drape
556 sedrape = stdrape
557 CALL layini(
558 . elbuf_tab(ng),lft ,llt ,geo ,igeo ,
559 . mat ,pid ,thkly ,matly ,posly ,
560 . igtyp ,ixfem ,ixlay ,nlay ,npt ,
561 . isubstack ,stack ,drape_sh3n ,nft ,thke ,
562 . nel ,thk_ly ,drapeg%INDX_SH3N ,sedrape,numel_drape)
563
564C-------------------------------------------------------
565C ELEMENT LOCAL FRAME : for rotation local -> Global
566C-------------------------------------------------------
567 IF (ihbe>=30) THEN
568 irel=0
569 ELSE
570 irel=2
571 END IF
572 CALL get_t3l(lft ,llt ,ixtg(1,nft+1),x ,gbuf%OFF,
573 . irel ,qt )
574
575C
576c------- loop over 3 node shell elements
577C
578 DO i=lft,llt
579 n = i + nft
580 iprt=iparttg(n)
581 IF (dynain_data%IPART_DYNAIN(iprt) == 0) cycle
582 jj = jj + 1
583 IF (mlw /= 0 .AND. mlw /= 13) THEN
584 wa(jj) = gbuf%OFF(i)
585 ELSE
586 wa(jj) = zero
587 ENDIF
588 jj = jj + 1
589 wa(jj) = ixtg(nixtg,n)
590 jj = jj + 1
591 IF (mpt == 0) THEN ! global integration
592 wa(jj) = 3 ! Membrane - Lower - Upper
593 ELSE
594 wa(jj) = mpt ! Integration points
595 ENDIF
596 jj = jj + 1
597 wa(jj) = npg
598 jj = jj + 1
599 wa(jj) = one ! LARGE
600
601 IF (ithk >0 ) THEN
602 thkp = gbuf%THK(i)
603 ELSE
604 thkp = thke(i + nft)
605 END IF
606
607c---------
608 IF (mlw == 0 .or. mlw == 13) THEN
609 DO ipg=1,npg
610 jj = jj + 1
611 wa(jj) = zero
612 DO j=1,7 ! STRAIN + POS
613 jj = jj + 1
614 wa(jj) = zero
615 ENDDO
616 ENDDO
617 ELSEIF (mpt==0 .AND. g_stra /= 0) THEN
618
619 IF (npg > 1) THEN
620 strain => gbuf%STRPG
621 ELSE
622 strain => gbuf%STRA
623 ENDIF
624
625
626! LOWER
627 DO ipg=1,npg
628 k = (ipg-1)*nel*g_stra
629 zh = -half*thkp
630
631 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
632 straing(3)=half*straing(3)
633 straing(4:5)=half*strain(kk(4:5)+i+k)
634
635 CALL shell2g(straing,qt(1,i))
636
637 DO j=1,6
638 jj = jj + 1
639 wa(jj) = straing(j)
640 END DO
641 jj = jj + 1
642 wa(jj) = -one
643 ENDDO
644
645! MEMBRANE
646 DO ipg=1,npg
647 k = (ipg-1)*nel*g_stra
648
649 straing(1:2)=strain(kk(1:2)+i+k)
650 straing(3:5)=half*strain(kk(3:5)+i+k)
651
652 CALL shell2g(straing,qt(1,i))
653
654 DO j=1,6
655 jj = jj + 1
656 wa(jj) = straing(j)
657 END DO
658 jj = jj + 1
659 wa(jj) = zero
660 ENDDO
661
662! Upper
663 DO ipg=1,npg
664 k = (ipg-1)*nel*g_stra
665 zh = half*thkp
666
667 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
668 straing(3)=half*straing(3)
669 straing(4:5)=half*strain(kk(4:5)+i+k)
670
671 CALL shell2g(straing,qt(1,i))
672
673 DO j=1,6
674 jj = jj + 1
675 wa(jj) = straing(j)
676 END DO
677 jj = jj + 1
678 wa(jj) = one
679 ENDDO
680
681
682 ELSEIF (g_stra /= 0) THEN
683
684 IF (npg > 1) THEN
685 strain => gbuf%STRPG
686 ELSE
687 strain => gbuf%STRA
688 ENDIF
689
690 ipt_all = 0
691 DO ilay =1,nlay
692 nptt = elbuf_tab(ng)%BUFLY(ilay)%NPTT
693 DO it=1,nptt
694 ipt = ipt_all + it
695C--
696 IF (ithk >0 ) THEN
697 thkp = gbuf%THK(i)
698 ELSE
699 thkp = thke(i + nft)
700 END IF
701
702 DO ipg=1,npg
703 k = (ipg-1)*nel*g_stra
704 zh = posly(i,ipt)*thkp
705 straing(1:3)=strain(kk(1:3)+i+k)+zh*strain(kk(6:8)+i+k)
706 straing(3)=half*straing(3)
707 straing(4:5)=half*strain(kk(4:5)+i+k)
708
709 CALL shell2g(straing,qt(1,i))
710C
711 DO j=1,6
712 jj = jj + 1
713 wa(jj) = straing(j)
714 END DO
715 jj = jj + 1
716 wa(jj) = posly(i,ipt)*two
717 END DO
718 END DO !IT=1,NPTT
719 ipt_all = ipt_all + nptt
720 END DO !ILAY =1,NLAY
721
722 ENDIF
723C
724 ie=ie+1
725C pointer for last position for element IE
726 ptwa(ie)=jj
727 ENDDO ! DO I=LFT,LLT
728 DEALLOCATE(matly, thkly, posly, thk_ly)
729 ENDIF ! IF (ITY == 7)
730 ENDDO ! DO NG=1,NGROUP
731 ENDIF
732C
733c-----------------------------------------------------------------------
734 IF (nspmd == 1) THEN
735C recopying for code simplification
736 len=jj
737 DO j=1,len
738 wap0(j)=wa(j)
739 ENDDO
740 ptwa_p0(0)=0
741 DO n=1,dynain_data%DYNAIN_NUMELTG
742 ptwa_p0(n)=ptwa(n)
743 ENDDO
744 ELSE
745C Global pointers WAP0
746 CALL spmd_stat_pgather(ptwa,dynain_data%DYNAIN_NUMELTG,ptwa_p0,dynain_data%DYNAIN_NUMELTG_G)
747 len = 0
748 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
749 ENDIF
750
751 IF (ispmd == 0.AND.len > 0) THEN
752 IF(is_written == 0 ) THEN
753 IF(dynain_data%ZIPDYNAIN==0) THEN
754 WRITE(iudynain,'(A)') delimit
755 WRITE(iudynain,'(A)')'*INITIAL_STRAIN_SHELL'
756 WRITE(iudynain,'(A)')
757 . '$ SHELLID NPG NBINT LARGE '
758 WRITE(iudynain,'(A)')
759 . '$ IF(NPT == 0), REPEAT I=1,NPG :'
760 WRITE(iudynain,'(A)')
761 . '$ IF(NPT /= 0) REPEAT K=1,NPT : REPEAT I=1,NPG :'
762 WRITE(iudynain,'(A)')
763 . '$ T EPSXX EPSYY EPSZZ EPSXY EPSYZ EPSZX'
764 WRITE(iudynain,'(A)') delimit
765 ELSE
766 WRITE(line,'(A)') delimit
767 CALL strs_txt50(line,100)
768 WRITE(line,'(A)')'*INITIAL_STRAIN_SHELL'
769 CALL strs_txt50(line,100)
770 WRITE(line,'(A)')
771 . '$ SHELLID NPG NBINT LARGE '
772 CALL strs_txt50(line,100)
773 WRITE(line,'(A)')
774 . '$ IF(NPT == 0), REPEAT I=1,NPG :'
775 CALL strs_txt50(line,100)
776 WRITE(line,'(A)')
777 . '$ IF(NPT /= 0) REPEAT K=1,NPT : REPEAT I=1,NPG :'
778 CALL strs_txt50(line,100)
779 WRITE(line,'(A)')
780 . '$ T EPSXX EPSYY EPSZZ EPSXY EPSYZ EPSZX'
781 CALL strs_txt50(line,100)
782 WRITE(line,'(A)') delimit
783 CALL strs_txt50(line,100)
784 ENDIF
785
786 is_written = 1
787
788 ENDIF
789
790 DO n=1,dynain_data%DYNAIN_NUMELTG_G
791C Retrieving shell ID in increasing order
792 k=dynain_indxtg(n)
793C Adress in WAP0
794 j=ptwa_p0(k-1)
795C
796 ioff = nint(wap0(j + 1))
797 IF (ioff >= 1) THEN
798 id = nint(wap0(j + 2))
799 npt = nint(wap0(j + 3))
800 npg = nint(wap0(j + 4))
801 large = nint(wap0(j + 5))
802 j = j + 5
803
804 IF(dynain_data%ZIPDYNAIN==0) THEN
805 WRITE(iudynain,'(4I8)')id,npg,npt,large
806 ELSE
807 WRITE(line,'(4I8)')id,npg,npt,large
808 CALL strs_txt50(line,100)
809 ENDIF
810
811 IF (npt == 0) THEN
812 DO ipg=1,npg
813 IF(dynain_data%ZIPDYNAIN==0) THEN
814 WRITE(iudynain,'(1P5G16.9)')(wap0(jj + k),k=1,5)
815 WRITE(iudynain,'(1P3G16.9)')(wap0(jj + k),k=6,7)
816 ELSE
817 WRITE(line,'(1P5G16.9)')(wap0(jj + k),k=1,5)
818 CALL strs_txt50(line,100)
819 WRITE(line,'(1P3G16.9)')(wap0(jj + k),k=6,7)
820 CALL strs_txt50(line,100)
821 ENDIF
822 j = j + 7
823 ENDDO
824 ELSE
825 DO ipt=1,npt
826 DO ipg=1,npg
827 IF(dynain_data%ZIPDYNAIN==0) THEN
828 WRITE(iudynain,'(1P5G16.9)')(wap0(j + k),k=1,5)
829 WRITE(iudynain,'(1P3G16.9)')(wap0(j + k),k=6,7)
830 ELSE
831 WRITE(line,'(1P5G16.9)')(wap0(j + k),k=1,5)
832 CALL strs_txt50(line,100)
833 WRITE(line,'(1P3G16.9)')(wap0(j + k),k=6,7)
834 CALL strs_txt50(line,100)
835 ENDIF
836 j = j + 7
837 ENDDO
838 ENDDO
839 ENDIF ! IF (NPT == 0)
840 ENDIF ! IF (IOFF >= 1)
841 ENDDO ! DO N=1,DYNAIN_NUMELTG_G
842 ENDIF ! IF (ISPMD == 0.AND.LEN > 0)
843C
844 DEALLOCATE(ptwa,ptwa_p0)
845 RETURN
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
id
initmumps id
Definition multiplerhs_example.m:4
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::stdrape
integer stdrape
Definition drape_mod.F:92
drape_mod::numelc_drape
integer numelc_drape
Definition drape_mod.F:92
stack_mod
Definition stack_mod.F:75
state_mod
Definition state_mod.F:54
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1019
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
get_t3l
subroutine get_t3l(jft, jlt, ixtg, x, offg, irel, vq)
Definition stat_c_strafg.F:834
get_q4l
subroutine get_q4l(jft, jlt, ixc, x, offg, irel, vq)
Definition stat_c_strafg.F:764
shell2g
subroutine shell2g(eps, qt)
Definition stat_c_strafg.F:899