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