OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbainit3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "vect01_c.inc"
#include "scr03_c.inc"
#include "scry_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cbainit3 (elbuf_str, ixc, pm, x, geo, xmas, in, nvc, dtelem, igrsh4n, xrefc, nel, ithk, ihbe, igrsh3n, thke, isigsh, sigsh, stifn, stifr, partsav, v, ipart, msc, inc, skew, i8mi, nsigsh, igeo, ipm, iuser, etnod, nshnod, stc, ptshel, bufmat, sh4tree, mcp, mcps, temp, ms_layer, zi_layer, itag, itagel, iparg, ms_layerc, zi_layerc, part_area, cpt_eltens, msz2c, zply, itagn, itage, ixfem, npf, tf, xfem_str, isubstack, stack, rnoise, drape, sh4ang, iddlevel, geo_stack, igeo_stack, strc, perturb, iyldini, ele_area, nloc_dmg, ng, group_param, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)

Function/Subroutine Documentation

◆ cbainit3()

subroutine cbainit3 ( type (elbuf_struct_), target elbuf_str,
integer, dimension(nixc,*) ixc,
pm,
x,
geo,
xmas,
in,
integer nvc,
dtelem,
type (group_), dimension(ngrshel) igrsh4n,
xrefc,
integer nel,
integer ithk,
integer ihbe,
type (group_), dimension(ngrsh3n) igrsh3n,
thke,
integer isigsh,
sigsh,
stifn,
stifr,
partsav,
v,
integer, dimension(*) ipart,
msc,
inc,
skew,
integer *8, dimension(6,*) i8mi,
integer nsigsh,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer iuser,
etnod,
integer, dimension(*) nshnod,
stc,
integer, dimension(*) ptshel,
bufmat,
integer, dimension(*) sh4tree,
mcp,
mcps,
temp,
ms_layer,
zi_layer,
integer, dimension(*) itag,
integer, dimension(*) itagel,
integer, dimension(*) iparg,
ms_layerc,
zi_layerc,
part_area,
integer cpt_eltens,
msz2c,
zply,
integer, dimension(*) itagn,
integer, dimension(*) itage,
integer ixfem,
integer, dimension(*) npf,
tf,
type (elbuf_struct_), dimension(ngroup,*), target xfem_str,
integer isubstack,
type (stack_ply) stack,
rnoise,
type (drape_), dimension(numelc_drape + numeltg_drape) drape,
sh4ang,
integer, intent(in) iddlevel,
geo_stack,
integer, dimension(*) igeo_stack,
strc,
integer, dimension(nperturb) perturb,
integer iyldini,
ele_area,
type (nlocal_str_) nloc_dmg,
integer ng,
type (group_param_) group_param,
integer idrape,
type (drapeg_) drapeg,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
type (fail_fractal_), intent(in) fail_fractal,
type (fail_brokmann_), intent(in) fail_brokmann,
type(glob_therm_), intent(in) glob_therm )

Definition at line 64 of file cbainit3.F.

81C-----------------------------------------------
82C M o d u l e s
83C-----------------------------------------------
84 USE my_alloc_mod
85 USE mat_elem_mod
86 USE message_mod
87 USE stack_mod
88 USE groupdef_mod
89 USE nlocal_reg_mod
90 USE group_param_mod
91 USE drape_mod
92 USE random_walk_def_mod
93 USE fractal_dmg_init_mod
94 USE names_and_titles_mod , ONLY : nchartitle
95 use brokmann_random_def_mod
96 use glob_therm_mod
97 use initemp_shell_mod
98 use element_mod , only : nixc
99C-----------------------------------------------
100C I m p l i c i t T y p e s
101C-----------------------------------------------
102#include "implicit_f.inc"
103C-----------------------------------------------
104C G l o b a l P a r a m e t e r s
105C-----------------------------------------------
106#include "mvsiz_p.inc"
107C-----------------------------------------------
108C C o m m o n B l o c k s
109C-----------------------------------------------
110#include "param_c.inc"
111#include "com01_c.inc"
112#include "com04_c.inc"
113#include "com_xfem1.inc"
114#include "vect01_c.inc"
115#include "scr03_c.inc"
116#include "scry_c.inc"
117#include "scr17_c.inc"
118C-----------------------------------------------
119C D u m m y A r g u m e n t s
120C-----------------------------------------------
121 INTEGER NVC,NEL,ITHK,IHBE,ISIGSH,IXFEM,NSIGSH,IUSER,IYLDINI,
122 . ISUBSTACK,NG,IDRAPE
123 INTEGER IXC(NIXC,*),IPART(*),PTSHEL(*),ITAG(*),ITAGEL(*),
124 . IGEO(NPROPGI,*), IPM(NPROPMI,*), NSHNOD(*),NPF(*),
125 . SH4TREE(*),IPARG(*),CPT_ELTENS,ITAGN(*),ITAGE(*),
126 . IGEO_STACK(*),PERTURB(NPERTURB)
127 INTEGER ,INTENT(IN) :: IDDLEVEL
128 INTEGER *8 I8MI(6,*)
129 my_real
130 . pm(npropm,*), x(3,*), geo(npropg,*), xmas(*), in(*),
131 . dtelem(*), xrefc(4,3,*),thke(*), sigsh(nsigsh,*),
132 . stifn(*),stifr(*),partsav(20,*), v(*) ,msc(*) ,inc(*),
133 . skew(lskew,*), etnod(*), stc(*),bufmat(*),mcp(*),mcps(*),
134 . temp(*),ms_layer(*),zi_layer(*),ms_layerc(*),zi_layerc(*),
135 . part_area(*),msz2c(*),zply(*),tf(*),rnoise(*),
136 . sh4ang(*),geo_stack(*),strc(*),ele_area(*)
137 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
138 TYPE (ELBUF_STRUCT_), TARGET ,DIMENSION(NGROUP,*):: XFEM_STR
139 ! when XFEM is ON, XFEM_STR's dimension = NGROUP,NXEL
140 TYPE (STACK_PLY) :: STACK
141 TYPE (NLOCAL_STR_) :: NLOC_DMG
142 TYPE (GROUP_PARAM_) :: GROUP_PARAM
143 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
144 TYPE (DRAPEG_) :: DRAPEG
145 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
146 TYPE (FAIL_FRACTAL_) ,INTENT(IN) :: FAIL_FRACTAL
147 TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
148 TYPE(glob_therm_) ,intent(in) :: glob_therm
149C-----------------------------------------------
150 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
151 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
152C-----------------------------------------------
153C L o c a l V a r i a b l e s
154C-----------------------------------------------
155 INTEGER I,J,K,N,II,IUN,NDEPAR,IGTYP,IGMAT,NUVAR,IMAT,IPROP,PROPID,
156 . IPG,NPG,PTF,PTM,PTS,IXEL,IREP,NLAY,NPTR,NPTS,NPTT,IFAIL,
157 . IL,IR,IS,IT,LENF,LENM,LENS,
158 . LENFP,LENMP,LENEPINCHXZ,LENEPINCHYZ,LENEPINCHZZ,
159 . IPANG,IPTHK,IPPOS, ILAY,I4,MPT,LAYNPT_MAX,LAY_MAX,NPT_ALL
160 INTEGER JJ(9)
161 INTEGER , DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,IORTHLOC,MAT,PID,NGL
162c
163 my_real , DIMENSION(MVSIZ) :: area,aldt,dtel,px1g,px2g,py1g,py2g,
164 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
165 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
166 . x2s,y2s,x3s,y3s,x4s,y4s,
167 . x2l,x3l,x4l,y2l,y3l,y4l
168 CHARACTER(LEN=NCHARTITLE)::TITR
169c
170 my_real, ALLOCATABLE, DIMENSION(:) :: dir_a,dir_b
171 my_real , DIMENSION(:) ,POINTER :: uvar
172 parameter(laynpt_max = 10)
173 parameter(lay_max = 100)
174 INTEGER, DIMENSION(:),ALLOCATABLE::MATLY
175 my_real, DIMENSION(:,:),ALLOCATABLE :: posly
176C-----------------------------------------------
177 TYPE(BUF_LAY_) ,POINTER :: BUFLY
178 TYPE(L_BUFEL_) ,POINTER :: LBUF
179 TYPE(G_BUFEL_) ,POINTER :: GBUF
180C=======================================================================
181 ! Allocate buffers
182 CALL my_alloc(matly,mvsiz*lay_max)
183 CALL my_alloc(posly,mvsiz,lay_max*laynpt_max)
184
185 gbuf => elbuf_str%GBUF
186c
187 imat = ixc(1,1+nft) ! mat N
188 iprop = ixc(nixc-1,1+nft) ! property N
189 propid= igeo(1 ,iprop) ! property ID
190 igtyp = igeo(11,iprop)
191 igmat = igeo(98,iprop) ! global mat flag
192 irep = iparg(35)
193 ifail = iparg(43)
194C
195 DO i=lft,llt
196 n = i+nft
197 mat(i) = ixc(1,n) ! imat = mxt
198 pid(i) = ixc(6,n) ! iprop = mxg
199 ENDDO
200C
201 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr)
202 iorthloc = 0
203c
204 nlay = elbuf_str%NLAY
205 nptr = elbuf_str%NPTR
206 npts = elbuf_str%NPTS
207 nptt = elbuf_str%NPTT
208 nxel = elbuf_str%NXEL
209 npg = nptr*npts
210 lenf = nel*gbuf%G_FORPG/npg
211 lenm = nel*gbuf%G_MOMPG/npg
212C
213 lenfp = nel*gbuf%G_FORPGPINCH/npg
214 lenmp = nel*gbuf%G_MOMPGPINCH/npg
215 lenepinchxz = nel*gbuf%G_EPGPINCHXZ/npg
216 lenepinchyz = nel*gbuf%G_EPGPINCHYZ/npg
217 lenepinchzz = nel*gbuf%G_EPGPINCHZZ/npg
218C
219 lens = nel*gbuf%G_STRPG/npg
220
221 npt_all = 0
222 DO il=1,nlay
223 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
224 ENDDO
225 mpt = max(1,npt_all)
226 IF(npt_all == 0 ) npt_all = nlay
227 IF (iparg(6) == 0.OR.npt==0) mpt=0
228 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0) THEN
229 ALLOCATE(dir_a(npt_all*nel*2))
230 ALLOCATE(dir_b(npt_all*nel*2))
231 dir_a = zero
232 dir_b = zero
233 ELSE
234 ALLOCATE(dir_a(nlay*nel*2))
235 ALLOCATE(dir_b(nlay*nel*2))
236 dir_a = zero
237 dir_b = zero
238 npt_all = nlay
239 ENDIF
240!
241 DO i=1,9 ! length max of GBUF%G_SMSTR = 9
242 jj(i) = nel*(i-1)
243 ENDDO
244 npt_all = max(nlay, npt_all)
245!
246C
247 IF (ishxfem_ply > 0) THEN
248 DO i=lft,llt
249 n = i+nft
250 itag(ixc(2,n)) =1
251 itag(ixc(3,n)) =1
252 itag(ixc(4,n)) =1
253 itag(ixc(5,n)) =1
254 itagel(n) = 1
255 ENDDO
256 ENDIF
257C
258 IF (ixfem > 0) THEN
259 DO i=lft,llt
260 n = i+nft
261 itagn(ixc(2,n)) =1
262 itagn(ixc(3,n)) =1
263 itagn(ixc(4,n)) =1
264 itagn(ixc(5,n)) =1
265 itage(n) = 1
266 ENDDO
267 ENDIF
268c-------------------------------------------------
269 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
270 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
271 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
272 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
273c
274 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
275c
276 CALL cneveci(lft ,llt ,area,
277 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
278 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
279 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
280C------------
281C Tags total area of the part (needed in /ADMAS for shells)
282C------------
283 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
284 DO i=lft,llt
285 j = ipart(i+nft)
286C PART_AREA(J) = PART_AREA(J) + AREA(I)
287 ele_area(i+nft) = area(i)
288 IF (gbuf%G_AREA > 0) gbuf%AREA(i) = area(i)
289 ENDDO
290 ENDIF
291C------------
292!
293! Initialize element temperature from /initemp
294!
295 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
296 CALL initemp_shell(elbuf_str,temp,nel,numnod,numelc,4,nixc,ixc)
297 END IF
298C------------
299 CALL cinmas(x,xrefc(1,1,nft+1),ixc,geo,pm,
300 . xmas,in,thke,ihbe,partsav,
301 . v,ipart(nft+1),msc(nft+1),inc(nft+1),area ,
302 . i8mi ,igeo ,etnod ,imat ,iprop,nshnod ,stc(nft+1),
303 . sh4tree ,mcp , mcps(nft+1) ,temp ,
304 . ms_layer, zi_layer,ms_layerc,zi_layerc,
305 . msz2c,zply,isubstack,nlay,elbuf_str,stack,
306 . gbuf%THK_I,rnoise ,drape ,glob_therm%NINTEMP,
307 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,
308 . idrape ,drapeg%INDX)
309C-----------------------------------------------
310 IF (mtn == 1 .OR. mtn == 91 .AND. npt/=1) npt = 0
311C---------------------------
312 CALL cderii(px1g,px2g,py1g,py2g,
313 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
314 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
315 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
316 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l )
317 CALL cndleni(pm ,geo ,stifn ,stifr ,ixc(1,nft+1),
318 . thke ,ihbe ,igeo ,sh4tree ,aldt ,
319 . bufmat ,ipm ,nlay ,stack%PM,isubstack,
320 . strc(nft+1),area ,imat ,iprop ,dtel ,
321 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l ,
322 . stack%IGEO ,group_param)
323 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thke,ksh4tree,sh4tree)
324c---------------------------
325 IF (ixfem > 0) THEN
326 DO ixel=1,nxel
327 CALL c1buf3(geo,xfem_str(ng,ixel)%GBUF%THK,
328 . xfem_str(ng,ixel)%GBUF%OFF,thke,ksh4tree,sh4tree)
329 DO i=lft,llt
330 xfem_str(ng,ixel)%GBUF%THK(i) = thke(i)
331 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
332 END DO
333 ENDDO
334 ENDIF
335c---------------------------
336 IF (mtn == 35) THEN
337 CALL cm35in3(elbuf_str,thke,area,nel,nlay,
338 . nptr,npts,nptt,igtyp)
339 ENDIF
340C
341 IF (( isigsh/=0 .OR. ithkshel == 2) .and. mpt>0) THEN
342 CALL layini1(
343 . elbuf_str ,lft ,llt ,geo ,igeo ,
344 . mat ,pid ,matly ,posly ,igtyp ,
345 . nlay ,mpt ,isubstack ,stack ,drape ,
346 . nft ,gbuf%THK ,nel ,idrape ,scdrape ,
347 . drapeg%INDX)
348 END IF
349c---------------------------
350c Loop over Gauss points
351c---------------------------
352 DO is = 1,npts
353 DO ir = 1,nptr
354 ipg = nptr*(is-1) + ir
355 ptf = (ipg-1)*lenf
356 ptm = (ipg-1)*lenm
357 pts = (ipg-1)*lens
358c
359
360 CALL cmaini3(elbuf_str,pm ,geo ,nel ,nlay ,
361 . skew ,igeo ,ixc(1,nft+1),nixc ,numelc ,
362 . nsigsh ,sigsh ,ptshel ,igtyp ,iorthloc ,
363 . ipm ,propid ,aldt ,mat_param,
364 . ir ,is ,isubstack,stack ,irep ,
365 . drape ,sh4ang(nft+1),geo_stack,igeo_stack,
366 . igmat ,imat ,iprop ,nummat,
367 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
368 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
369 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,x ,
370 . npt_all,idrape ,scdrape , drapeg%INDX)
371c
372 IF (( isigsh/=0 .OR. ithkshel == 2) .and. ihbe == 11) THEN
373 IF (mpt>0)
374 . CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
375 . nlay ,irep ,nel ,
376 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
377 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
378 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
379 . idrape, igtyp)
380 CALL csigini4(elbuf_str,ihbe ,
381 1 lft ,llt ,nft ,mpt ,istrain,
382 2 gbuf%THK ,gbuf%EINT,gbuf%STRPG(pts+1),gbuf%HOURG,
383 3 gbuf%FORPG(ptf+1),gbuf%MOMPG(ptm+1),sigsh ,nsigsh ,numelc ,
384 4 ixc ,nixc ,numshel ,ptshel ,igeo ,
385 5 ir ,is ,ipg ,npg ,gbuf%G_PLA,
386 6 gbuf%PLA,thke ,igtyp ,nel ,isigsh ,
387 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
388 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
389 IF (mpt == 0) THEN
390 DO i=lft,llt
391 gbuf%FORPG_G(ptf+i+jj(1:5))=gbuf%FORPG(ptf+i+jj(1:5))
392 END DO
393 END IF
394 IF (ithkshel == 2) THEN
395 DO i=lft,llt
396 gbuf%STRA(i+jj(1:8))=gbuf%STRA(i+jj(1:8))+
397 . fourth*gbuf%STRPG(pts+i+jj(1:8))
398 END DO
399 END IF
400 ELSEIF ( ithkshel == 1 .AND. ihbe == 11 ) THEN
401 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
402 2 gbuf%THK,thke ,ixc ,nixc ,nsigsh,
403 3 sigsh )
404 ENDIF
405c
406 IF (iuser == 1. and. mtn>=28 .AND. ihbe == 11) THEN
407 npg = 4
408 CALL cuserini4(elbuf_str,
409 1 lft ,llt ,nft ,nel ,istrain ,
410 2 sigsh ,nsigsh ,numelc,ixc ,nixc ,
411 3 numshel ,ptshel ,ir ,is ,npt ,
412 4 igtyp ,igeo ,nlay ,npg ,ipg )
413 ENDIF
414c
415 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87).AND. ihbe == 11) THEN
416 npg = 4
417 CALL cmatini4(elbuf_str,
418 1 lft ,llt ,nft ,nel ,istrain ,
419 2 sigsh ,nsigsh ,numelc,ixc ,nixc ,
420 3 numshel ,ptshel ,ir ,is ,npt ,
421 4 igtyp ,igeo ,nlay ,npg ,ipg )
422 ENDIF
423c
424 ENDDO ! IR = 1,NPTR
425 ENDDO ! IS = 1,NPTS
426c-----------------------------------------------------------------------
427c Failure model initialisation
428c-----------------------------------------------------------------------
429c set element damage initialized in /FAIL/FRACTAL_DMG
430 IF (fail_fractal%NFAIL > 0) THEN
431 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
432 . nummat ,numelc ,nel ,nft ,ngl ,ity )
433 ENDIF
434c tag edge elements in local UVAR for /FAIL/ALTER
435 IF (ifail > 0 .and. iddlevel == 1) THEN
436 CALL fail_windshield_init(elbuf_str,mat_param,fail_brokmann,
437 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
438 . aldt ,thke ,ngl )
439 ENDIF
440c
441 IF (ihbe == 11) THEN
442C to be checked for IGTYP = 51
443 CALL cfailini4(elbuf_str,nptr ,npts ,nptt ,nlay ,
444 . sigsh ,nsigsh ,ptshel ,rnoise ,perturb ,
445 . mat_param,aldt ,thke )
446 ELSEIF (ihbe > 20 .AND. ihbe < 29) THEN
447C to be checked for IGTYP = 51
448 CALL cfailini(elbuf_str,mat_param,
449 . nptt ,nlay ,sigsh ,nsigsh ,ptshel ,
450 . rnoise ,perturb ,aldt ,thke )
451 ENDIF
452c
453C-----------------------------------------------------------------------
454C CALCUL DES DEFORMATIONS INITIALES (MEMBRANE)
455c-----------------------------------------------------------------------
456 IF (ihbe > 20 .AND. ihbe < 29) THEN ! 1 Gauss Point
457c
458 ir = 1
459 is = 1
460 npg = 1
461c----
462 IF (istrain == 1 .AND. nxref > 0) THEN
463c REFERENCE STATE, QEPH
464c
465 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR !
466 CALL cnepsini(elbuf_str,mat_param(imat),
467 . lft ,llt ,ismstr ,mtn ,ithk ,
468 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
469 . nlay ,gbuf%FOR ,gbuf%THK,gbuf%EINT ,gbuf%STRA,
470 . px1g ,px2g ,py1g ,py2g ,x2s ,
471 . y2s ,x3s ,y3s ,x4s ,y4s ,
472 . gbuf%OFF ,uvar ,ipm ,imat ,
473 . igeo ,nel ,dir_a ,dir_b ,gbuf%SIGI,
474 . npf ,tf ,irep )
475c
476 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),
477 . gbuf%STRA,thke,nel ,cpt_eltens)
478 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
479 IF (mtn==58 .AND. npt_all==1) THEN
480C-------IINT to say NXREF > 0
481 iparg(36)=1
482 DO i=lft,llt
483 ii = nft + i
484 elbuf_str%GBUF%HOURG(jj(1)+i) = xrefc(2,1,ii)-xrefc(1,1,ii)
485 elbuf_str%GBUF%HOURG(jj(2)+i) = xrefc(2,2,ii)-xrefc(1,2,ii)
486 elbuf_str%GBUF%HOURG(jj(3)+i) = xrefc(2,3,ii)-xrefc(1,3,ii)
487 elbuf_str%GBUF%HOURG(jj(4)+i) = xrefc(3,1,ii)-xrefc(1,1,ii)
488 elbuf_str%GBUF%HOURG(jj(5)+i) = xrefc(3,2,ii)-xrefc(1,2,ii)
489 elbuf_str%GBUF%HOURG(jj(6)+i) = xrefc(3,3,ii)-xrefc(1,3,ii)
490 elbuf_str%GBUF%HOURG(jj(7)+i) = xrefc(4,1,ii)-xrefc(1,1,ii)
491 elbuf_str%GBUF%HOURG(jj(8)+i) = xrefc(4,2,ii)-xrefc(1,2,ii)
492 elbuf_str%GBUF%HOURG(jj(9)+i) = xrefc(4,3,ii)-xrefc(1,3,ii)
493 ENDDO
494 END IF
495c
496 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) ) THEN
497c
498 CALL csms11_ini(
499 . lft ,llt ,ixc(1,nft+1),x ,
500 . x2s,y2s,x3s,y3s,x4s,y4s)
501 ENDIF
502c----
503 IF (ismstr == 10 ) THEN
504 DO i=lft,llt
505 ii = nft + i
506 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
507 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
508 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
509 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
510 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
511 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
512 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
513 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
514 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
515 ENDDO
516 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) ) THEN
517 DO i=lft,llt
518 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
519 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
520 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
521 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
522 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
523 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
524 ENDDO
525 ENDIF
526c---
527 IF (isigsh/=0 .OR. ithkshel == 2) THEN
528 ipg = 0
529 IF (mpt>0)
530 . CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
531 . nlay ,irep ,nel ,
532 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
533 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
534 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
535 . idrape, igtyp)
536 CALL csigini4(elbuf_str,ihbe ,
537 1 lft ,llt ,nft ,mpt ,istrain,
538 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG,
539 3 gbuf%FOR,gbuf%MOM,sigsh ,nsigsh ,numelc ,
540 4 ixc ,nixc ,numshel ,ptshel ,igeo ,
541 5 ir ,is ,ipg ,npg ,gbuf%G_PLA,
542 6 gbuf%PLA,thke ,igtyp ,nel ,isigsh ,
543 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
544 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
545 IF (mpt == 0) THEN
546 DO i=lft,llt
547 gbuf%FOR_G(i+jj(1:5))=gbuf%FOR(i+jj(1:5))
548 END DO
549 END IF
550C--------to fill GBUF%STRPG
551 IF (ithkshel == 2.AND.gbuf%G_STRPG>gbuf%G_STRA)
552 1 CALL cstraini4(lft ,llt ,nft ,nel ,numshel,
553 2 istrain,gbuf%STRPG,sigsh ,nsigsh ,numelc ,
554 4 ixc ,nixc ,ptshel ,thke ,gbuf%STRA,
555 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
556 8 e1z ,e2z ,e3z )
557 ELSEIF ( ithkshel == 1 ) THEN
558 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
559 2 gbuf%THK,thke ,ixc ,nixc ,nsigsh,
560 3 sigsh )
561 ENDIF
562 IF (iuser == 1 .AND. mtn >= 29) THEN
563 CALL cuserini(elbuf_str,
564 1 lft ,llt ,nft ,nel , npt ,
565 2 istrain,sigsh ,numelc ,ixc ,nixc ,
566 3 nsigsh ,numshel,ptshel ,ir ,is ,
567 4 nlay )
568 ENDIF
569C-----
570 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87)) THEN
571 CALL cmatini(elbuf_str,
572 1 lft ,llt ,nft ,nel , npt ,
573 2 istrain,sigsh ,numelc ,ixc ,nixc ,
574 3 nsigsh ,numshel,ptshel ,ir ,is ,
575 4 nlay )
576 ENDIF
577c
578c-----
579 ELSEIF (ihbe == 11) THEN ! Batoz, NPG = 4
580c-----
581c
582 IF (istrain == 1 .AND. nxref > 0) THEN
583c REFERENCE STATE, Batoz
584c
585 ir = 1
586 is = 1
587c using only one pt, suppose constant
588 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR ! loi 58 => nlay=1
589c
590 CALL cnepsini(elbuf_str,mat_param(imat),
591 . lft ,llt ,ismstr ,mtn ,ithk ,
592 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
593 . nlay ,gbuf%FOR ,gbuf%THK ,gbuf%EINT,gbuf%STRA ,
594 . px1g ,px2g ,py1g ,py2g ,x2s ,
595 . y2s ,x3s ,y3s ,x4s ,y4s ,
596 . gbuf%OFF,uvar ,ipm ,imat ,
597 . igeo ,nel ,dir_a ,dir_b ,gbuf%SIGI ,
598 . npf ,tf ,irep )
599c
600 IF (ismstr /= 4) THEN
601 DO i=lft,llt
602 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
603 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
604 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
605 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
606 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
607 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
608 ENDDO
609 ENDIF
610c
611 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),
612 . gbuf%STRA,thke,nel ,cpt_eltens)
613 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
614c-----------------------------------------------------------
615 DO is =1,npts
616 DO ir =1,nptr
617 ipg = nptr*(is-1) + ir
618 ptf = (ipg-1)*lenf
619 ptm = (ipg-1)*lenm
620 pts = (ipg-1)*lens
621 DO i=lft,llt
622 gbuf%FORPG(ptf+jj(1)+i) = gbuf%FOR(jj(1)+i)
623 gbuf%FORPG(ptf+jj(2)+i) = gbuf%FOR(jj(2)+i)
624 gbuf%FORPG(ptf+jj(3)+i) = gbuf%FOR(jj(3)+i)
625!
626 gbuf%MOMPG(ptm+jj(1)+i) = gbuf%MOM(jj(1)+i)
627 gbuf%MOMPG(ptm+jj(2)+i) = gbuf%MOM(jj(2)+i)
628 gbuf%MOMPG(ptm+jj(3)+i) = gbuf%MOM(jj(3)+i)
629!
630 gbuf%STRPG(pts+jj(1)+i) = gbuf%STRA(jj(1)+i)
631 gbuf%STRPG(pts+jj(2)+i) = gbuf%STRA(jj(2)+i)
632 gbuf%STRPG(pts+jj(3)+i) = gbuf%STRA(jj(3)+i)
633 ENDDO
634 DO j=1,nlay
635 IF (elbuf_str%BUFLY(j)%ILAW == 58) THEN
636 DO k = 1,elbuf_str%BUFLY(j)%NPTT
637 uvar => elbuf_str%BUFLY(j)%MAT(ir,is,k)%VAR
638 nuvar = elbuf_str%BUFLY(j)%NVAR_MAT
639 DO i=1,nel*nuvar
640 uvar(i) = elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR(i)
641 ENDDO
642 ENDDO
643 END IF
644 ENDDO
645 ENDDO ! DO IR =1,NPTR
646 ENDDO ! DO IS =1,NPTS
647C
648C---------- ISMSTR == 10 in global system :9 + 9 place + 3
649 ELSEIF (ismstr == 10 ) THEN
650 DO i=lft,llt
651 ii = nft + i
652 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
653 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
654 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
655 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
656 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
657 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
658 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
659 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
660 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
661 ENDDO
662 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) ) THEN
663C to be checked for IGTYP = 51
664 CALL csms11_ini(
665 . lft ,llt ,ixc(1,nft+1),x ,x2s ,
666 . y2s ,x3s ,y3s ,x4s ,y4s )
667 DO i=lft,llt
668 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
669 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
670 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
671 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
672 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
673 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
674 ENDDO
675 ENDIF
676c
677 ENDIF ! IHBE
678C-------------------------------------------
679c calculation of elementary dt
680C-------------------------------------------
681 IF (igtyp /= 1 .AND. igtyp /= 7 .AND.
682 . igtyp /= 9 .AND. igtyp /= 10 .AND.
683 . igtyp /= 11 .AND. igtyp /= 0 .AND.
684 . igtyp /= 16 .AND. igtyp /= 17 .AND.
685 . igtyp /= 51 .AND. igtyp /= 52 ) THEN
686 CALL ancmsg(msgid=25,
687 . anmode=aninfo,
688 . msgtype=msgerror,
689 . i1=propid,
690 . c1=titr,
691 . i2=iprop)
692 ENDIF
693 ndepar=numels+nft
694 DO i=lft,llt
695c IGTYP = GEO(12,IXC(6,I+NFT))
696 dtelem(ndepar+i) = dtel(i)
697 END DO
698c-----------
699 IF (ixfem > 0) THEN
700 CALL cbufxfe(elbuf_str,xfem_str ,isubstack,stack ,
701 . igeo ,geo ,lft ,llt ,mat ,
702 . pid ,npt ,nptt ,nlay ,ir ,
703 . is ,ixfem ,mtn ,ng)
704 ENDIF
705C------------
706 ! Compute the initial volume
707 DO i=lft,llt
708 IF (gbuf%G_VOL > 0) gbuf%VOL(i) = area(i)*gbuf%THK(i)
709 ENDDO
710 IF (ixfem > 0) THEN
711 DO ixel=1,nxel
712 DO i=lft,llt
713 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
714 . xfem_str(ng,ixel)%GBUF%VOL(i) = area(i)*gbuf%THK(i)
715 END DO
716 ENDDO
717 ENDIF
718c-----------
719 DEALLOCATE(dir_a)
720 DEALLOCATE(dir_b)
721 DEALLOCATE(matly)
722 DEALLOCATE(posly)
723
724 RETURN
c1buf3
subroutine c1buf3(geo, thk, off, thke, kshtree, shtree)
Definition c1buf3.F:32
cbufxfe
subroutine cbufxfe(elbuf_str, xfem_str, isubstack, stack, igeo, geo, lft, llt, mat, pid, npt, nptt, nlay, ir, is, ixfem, mtn, ng)
Definition cbufxfe.F:39
ccoori
subroutine ccoori(x, xrefc, ixc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, ix1, ix2, ix3, ix4, ngl)
Definition ccoori.F:40
cderii
subroutine cderii(px1, px2, py1, py2, x1g, x2g, x3g, x4g, y1g, y2g, y3g, y4g, z1g, z2g, z3g, z4g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x2l, x3l, x4l, y2l, y3l, y4l)
Definition cderii.F:35
cepschk
subroutine cepschk(jft, jlt, nft, pm, geo, ixc, gstr, thk, nel, cpt_eltens)
Definition cepsini.F:829
cfailini
subroutine cfailini(elbuf_str, mat_param, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, aldt, thk)
Definition cfailini.F:36
cfailini4
subroutine cfailini4(elbuf_str, nptr, npts, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, mat_param, aldt, thk)
Definition cfailini.F:182
csms11_ini
subroutine csms11_ini(jft, jlt, ixc, x, x2s, y2s, x3s, y3s, x4s, y4s)
Definition cinit3.F:671
cinmas
subroutine cinmas(x, xrefc, ix, geo, pm, ms, tiner, thke, ihbe, partsav, v, ipart, msc, inc, area, i8mi, igeo, etnod, imid, iprop, nshnod, stc, sh4tree, mcp, mcps, temp, ms_layer, zi_layer, ms_layerc, zi_layerc, msz2c, zply, isubstack, nlay, elbuf_str, stack, thki, rnoise, drape, nintemp, perturb, ix1, ix2, ix3, ix4, idrape, indx)
Definition cinmas.F:95
cm35in3
subroutine cm35in3(elbuf_str, thk, area, nel, nlay, nptr, npts, nptt, igtyp)
Definition cm35in3.F:34
cmaini3
subroutine cmaini3(elbuf_str, pm, geo, nel, nlay, skew, igeo, ix, nix, numel, nsigsh, sigsh, ptsh, igtyp, iorthloc, ipm, propid, aldt, mat_param, ir, is, isubstack, stack, irep, drape, shang, geo_stack, igeo_stack, igmat, imat, iprop, nummat, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x, npt_all, idrape, numel_drape, indx)
Definition cmaini3.F:53
cmatini4
subroutine cmatini4(elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)
Definition cmatini4.F:39
cmatini
subroutine cmatini(elbuf_str, jft, jlt, nft, nel, npt, istrain, sigsh, numel, ix, nix, nsigsh, numsh, ptsh, ir, is, nlay)
Definition cmatini.F:36
cndleni
subroutine cndleni(pm, geo, stifn, stifr, ixc, thk, ihbe, igeo, sh4tree, aldt, uparam, ipm, nlay, pm_stack, isubstack, strc, area, imat, iprop, dtel, x2l, x3l, x4l, y2l, y3l, y4l, igeo_stack, group_param)
Definition cndleni.F:35
cnepsini
subroutine cnepsini(elbuf_str, mat_param, jft, jlt, ismstr, mtn, ithk, pm, geo, ixc, x, xrefc, nlay, for, thk, eint, gstr, px1g, px2g, py1g, py2g, x2s, y2s, x3s, y3s, x4s, y4s, off, uvar, ipm, imat, igeo, nel, dir_a, dir_b, sigi, npf, tf, irep)
Definition cnepsini.F:44
cneveci
subroutine cneveci(jft, jlt, area, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cneveci.F:36
corth3
subroutine corth3(elbuf_str, dir_a, dir_b, jft, jlt, nlay, irep, nel, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, idrape, igtyp)
Definition corth3.F:42
my_real
#define my_real
Definition cppsort.cpp:32
cstraini4
subroutine cstraini4(jft, jlt, nft, nel, numshel, istrain, gstr, sigsh, nsigsh, numel, ix, nix, ptsh, thke, gstrm, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cstraini4.F:39
cuserini4
subroutine cuserini4(elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)
Definition cuserini4.F:39
cuserini
subroutine cuserini(elbuf_str, jft, jlt, nft, nel, npt, istrain, sigsh, numel, ix, nix, nsigsh, numsh, ptsh, ir, is, nlay)
Definition cuserini.F:36
cveok3
subroutine cveok3(nvc, nod, ix1, ix2, ix3, ix4)
Definition cveok3.F:35
dtel
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
Definition dtel.F:46
fail_brokmann
subroutine fail_brokmann(nel, nuparam, nuvar, time, timestep, uparam, ngl, signxx, signyy, signxy, uvar, off, ipt, nindxf, indxf, tdel)
Definition fail_brokmann.F:37
fail_windshield_init
subroutine fail_windshield_init(elbuf_str, mat_param, fail_brokmann, nel, nft, ity, igrsh4n, igrsh3n, aldt, thk, ngl)
Definition fail_windshield_init.F:40
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
layini1
subroutine layini1(elbuf_str, jft, jlt, geo, igeo, mat, pid, matly, posly, igtyp, nlay, npt, isubstack, stack, drape, nft, thk, nel, idrape, numel_drape, indx)
Definition layini1.F:40
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
drape_mod::scdrape
integer scdrape
Definition drape_mod.F:92
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
stack_mod
Definition stack_mod.F:75
csigini4
subroutine csigini4(elbuf_str, ihbe, jft, jlt, nft, npt, istrain, thk, eint, gstr, hh, for, mom, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, igeo, ir, is, ipg, npg, g_pla, epsp, thke, igtyp, nel, isigsh, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, dir_a, dir_b, posly)
Definition scigini4.F:47
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
thickini
subroutine thickini(jft, jlt, nft, ptsh, numel, thk, thke, ix, nix, nsigsh, sigsh)
Definition thickini.F:36