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 41 of file dynain_c_strag.F.

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