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

Go to the source code of this file.

Functions/Subroutines

subroutine cinit3 (elbuf_str, ixc, pm, x, geo, xmas, in, nvc, dtelem, igrsh4n, xrefc, nel, ithk, ihbe, igrsh3n, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, msc, inc, skew, iparg, i8mi, nsigsh, igeo, iuser, etnod, nshnod, stc, ptshel, ipm, bufmat, sh4tree, mcp, mcps, temp, cpt_eltens, part_area, itagn, itage, ixfem, npf, tf, xfem_str, isubstack, stack, rnoise, drape, sh4ang, iddlevel, geo_stack, igeo_stack, strc, perturb, iyldini, ele_area, ng, group_param, nloc_dmg, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
subroutine csms11_ini (jft, jlt, ixc, x, x2s, y2s, x3s, y3s, x4s, y4s)

Function/Subroutine Documentation

◆ cinit3()

subroutine cinit3 ( 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,
thk,
integer isigsh,
sigsh,
stifn,
stifr,
partsav,
v,
integer, dimension(*) ipart,
msc,
inc,
skew,
integer, dimension(*) iparg,
integer *8, dimension(6,*) i8mi,
integer nsigsh,
integer, dimension(npropgi,*) igeo,
integer iuser,
etnod,
integer, dimension(*) nshnod,
stc,
integer, dimension(*) ptshel,
integer, dimension(npropmi,*) ipm,
bufmat,
integer, dimension(*) sh4tree,
mcp,
mcps,
temp,
integer cpt_eltens,
part_area,
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,
integer ng,
type (group_param_) group_param,
type (nlocal_str_) nloc_dmg,
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 cinit3.F.

79C-----------------------------------------------
80C M o d u l e s
81C-----------------------------------------------
82 USE my_alloc_mod
83 USE elbufdef_mod
84 USE message_mod
85 USE stack_mod
86 USE groupdef_mod
87 USE group_param_mod
88 USE nlocal_reg_mod
89 USE drape_mod
90 USE matparam_def_mod
91 USE random_walk_def_mod
92 USE fractal_dmg_init_mod
93 USE names_and_titles_mod , ONLY : nchartitle
94 use brokmann_random_def_mod
95 use glob_therm_mod
96 use initemp_shell_mod
97C-----------------------------------------------
98C I m p l i c i t T y p e s
99C-----------------------------------------------
100#include "implicit_f.inc"
101C-----------------------------------------------
102C G l o b a l P a r a m e t e r s
103C-----------------------------------------------
104#include "mvsiz_p.inc"
105C-----------------------------------------------
106C C o m m o n B l o c k s
107C-----------------------------------------------
108#include "vect01_c.inc"
109#include "param_c.inc"
110#include "com01_c.inc"
111#include "com04_c.inc"
112#include "scr03_c.inc"
113#include "scr17_c.inc"
114#include "scry_c.inc"
115#include "com_xfem1.inc"
116C-----------------------------------------------
117C D u m m y A r g u m e n t s
118C-----------------------------------------------
119 INTEGER NVC,NEL,ITHK,IHBE,ISIGSH,IXFEM,NSIGSH,IUSER,IYLDINI
120 INTEGER IXC(NIXC,*),IPART(*),IPARG(*),IGEO(NPROPGI,*), NSHNOD(*),
121 . PTSHEL(*),IPM(NPROPMI,*), SH4TREE(*),ITAGN(*),ITAGE(*),NPF(*),
122 . ISUBSTACK,IGEO_STACK(*),PERTURB(NPERTURB),NG,IDRAPE
123 INTEGER *8 I8MI(6,*)
124 INTEGER ,INTENT(IN) :: IDDLEVEL
125 my_real
126 . pm(npropm,*), x(3,*), geo(npropg,*), xmas(*), in(*),
127 . dtelem(*), xrefc(4,3,*),thk(*), sigsh(nsigsh,*),
128 . stifn(*),stifr(*),partsav(20,*), v(*) ,msc(*) ,inc(*),
129 . skew(lskew,*), etnod(*), stc(*),bufmat(*),mcp(*),mcps(*),
130 . temp(*),part_area(*),tf(*),rnoise(*),
131 . sh4ang(*),geo_stack(*),strc(*),ele_area(*)
132 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
133 TYPE(ELBUF_STRUCT_), TARGET ,DIMENSION(NGROUP,*):: XFEM_STR
134 ! when XFEM is ON, XFEM_STR's dimension = NGROUP,NXEL
135 TYPE (STACK_PLY) :: STACK
136 TYPE (GROUP_PARAM_) :: GROUP_PARAM
137 TYPE (NLOCAL_STR_) :: NLOC_DMG
138 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
139 TYPE (DRAPEG_) :: DRAPEG
140 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
141 TYPE (FAIL_FRACTAL_) ,INTENT(IN) :: FAIL_FRACTAL
142 TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
143 TYPE (glob_therm_) ,intent(in) :: glob_therm
144C-----------------------------------------------
145 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
146 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
147C-----------------------------------------------
148C L o c a l V a r i a b l e s
149C-----------------------------------------------
150 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
151 INTEGER I,J,N,IP,NDEPAR,IGTYP,NUVAR,ID,NLAY,II,IREP,IPROP,NUPARAM,
152 . IL,IR,IS,IT,CPT_ELTENS,IUN,NPTR,NPTS,NPTT,IXEL,ILAW,IMAT,IFAIL,
153 . IGMAT,JJ(9),NPT_ALL,MPT,LAYNPT_MAX,LAY_MAX
154 INTEGER, DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,IORTHLOC,MAT,PID,NGL
155 my_real :: bid
156 my_real, DIMENSION(MVSIZ) :: px1g,px2g,py1g,py2g,area,aldt,
157 . dt,vx,vy,vz,
158 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
159 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
160 . x2s,y2s,x3s,y3s,x4s,y4s,
161 . x2l,x3l,x4l,y2l,y3l,y4l
162 my_real, DIMENSION(NEL) :: tempel
163 my_real, DIMENSION(:) ,POINTER :: uvar,dir1,dir2
164 my_real, ALLOCATABLE, DIMENSION(:) :: dir_a,dir_b
165 my_real, DIMENSION(:), ALLOCATABLE :: phi1,phi2,coor1,coor2,coor3,coor4
166 parameter(laynpt_max = 10)
167 parameter(lay_max = 100)
168 INTEGER, DIMENSION(:),ALLOCATABLE :: MATLY
169 my_real, DIMENSION(:,:),ALLOCATABLE :: posly
170
171 TYPE(G_BUFEL_) ,POINTER :: GBUF
172 TYPE(L_BUFEL_) ,POINTER :: LBUF
173C=======================================================================
174 CALL my_alloc(matly,mvsiz*lay_max)
175 CALL my_alloc(posly,mvsiz,lay_max*laynpt_max)
176 gbuf => elbuf_str%GBUF
177c
178 imat = ixc(1,1+nft) ! mat N
179 iprop = ixc(nixc-1,1+nft) ! property N
180 igtyp = igeo(11,iprop)
181 id = igeo(1,iprop)
182 igmat = igeo(98,ixc(6,1+nft))
183 irep = iparg(35)
184 ifail = iparg(43)
185c
186 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr)
187 vx = zero
188 vy = zero
189 vz = zero
190 iorthloc = 0
191 bid = zero
192C
193 iun = 1
194 ir = 1
195 is = 1
196 nlay = elbuf_str%NLAY
197 nxel = elbuf_str%NXEL
198 nptt = elbuf_str%NPTT
199 idrape = elbuf_str%IDRAPE
200 npt_all = 0
201 DO il=1,nlay
202 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
203 ENDDO
204 mpt = max(1,npt_all)
205 IF(npt_all == 0 ) npt_all = nlay
206C----- NPT=0 for some cases
207 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0) THEN
208 ALLOCATE(phi1(mvsiz*npt_all))
209 ALLOCATE(phi2(nvsiz*npt_all))
210 ALLOCATE(dir_a(npt_all*nel*2))
211 ALLOCATE(dir_b(npt_all*nel*2))
212 phi1 = zero
213 phi2 = zero
214 dir_a = zero
215 dir_b = zero
216 ALLOCATE(coor1(npt_all*mvsiz))
217 ALLOCATE(coor2(npt_all*mvsiz))
218 ALLOCATE(coor3(npt_all*mvsiz))
219 ALLOCATE(coor4(npt_all*mvsiz))
220 coor1 = zero
221 coor2 = zero
222 coor3 = zero
223 coor4 = zero
224 ELSE
225 ALLOCATE(phi1(nlay*mvsiz))
226 ALLOCATE(phi2(nlay*mvsiz))
227 ALLOCATE(dir_a(nlay*nel*2))
228 ALLOCATE(dir_b(nlay*nel*2))
229 phi1 = zero
230 phi2 = zero
231 dir_a = zero
232 dir_b = zero
233 ALLOCATE(coor1(nlay*mvsiz))
234 ALLOCATE(coor2(nlay*mvsiz))
235 ALLOCATE(coor3(nlay*mvsiz))
236 ALLOCATE(coor4(nlay*mvsiz))
237 coor1 = zero
238 coor2 = zero
239 coor3 = zero
240 coor4 = zero
241 npt_all = nlay
242 ENDIF
243C
244 IF (iparg(6) == 0.OR.npt==0) mpt=0
245C
246 DO j=1,9
247 jj(j) = nel*(j-1)
248 ENDDO
249C
250 DO i=lft,llt
251 n = i+nft
252 mat(i) = ixc(1,n)
253 pid(i) = ixc(6,n)
254 ENDDO
255C
256 IF (ixfem > 0) THEN
257 DO i=lft,llt
258 n = i+nft
259 itagn(ixc(2,n)) =1
260 itagn(ixc(3,n)) =1
261 itagn(ixc(4,n)) =1
262 itagn(ixc(5,n)) =1
263 itage(n) = 1
264 ENDDO
265 ENDIF
266C
267 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
268 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
269 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
270 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
271c
272 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
273c--------------------------------------
274 CALL ceveci(lft,llt ,area,
275 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
276 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
277 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
278c
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 ip = ipart(i+nft)
285C PART_AREA(IP) = PART_AREA(IP) + AREA(I)
286 ele_area(i+nft) = area(i)
287 IF (gbuf%G_AREA > 0) gbuf%AREA(i) = area(i)
288 ENDDO
289 ENDIF
290!
291! Initialize element temperature from /initemp
292!
293 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
294 CALL initemp_shell(elbuf_str,temp,nel,numnod,numelc,4,nixc,ixc)
295 END IF
296C------------
297 CALL cinmas(x ,xrefc(1,1,nft+1),ixc ,geo ,pm,
298 . xmas ,in ,thk ,ihbe ,partsav,
299 . v ,ipart(nft+1) ,msc(nft+1),inc(nft+1) ,area ,
300 . i8mi ,igeo ,etnod ,imat ,iprop ,
301 . nshnod ,stc(nft+1) ,sh4tree ,mcp ,mcps(nft+1),
302 . temp ,bid ,bid ,bid ,bid,
303 . bid ,bid ,isubstack ,nlay ,elbuf_str,
304 . stack ,gbuf%THK_I ,rnoise ,drape ,glob_therm%NINTEMP,
305 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,
306 . idrape ,drapeg%INDX)
307C-----------------------------------------------
308 CALL cderii(px1g,px2g,py1g,py2g,
309 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
310 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
311 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
312 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l )
313 CALL cdleni(pm ,geo ,stifn ,stifr ,ixc(1,nft+1),
314 . px1g ,px2g ,py1g ,py2g ,thk ,
315 . igeo ,dt ,sh4tree ,aldt ,bufmat ,
316 . ipm ,nlay ,stack%PM,isubstack,strc(nft+1),
317 . area ,imat ,iprop ,
318 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l ,
319 . stack%IGEO,group_param)
320 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh4tree,sh4tree)
321C-----------------------------------------------
322 IF (ixfem > 0) THEN
323 DO ixel=1,nxel
324 DO i=lft,llt
325 xfem_str(ng,ixel)%GBUF%THK(i) = thk(i)
326 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
327 END DO
328 ENDDO
329 ENDIF
330C-----------------------------------------------------------------------
331c PHI, COOR used only with dimension(NLAY,MVSIZ); !! now corrected
332 CALL corthini(
333 . lft ,llt ,nft ,nlay ,numelc ,
334 . nsigsh ,nixc ,ixc(1,nft+1),igeo ,geo ,
335 . skew ,sigsh ,ptshel ,phi1 ,phi2 ,
336 . vx ,vy ,vz ,coor1 ,coor2 ,
337 . coor3 ,coor4 ,iorthloc ,isubstack ,stack ,
338 . irep ,elbuf_str ,drape ,sh4ang(nft+1),x ,
339 . geo_stack ,e3x ,e3y ,e3z ,
340 . gbuf%BETAORTH,x1 ,x2 ,y1 ,y2 ,
341 . z1 ,z2 ,nel ,gbuf%G_ADD_NODE,gbuf%ADD_NODE,
342 . npt_all ,idrape ,drapeg%INDX)
343c---
344C-----
345 IF(igtyp == 51 .OR. igtyp == 52 .AND. igmat > 0) THEN
346c
347 CALL corthdir(elbuf_str,
348 . igeo ,geo ,vx ,vy ,vz ,
349 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
350 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
351 . stack ,geo_stack ,igeo_stack ,ir ,is ,
352 . nel ,imat ,iprop ,
353 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
354 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
355 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
356 . npt_all ,idrape)
357c
358 ELSEIF (mtn == 27) THEN
359 CALL cm27in3(elbuf_str,
360 . geo ,igeo ,pm ,ipm ,ixc(1,1+nft) ,nixc,
361 . nlay,ir ,is ,imat )
362 ELSEIF (mtn == 35) THEN
363 nptr = elbuf_str%NPTR
364 npts = elbuf_str%NPTS
365 nptt = elbuf_str%NPTT
366 CALL cm35in3(elbuf_str,thk,area,nel,nlay,
367 . nptr,npts,nptt,igtyp)
368 ELSEIF (mtn==15 .or. mtn==19 .or. mtn==25 .or. mtn>=28) THEN
369 IF (mtn == 19 .AND. igtyp /= 9) THEN
370 CALL ancmsg(msgid=5,
371 . anmode=aninfo,
372 . msgtype=msgerror,
373 . i1=igeo(1,ixc(nixc-1,nft+1)))
374 ENDIF
375c
376 CALL corthdir(elbuf_str,
377 . igeo ,geo ,vx ,vy ,vz ,
378 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
379 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
380 . stack ,geo_stack ,igeo_stack ,ir ,is ,
381 . nel ,imat ,iprop ,
382 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
383 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
384 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z ,
385 . npt_all ,idrape)
386 ENDIF
387c
388 IF ((mtn == 58 .or. mtn == 158) .AND.
389 . igtyp /= 16 .AND. igtyp /= 51 .AND. igtyp /= 52) THEN
390 CALL ancmsg(msgid=658,
391 . msgtype=msgerror,
392 . anmode=aninfo_blind_1,
393 . i1=id,
394 . c1=titr,
395 . i2=mtn,
396 . i3=igtyp)
397 ELSEIF (mtn == 58 .or. mtn == 158 .OR. igtyp == 51 .OR. igtyp == 52) THEN
398C
399 IF (idrape == 0) THEN
400 DO il = 1,nlay
401 nptt = elbuf_str%BUFLY(il)%NPTT
402 imat = elbuf_str%BUFLY(il)%IMAT
403 ilaw = elbuf_str%BUFLY(il)%ILAW
404 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
405 dir1 => elbuf_str%BUFLY(il)%DIRA
406 dir2 => elbuf_str%BUFLY(il)%DIRB
407 nuparam = mat_param(imat)%NUPARAM
408!
409 IF (ilaw == 58) THEN
410 DO it=1,nptt
411 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
412 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
413 CALL cm58in3(
414 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
415 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
416 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
417 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
418 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
419 ENDDO
420 ELSE IF (ilaw == 158) THEN
421 DO it=1,nptt
422 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
423 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
424 CALL law158_init(dir1 ,dir2 ,
425 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
426 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
427 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
428 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
429 ENDDO
430 ENDIF ! IF (ILAW == 58) THEN
431 ENDDO ! DO IL = 1,NLAY
432 ELSE
433 DO il = 1,nlay
434 nptt = elbuf_str%BUFLY(il)%NPTT
435 imat = elbuf_str%BUFLY(il)%IMAT
436 ilaw = elbuf_str%BUFLY(il)%ILAW
437 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
438 nuparam = mat_param(imat)%NUPARAM
439!
440 IF (ilaw == 58) THEN
441 DO it=1,nptt
442 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
443 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
444 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
445 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
446 CALL cm58in3(
447 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
448 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
449 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
450 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
451 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
452 ENDDO
453 ELSE IF (ilaw == 158) THEN
454 DO it=1,nptt
455 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
456 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
457 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
458 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
459 CALL law158_init(dir1 ,dir2 ,
460 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
461 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
462 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
463 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
464 ENDDO
465 ENDIF ! IF (ILAW == 58) THEN
466 ENDDO ! DO IL = 1,NLAY
467 ENDIF
468 ENDIF
469C-----------------------------------------------------------------------
470C CALCUL DES CONTRAINTES INITIALES
471C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
472 IF (isigsh/=0 .OR. ithkshel == 2) THEN
473C to be checked for IGTYP = 51 : ok
474 IF (mpt > 0) THEN
475 CALL layini1(
476 . elbuf_str ,lft ,llt ,geo ,igeo ,
477 . mat ,pid ,matly ,posly ,igtyp ,
478 . nlay ,mpt ,isubstack ,stack ,drape ,
479 . nft ,gbuf%THK ,nel ,idrape ,scdrape ,
480 . drapeg%INDX)
481 CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
482 . nlay ,irep ,nel ,
483 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
484 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
485 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
486 . idrape, igtyp )
487 END IF
488
489 CALL csigini(elbuf_str ,
490 1 lft ,llt ,nft ,mpt ,istrain ,
491 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG,gbuf%PLA ,
492 3 gbuf%FOR,gbuf%MOM ,sigsh ,nlay ,gbuf%G_HOURG,
493 4 numelc ,ixc ,nixc ,nsigsh ,numshel ,
494 5 ptshel ,igeo ,thk ,nel ,e1x ,
495 6 e2x ,e3x ,e1y ,e2y ,e3y ,
496 7 e1z ,e2z ,e3z ,isigsh ,dir_a ,
497 8 dir_b ,posly ,igtyp )
498 ELSEIF ( ithkshel == 1 ) THEN
499 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
500 2 gbuf%THK,thk ,ixc ,nixc ,nsigsh,
501 3 sigsh )
502 ENDIF
503C-----------------------------------------------------------------------
504C CALCUL DES DEFORMATIONS INITIALES (MEMBRANE)
505C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
506 IF (istrain == 1 .AND. nxref > 0) THEN
507 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
508 imat = elbuf_str%BUFLY(1)%IMAT
509 CALL cepsini(elbuf_str ,mat_param(imat),
510 . lft ,llt ,ismstr ,mtn ,ithk ,
511 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
512 . gbuf%FOR ,gbuf%THK ,gbuf%EINT ,gbuf%STRA ,nlay ,
513 . px1g ,px2g ,py1g ,py2g ,x2s ,
514 . y2s ,x3s ,y3s ,x4s ,y4s ,
515 . uvar ,ipm ,igeo ,imat ,
516 . skew ,nel ,dir_a ,dir_b ,gbuf%SIGI,
517 . npf ,tf ,irep )
518c
519 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),gbuf%STRA,thk,
520 . nel,cpt_eltens)
521 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
522c
523 ELSEIF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19)) THEN
524C to be checked for IGTYP = 51
525 CALL csms11_ini(lft ,llt ,ixc(1,nft+1),x ,
526 . x2s ,y2s ,x3s ,y3s ,x4s ,y4s )
527 ENDIF
528c----------------------------
529 IF (ismstr == 10 ) THEN
530 DO i=lft,llt
531 ii = nft + i
532 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
533 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
534 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
535 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
536 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
537 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
538 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
539 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
540 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
541 ENDDO
542 ELSEIF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19)) THEN
543 DO i=lft,llt
544 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
545 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
546 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
547 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
548 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
549 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
550 ENDDO
551 ENDIF
552C-----
553 IF (iuser == 1 .AND. mtn > 28) THEN
554C to be checked for IGTYP = 51
555 CALL cuserini(elbuf_str,
556 1 lft ,llt ,nft ,nel ,npt ,
557 2 istrain,sigsh ,numelc ,ixc ,nixc ,
558 3 nsigsh ,numshel,ptshel ,iun ,iun ,
559 4 nlay )
560 ENDIF
561
562 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87))THEN
563 CALL cmatini(elbuf_str,
564 1 lft ,llt ,nft ,nel ,npt ,
565 2 istrain,sigsh ,numelc ,ixc ,nixc ,
566 3 nsigsh ,numshel,ptshel ,iun ,iun ,
567 4 nlay )
568 ENDIF
569
570c-----------------------------------------------------------------------
571c Failure model initialisation
572c-----------------------------------------------------------------------
573c set element damage initialized in /FAIL/FRACTAL_DMG
574 IF (fail_fractal%NFAIL > 0) THEN
575 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
576 . nummat ,numelc ,nel ,nft ,ngl ,ity )
577 ENDIF
578c tag edge elements in local UVAR for /FAIL/ALTER (XFEM)
579 IF (ifail > 0 .and. iddlevel == 1) THEN
580 CALL fail_windshield_init(elbuf_str,mat_param,fail_brokmann,
581 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
582 . aldt ,thk ,ngl )
583 ENDIF
584C to be checked for IGTYP = 51
585 CALL cfailini(elbuf_str,mat_param,
586 . nptt ,nlay ,sigsh ,nsigsh ,ptshel ,
587 . rnoise ,perturb ,aldt ,thk )
588C-------------------------------------------
589C CALCUL DES DT ELEMENTAIRES
590C-------------------------------------------
591c IGTYP=GEO(12,IXC(6,I+NFT))
592 IF (igtyp /= 0 .AND. igtyp /= 1 .AND.
593 . igtyp /= 9 .AND. igtyp /= 10 .AND.
594 . igtyp /= 11 .AND. igtyp /= 16 .AND.
595 . igtyp /= 17 .AND. igtyp /= 51 .AND.
596 . igtyp /= 52) THEN
597 CALL ancmsg(msgid=25,
598 . anmode=aninfo,
599 . msgtype=msgerror,
600 . i1=id,
601 . c1=titr,
602 . i2=iprop)
603 ENDIF
604 ndepar=numels+nft
605 DO i=lft,llt
606 dtelem(ndepar+i)=dt(i)
607 ENDDO
608C---
609 IF (ixfem > 0) THEN
610 CALL cbufxfe(elbuf_str,xfem_str,isubstack,stack ,
611 . igeo ,geo ,lft ,llt ,mat,
612 . pid ,npt ,nptt ,nlay,ir ,
613 . is ,ixfem,mtn ,ng)
614 ENDIF
615C------------
616 ! Compute the initial volume
617 DO i=lft,llt
618 IF (gbuf%G_VOL > 0) gbuf%VOL(i) = area(i)*gbuf%THK(i)
619 ENDDO
620 IF (ixfem > 0) THEN
621 DO ixel=1,nxel
622 DO i=lft,llt
623 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
624 . xfem_str(ng,ixel)%GBUF%VOL(i) = area(i)*gbuf%THK(i)
625 END DO
626 ENDDO
627 ENDIF
628C---
629 IF (ALLOCATED(dir_b)) DEALLOCATE(dir_b)
630 IF (ALLOCATED(dir_a)) DEALLOCATE(dir_a)
631 DEALLOCATE(phi1,phi2,coor1,coor2,coor3,coor4)
632 DEALLOCATE(matly)
633 DEALLOCATE(posly)
634C-----------------------------
635 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
cdleni
subroutine cdleni(pm, geo, stifn, stifr, ixc, px1, px2, py1, py2, thk, igeo, dt, sh4tree, aldt, uparam, ipm, nlay, pm_stack, isubstack, strc, area, imat, iprop, x2l, x3l, x4l, y2l, y3l, y4l, igeo_stack, group_param)
Definition cdleni.F:36
cepsini
subroutine cepsini(elbuf_str, mat_param, jft, jlt, ismstr, ilaw, ithk, pm, geo, ixc, x, xrefc, for, thk, eint, gstr, nlay, px1g, px2g, py1g, py2g, x2s, y2s, x3s, y3s, x4s, y4s, uvar, ipm, igeo, imat, skew, nel, dir_a, dir_b, sigi, npf, tf, irep)
Definition cepsini.F:44
cepschk
subroutine cepschk(jft, jlt, nft, pm, geo, ixc, gstr, thk, nel, cpt_eltens)
Definition cepsini.F:828
ceveci
subroutine ceveci(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 ceveci.F:37
cfailini
subroutine cfailini(elbuf_str, mat_param, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, aldt, thk)
Definition cfailini.F:36
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
cm27in3
subroutine cm27in3(elbuf_str, geo, igeo, pm, ipm, ix, nix, nlay, ir, is, imat)
Definition cm27in3.F:38
cm35in3
subroutine cm35in3(elbuf_str, thk, area, nel, nlay, nptr, npts, nptt, igtyp)
Definition cm35in3.F:34
cm58in3
subroutine cm58in3(irep, dir1, dir2, uparam, uvar, aldt, nel, nuvar, tan_phi, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cm58in3.F:35
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
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
corthdir
subroutine corthdir(elbuf_str, igeo, geo, vx, vy, vz, phi1, phi2, coor1, coor2, coor3, coor4, iorthloc, nlay, irep, isubstack, stack, geo_stack, igeo_stack, ir, is, nel, imat, iprop, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, npt_all, idrape)
Definition corthdir.F:42
corthini
subroutine corthini(jft, jlt, nft, nlay, numel, nsigsh, nix, ix, igeo, geo, skew, sigsh, ptsh, phi1, phi2, vx, vy, vz, coor1, coor2, coor3, coor4, iorthloc, isubstack, stack, irep, elbuf_str, drape, angle, x, geo_stack, e3x, e3y, e3z, betaorth, x1, x2, y1, y2, z1, z2, nel, g_add_node, add_node, npt_all, idrape, indx)
Definition corthini.F:48
my_real
#define my_real
Definition cppsort.cpp:32
csigini
subroutine csigini(elbuf_str, jft, jlt, nft, npt, istrain, thk, eint, gstr, hh, plas, for, mom, sigsh, nlay, g_hourg, numel, ix, nix, nsigsh, numsh, ptsh, igeo, thke, nel, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, isigsh, dir_a, dir_b, posly, igtyp)
Definition csigini.F:46
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
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
law158_init
subroutine law158_init(dir1, dir2, uvar, aldt, nel, nuvar, tan_phi, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition law158_init.F:35
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
id
initmumps id
Definition multiplerhs_example.m:4
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
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

◆ csms11_ini()

subroutine csms11_ini ( integer jft,
integer jlt,
integer, dimension(nixc,*) ixc,
x,
x2s,
y2s,
x3s,
y3s,
x4s,
y4s )

Definition at line 643 of file cinit3.F.

646C-----------------------------------------------
647C I m p l i c i t T y p e s
648C-----------------------------------------------
649#include "implicit_f.inc"
650C-----------------------------------------------
651C G l o b a l P a r a m e t e r s
652C-----------------------------------------------
653#include "mvsiz_p.inc"
654C-----------------------------------------------
655C D u m m y A r g u m e n t s
656C-----------------------------------------------
657 INTEGER JFT, JLT
658 INTEGER IXC(NIXC,*)
659 my_real
660 . x(3,*), x2s(*), y2s(*), x3s(*), y3s(*), x4s(*), y4s(*)
661C------------------------------------------------------
662C L o c a l V a r i a b l e s
663C-----------------------------------------------
664 INTEGER I, NIT, NT, I1, I2, I3, I4
665 my_real
666 . x1(mvsiz) , x2(mvsiz) , x3(mvsiz) , x4(mvsiz) ,
667 . y1(mvsiz) , y2(mvsiz) , y3(mvsiz) , y4(mvsiz) ,
668 . z1(mvsiz) , z2(mvsiz) , z3(mvsiz) , z4(mvsiz)
669 my_real
670 . suma,s1,s2
671
672 my_real
673 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
674 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
675 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz)
676C---------------------------------------------------------------
677 DO i=jft,jlt
678 x1(i)=zero
679 y1(i)=zero
680 z1(i)=zero
681 x2(i)=x(1,ixc(3,i))-x(1,ixc(2,i))
682 y2(i)=x(2,ixc(3,i))-x(2,ixc(2,i))
683 z2(i)=x(3,ixc(3,i))-x(3,ixc(2,i))
684 x3(i)=x(1,ixc(4,i))-x(1,ixc(2,i))
685 y3(i)=x(2,ixc(4,i))-x(2,ixc(2,i))
686 z3(i)=x(3,ixc(4,i))-x(3,ixc(2,i))
687 x4(i)=x(1,ixc(5,i))-x(1,ixc(2,i))
688 y4(i)=x(2,ixc(5,i))-x(2,ixc(2,i))
689 z4(i)=x(3,ixc(5,i))-x(3,ixc(2,i))
690 ENDDO
691 DO i=jft,jlt
692 e1x(i) = x2(i)+x3(i)-x1(i)-x4(i)
693 e1y(i) = y2(i)+y3(i)-y1(i)-y4(i)
694 e1z(i) = z2(i)+z3(i)-z1(i)-z4(i)
695C
696 e2x(i) = x3(i)+x4(i)-x1(i)-x2(i)
697 e2y(i) = y3(i)+y4(i)-y1(i)-y2(i)
698 e2z(i) = z3(i)+z4(i)-z1(i)-z2(i)
699C
700 e3x(i) = e1y(i)*e2z(i)-e1z(i)*e2y(i)
701 e3y(i) = e1z(i)*e2x(i)-e1x(i)*e2z(i)
702 e3z(i) = e1x(i)*e2y(i)-e1y(i)*e2x(i)
703 ENDDO
704C---
705 DO i=jft,jlt
706 suma = e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i)
707 suma = one/max(sqrt(suma),em20)
708 e3x(i) = e3x(i)*suma
709 e3y(i) = e3y(i)*suma
710 e3z(i) = e3z(i)*suma
711C
712 s1 = e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
713 s2 = e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
714 suma = sqrt(s1/s2)
715 e1x(i) = e1x(i) + (e2y(i)*e3z(i)-e2z(i)*e3y(i))*suma
716 e1y(i) = e1y(i) + (e2z(i)*e3x(i)-e2x(i)*e3z(i))*suma
717 e1z(i) = e1z(i) + (e2x(i)*e3y(i)-e2y(i)*e3x(i))*suma
718C
719 suma = e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
720 suma = one/max(sqrt(suma),em20)
721 e1x(i) = e1x(i)*suma
722 e1y(i) = e1y(i)*suma
723 e1z(i) = e1z(i)*suma
724C
725 e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
726 e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
727 e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
728 ENDDO
729 DO i=jft,jlt
730 x2s(i) = e1x(i)*x2(i) + e1y(i)*y2(i) + e1z(i)*z2(i)
731 y2s(i) = e2x(i)*x2(i) + e2y(i)*y2(i) + e2z(i)*z2(i)
732 x3s(i) = e1x(i)*x3(i) + e1y(i)*y3(i) + e1z(i)*z3(i)
733 y3s(i) = e2x(i)*x3(i) + e2y(i)*y3(i) + e2z(i)*z3(i)
734 x4s(i) = e1x(i)*x4(i) + e1y(i)*y4(i) + e1z(i)*z4(i)
735 y4s(i) = e2x(i)*x4(i) + e2y(i)*y4(i) + e2z(i)*z4(i)
736 ENDDO
737C-----------
738 RETURN