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

Go to the source code of this file.

Functions/Subroutines

subroutine cdkinit3 (elbuf_str, group_param, ixtg, pm, x, geo, xmas, in, nvc, dtelem, xreftg, offset, nel, ithk, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, mstg, intg, ptg, skew, ish3n, nsigsh, igeo, ipm, iuser, etnod, nshnod, sttg, ptsh3n, bufmat, sh3tree, mcp, mcps, temp, iparg, cpt_eltens, part_area, npf, tf, sh3trim, isubstack, stack, rnoise, drape, sh3ang, geo_stack, igeo_stack, strtg, perturb, iyldini, ele_area, nloc_dmg, idrape, drapeg, mat_param, glob_therm)
subroutine cdkpxpyi (jft, jlt, ismstr, px2g, py2g, px3g, py3g, px2, py2, px3, py3, x2, y2, x3, y3, x1g, x2g, x3g, y1g, y2g, y3g, z1g, z2g, z3g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, area)
subroutine cdkdefoi (jft, jlt, nel, vl, gstr, px2, py2, px3, py3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, exx, eyy, exy, eyz, ezx)

Function/Subroutine Documentation

◆ cdkdefoi()

subroutine cdkdefoi ( integer jft,
integer jlt,
integer nel,
vl,
gstr,
px2,
py2,
px3,
py3,
e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
exx,
eyy,
exy,
eyz,
ezx )

Definition at line 536 of file cdkinit3.F.

541C-----------------------------------------------
542C I m p l i c i t T y p e s
543C-----------------------------------------------
544#include "implicit_f.inc"
545C-----------------------------------------------
546C G l o b a l P a r a m e t e r s
547C-----------------------------------------------
548#include "mvsiz_p.inc"
549C-----------------------------------------------
550C D u m m y A r g u m e n t s
551C-----------------------------------------------
552 INTEGER JFT, JLT,NEL
553C REAL
554 my_real
555 . vl(3,3,*),gstr(nel,8),px2(*),py2(*),px3(*),py3(*)
556 my_real
557 . exx(mvsiz) , eyy(mvsiz) , exy(mvsiz) ,
558 . ezx(mvsiz) , eyz(mvsiz) ,
559 . e1x(mvsiz) , e1y(mvsiz) , e1z(mvsiz) ,
560 . e2x(mvsiz) , e2y(mvsiz) , e2z(mvsiz) ,
561 . e3x(mvsiz) , e3y(mvsiz) , e3z(mvsiz)
562C-----------------------------------------------
563C L o c a l V a r i a b l e s
564C-----------------------------------------------
565 INTEGER I
566 my_real vx1(mvsiz) , vx2(mvsiz) , vx3(mvsiz) ,
567 . vy1(mvsiz) , vy2(mvsiz) , vy3(mvsiz) ,
568 . vz1(mvsiz) , vz2(mvsiz) , vz3(mvsiz) ,
569 . vx12(mvsiz), vx13(mvsiz),
570 . vy12(mvsiz), vy13(mvsiz)
571C=======================================================================
572 DO i=jft,jlt
573 vx1(i)=e1x(i)*vl(1,1,i)+e1y(i)*vl(2,1,i)+e1z(i)*vl(3,1,i)
574 vx2(i)=e1x(i)*vl(1,2,i)+e1y(i)*vl(2,2,i)+e1z(i)*vl(3,2,i)
575 vx3(i)=e1x(i)*vl(1,3,i)+e1y(i)*vl(2,3,i)+e1z(i)*vl(3,3,i)
576C
577 vy3(i)=e2x(i)*vl(1,3,i)+e2y(i)*vl(2,3,i)+e2z(i)*vl(3,3,i)
578 vy2(i)=e2x(i)*vl(1,2,i)+e2y(i)*vl(2,2,i)+e2z(i)*vl(3,2,i)
579 vy1(i)=e2x(i)*vl(1,1,i)+e2y(i)*vl(2,1,i)+e2z(i)*vl(3,1,i)
580C
581 vz1(i)=e3x(i)*vl(1,1,i)+e3y(i)*vl(2,1,i)+e3z(i)*vl(3,1,i)
582 vz2(i)=e3x(i)*vl(1,2,i)+e3y(i)*vl(2,2,i)+e3z(i)*vl(3,2,i)
583 vz3(i)=e3x(i)*vl(1,3,i)+e3y(i)*vl(2,3,i)+e3z(i)*vl(3,3,i)
584 ENDDO
585C
586 DO i=jft,jlt
587C
588 vx12(i)=-vx1(i) + vx2(i)
589 vy12(i)=-vy1(i) + vy2(i)
590 vx13(i)=-vx1(i) + vx3(i)
591 vy13(i)=-vy1(i) + vy3(i)
592C
593 exx(i)=px2(i)*vx12(i) + px3(i)*vx13(i)
594 eyy(i)=py2(i)*vy12(i) + py3(i)*vy13(i)
595C
596 exy(i)=py2(i)*vx12(i) + py3(i)*vx13(i)
597 . + px2(i)*vy12(i) + px3(i)*vy13(i)
598 eyz(i)=zero
599 ezx(i)=zero
600 ENDDO
601C
602 DO i=jft,jlt
603 gstr(i,1)=gstr(i,1)+exx(i)
604 gstr(i,2)=gstr(i,2)+eyy(i)
605 gstr(i,3)=gstr(i,3)+exy(i)
606 ENDDO
607C
608 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ cdkinit3()

subroutine cdkinit3 ( type (elbuf_struct_), target elbuf_str,
type (group_param_) group_param,
integer, dimension(nixtg,*) ixtg,
pm,
x,
geo,
xmas,
in,
integer nvc,
dtelem,
xreftg,
integer offset,
integer nel,
integer ithk,
thk,
integer isigsh,
sigsh,
stifn,
stifr,
partsav,
v,
integer, dimension(*) ipart,
mstg,
intg,
ptg,
skew,
integer ish3n,
integer nsigsh,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer iuser,
etnod,
integer, dimension(*) nshnod,
sttg,
integer, dimension(*) ptsh3n,
bufmat,
integer, dimension(*) sh3tree,
mcp,
mcps,
temp,
integer, dimension(*) iparg,
integer cpt_eltens,
part_area,
integer, dimension(*) npf,
tf,
integer, dimension(*) sh3trim,
integer isubstack,
type (stack_ply) stack,
rnoise,
type (drape_), dimension(numelc_drape + numeltg_drape) drape,
sh3ang,
geo_stack,
integer, dimension(*) igeo_stack,
strtg,
integer, dimension(nperturb) perturb,
integer iyldini,
ele_area,
type (nlocal_str_) nloc_dmg,
integer idrape,
type (drapeg_) drapeg,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
type (glob_therm_), intent(in) glob_therm )

Definition at line 53 of file cdkinit3.F.

67C-----------------------------------------------
68C M o d u l e s
69C-----------------------------------------------
70 USE mat_elem_mod
71 USE message_mod
72 USE stack_mod
73 USE group_param_mod
74 USE nlocal_reg_mod
75 USE drape_mod
76 use glob_therm_mod
77 use initemp_shell_mod
78 use element_mod , only : nixtg
79C-----------------------------------------------
80C I m p l i c i t T y p e s
81C-----------------------------------------------
82#include "implicit_f.inc"
83C-----------------------------------------------
84C G l o b a l P a r a m e t e r s
85C-----------------------------------------------
86#include "mvsiz_p.inc"
87C-----------------------------------------------
88C C o m m o n B l o c k s
89C-----------------------------------------------
90#include "com01_c.inc"
91#include "com04_c.inc"
92#include "param_c.inc"
93#include "scr03_c.inc"
94#include "vect01_c.inc"
95#include "scry_c.inc"
96C-----------------------------------------------
97C D u m m y A r g u m e n t s
98C-----------------------------------------------
99 INTEGER IXTG(NIXTG,*),IPART(*), OFFSET, NEL, ITHK, ISIGSH,
100 . ISH3N,NSIGSH,NLAY,NPTR,NPTS,NPTT,IL,IR,IS,IT,IYLDINI,
101 . IGEO(NPROPGI,*),IPM(NPROPMI,*),IUSER, NSHNOD(*),NPF(*),
102 . PTSH3N(*), SH3TREE(*),IPARG(*),CPT_ELTENS,SH3TRIM(*),
103 . ISUBSTACK,IGEO_STACK(*),PERTURB(NPERTURB),IDRAPE
104 my_real
105 . pm(npropm,*),x(*),geo(npropg,*),xmas(*),
106 . in(*),dtelem(*), xreftg(3,3,*),thk(*),sigsh(nsigsh,*),
107 . stifn(*),stifr(*),partsav(20,*), v(*), skew(lskew,*),
108 . mstg(*),intg(*),ptg(3,*),etnod(*), sttg(*),bufmat(*),
109 . mcp(*),mcps(*),temp(*),part_area(*),tf(*),
110 . rnoise(*),sh3ang(*),geo_stack(*),strtg(*),ele_area(*)
111 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
112 TYPE (STACK_PLY) :: STACK
113 TYPE (GROUP_PARAM_) :: GROUP_PARAM
114 TYPE (NLOCAL_STR_) :: NLOC_DMG
115 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
116 TYPE (DRAPEG_) :: DRAPEG
117 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
118 TYPE (glob_therm_) ,intent(in) :: glob_therm
119C-----------------------------------------------
120C L o c a l V a r i a b l e s
121C-----------------------------------------------
122 INTEGER I,J,NDEPAR,IGTYP,IMAT,IPROP,IGMAT,NVC,IHBE,NPG,MPT,
123 . PTM,PTF,PTS,NUVAR,NUVARR,ID,LENF,LENM,LENS,IREP,IPG
124 INTEGER JJ(8),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
125 . MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ)
126 INTEGER LAYNPT_MAX,LAY_MAX,NPT_ALL
127 my_real,
128 . DIMENSION(MVSIZ) :: px2,py2,px3,py3,x2s,y2s,x3s,y3s,
129 . area,aldt,iorthloc,dt
130 my_real x1(mvsiz), x2(mvsiz), x3(mvsiz) ,x4(mvsiz),
131 . y1(mvsiz), y2(mvsiz), y3(mvsiz),y4(mvsiz),
132 . z1(mvsiz), z2(mvsiz), z3(mvsiz),z4(mvsiz),
133 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
134 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
135 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
136 . x31(mvsiz), y31(mvsiz), z31(mvsiz),
137 . x2l(mvsiz), x3l(mvsiz), y3l(mvsiz)
138 my_real, ALLOCATABLE, DIMENSION(:) :: dir_a,dir_b
139
140 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDX
141 my_real,
142 . DIMENSION(:) ,POINTER :: uvar
143 parameter(laynpt_max = 10)
144 parameter(lay_max = 100)
145 INTEGER MATLY(MVSIZ*LAY_MAX)
146 my_real
147 . posly(mvsiz,lay_max*laynpt_max),npgth
148C-----------------------------------------------
149 TYPE(BUF_LAY_) ,POINTER :: BUFLY
150 TYPE(L_BUFEL_) ,POINTER :: LBUF
151 TYPE(G_BUFEL_) ,POINTER :: GBUF
152C=======================================================================
153 gbuf => elbuf_str%GBUF
154 iorthloc = 0
155 imat = ixtg(1,1+nft) ! mat N
156 iprop = ixtg(nixtg-1,1+nft) ! property N
157C IGTYP = GEO(12,IPROP)
158 igtyp = igeo(11,iprop)
159 igmat = igeo(98,iprop)
160 id = igeo(1,iprop)
161 irep = iparg(35)
162C
163 nlay = elbuf_str%NLAY
164 nptr = elbuf_str%NPTR
165 npts = elbuf_str%NPTS
166 nptt = elbuf_str%NPTT
167 npg = nptr*npts
168 IF (npt /= 0) npt = nptt*nlay
169 lenf = nel*gbuf%G_FORPG/npg
170 lenm = nel*gbuf%G_MOMPG/npg
171 lens = nel*gbuf%G_STRPG/npg
172!
173 DO i=1,8
174 jj(i) = nel*(i-1)
175 ENDDO
176C
177 DO i=lft,llt
178 mat(i) = imat
179 pid(i) = iprop
180 ENDDO
181C-----------------------------------------------
182 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
183 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
184 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
185 CALL c3veok3(nvc ,ix1 ,ix2 ,ix3 )
186 CALL c3evec3(lft ,llt ,area,
187 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
188 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
189 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
190 . x31, y31, z31 ,x2l ,x3l ,y3l )
191C-----------------------------------------------------------------------
192! Initialize element temperature from /initemp
193!
194 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
195 CALL initemp_shell(elbuf_str,temp,nel,numnod,numeltg,3,nixtg,ixtg)
196 END IF
197C-----------------------------------------------------------------------
198 IF(idrape > 0 ) THEN
199 ALLOCATE(indx(numeltg))
200 indx = 0
201 indx(1:numeltg) = drapeg%INDX(numelc + 1 : numelc + numeltg)
202 ELSE
203 ALLOCATE(indx(0))
204 ENDIF
205 CALL c3inmas(x,xreftg(1,1,nft+1),ixtg,geo,pm,xmas,in,thk,
206 . partsav,v,ipart(nft+1),mstg(nft+1),intg(nft+1),
207 . ptg(1,nft+1),igeo ,imat ,iprop ,area ,
208 . etnod,nshnod,sttg(nft+1),sh3tree,mcp ,
209 . mcps(nft+1) , temp,sh3trim,isubstack,nlay,
210 . elbuf_str,stack,gbuf%THK_I,rnoise,drape ,
211 . perturb,ix1 ,ix2 ,ix3 ,glob_therm%NINTEMP,
212 . x2l ,x3l ,y3l ,idrape , indx)
213C-----------------------------------------------
214 npt_all = 0
215 DO il=1,nlay
216 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
217 ENDDO
218 mpt = max(1,npt_all)
219 IF(npt_all == 0 ) npt_all = nlay
220 IF (iparg(6) == 0.OR.npt==0) mpt=0
221C
222 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0) THEN
223 ALLOCATE(dir_a(npt_all*nel*2))
224 ALLOCATE(dir_b(npt_all*nel*2))
225 dir_a = zero
226 dir_b = zero
227 ELSE
228 ALLOCATE(dir_a(nlay*nel*2))
229 ALLOCATE(dir_b(nlay*nel*2))
230 dir_a = zero
231 dir_b = zero
232 npt_all = nlay
233 ENDIF
234 nuvar = 0
235 nuvarr = 0
236 IF (mtn>=29) THEN
237 DO i=lft,llt
238 imat = ixtg(1,i+nft)
239 nuvar = max(nuvar,ipm(8,imat))
240 nuvarr = max(nuvarr,ipm(221,imat))
241 ENDDO
242 ENDIF
243C---------------------------
244 CALL cdkevec3(lft ,llt ,area,
245 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
246 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
247 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
248C------------
249C Tags total area of the part (needed in /ADMAS for shells)
250C------------
251 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
252 DO i=lft,llt
253 j = ipart(i+nft)
254C PART_AREA(J) = PART_AREA(J) + AREA(I)
255 ele_area(numelc+i+nft) = area(i)
256 IF (gbuf%G_AREA > 0) gbuf%AREA(i) = area(i)
257 ENDDO
258 ENDIF
259C------------
260 CALL cdkderii(lft,llt,pm,geo,px2,py2,px3,py3,
261 . stifn ,stifr ,ixtg(1,nft+1),thk, sh3tree,
262 . aldt ,bufmat ,ipm ,igeo,stack%PM,
263 . isubstack,strtg(nft+1),group_param,
264 . imat ,iprop,area, dt ,
265 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
266 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
267 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
268C
269 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh3tree,sh3tree)
270c---------------------------
271c---- Init UVAR
272 IF (mtn == 35) THEN
273 CALL cm35in3(elbuf_str,thk,area,nel,nlay,
274 . nptr,npts,nptt,igtyp)
275 ENDIF
276C
277 IF (( isigsh/=0 .OR. ithkshel == 2) .and. mpt>0) THEN
278 CALL layini1(
279 . elbuf_str ,lft ,llt ,geo ,igeo ,
280 . mat ,pid ,matly ,posly ,igtyp ,
281 . nlay ,mpt ,isubstack ,stack ,drape ,
282 . nft ,gbuf%THK ,nel ,idrape ,stdrape ,
283 . indx)
284 END IF
285C------------
286 is = 1
287 DO ir =1,npg
288 ipg = ir
289 ptf = (ir-1)*lenf
290 ptm = (ir-1)*lenm
291 pts = (ir-1)*lens
292c
293 CALL cmaini3(elbuf_str,pm ,geo ,nel ,nlay ,
294 . skew ,igeo ,ixtg(1,nft+1),nixtg ,numeltg ,
295 . nsigsh ,sigsh ,ptsh3n ,igtyp ,iorthloc ,
296 . ipm ,id ,aldt ,mat_param,
297 . ir ,is ,isubstack,stack ,irep ,
298 . drape ,sh3ang(nft+1),geo_stack,igeo_stack,
299 . igmat ,imat ,iprop ,nummat,
300 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
301 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
302 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,x ,
303 . npt_all ,idrape ,stdrape ,indx)
304C-----------------------------------------------------------------------
305C CALCULATION OF INITIAL STRESSES
306C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
307 IF ((isigsh /= 0 .OR. ithkshel == 2).AND. ish3n == 30 ) THEN
308 IF (mpt>0)
309 . CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
310 . nlay ,irep ,nel ,
311 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
312 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
313 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
314 . idrape, igtyp)
315 ihbe = 11
316 CALL csigini4(elbuf_str,ihbe ,
317 1 lft ,llt ,nft ,mpt ,istrain,
318 2 gbuf%THK ,gbuf%EINT,gbuf%STRPG(pts+1),gbuf%HOURG,
319 3 gbuf%FORPG(ptf+1),gbuf%MOMPG(ptm+1),sigsh ,nsigsh ,numeltg ,
320 4 ixtg ,nixtg ,numsh3n ,ptsh3n ,igeo ,
321 5 ir ,is ,ir ,npg ,gbuf%G_PLA,
322 6 gbuf%PLA,thk ,igtyp ,nel ,isigsh ,
323 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
324 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
325 IF (mpt == 0) THEN
326 DO i=lft,llt
327 gbuf%FORPG_G(ptf+i+jj(1:5))=gbuf%FORPG(ptf+i+jj(1:5))
328 END DO
329 END IF
330 IF (ithkshel == 2) THEN
331 npgth = one/npg
332 DO i=lft,llt
333 gbuf%STRA(i+jj(1:8))=gbuf%STRA(i+jj(1:8))+
334 . npgth*gbuf%STRPG(pts+i+jj(1:8))
335 END DO
336 END IF
337 ELSEIF ( ithkshel == 1 .AND. ish3n == 30 ) THEN
338 CALL thickini(lft ,llt ,nft ,ptsh3n,numeltg,
339 2 gbuf%THK,thk ,ixtg ,nixtg ,nsigsh ,
340 3 sigsh )
341 ENDIF
342C
343 IF (iuser == 1.AND.mtn>=28) THEN
344 CALL cuserini4(elbuf_str,
345 1 lft ,llt ,nft ,nel ,istrain ,
346 2 sigsh ,nsigsh ,numelc ,ixtg ,nixtg ,
347 3 numsh3n ,ptsh3n ,ir ,is ,npt ,
348 4 igtyp ,igeo ,nlay ,npg ,ipg )
349 ENDIF
350C-----------------------------------------------------------------------
351 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87)) THEN
352 CALL cmatini4(elbuf_str,
353 1 lft ,llt ,nft ,nel ,istrain ,
354 2 sigsh ,nsigsh ,numelc ,ixtg ,nixtg ,
355 3 numsh3n ,ptsh3n ,ir ,is ,npt ,
356 4 igtyp ,igeo ,nlay ,npg ,ipg )
357 ENDIF
358 ENDDO
359C----------------------------------------
360c Failure model initialisation
361C----------------------------------------
362 CALL cfailini4(elbuf_str,nptr ,npts ,nptt ,nlay ,
363 . sigsh ,nsigsh ,ptsh3n ,rnoise ,perturb ,
364 . mat_param,aldt ,thk )
365C-----------------------------------------------------------------------
366C CALCUL DES DEFORMATIONS INITIALES (MEMBRANE)
367C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
368 IF (istrain == 1 .AND. nxref > 0) THEN
369 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR !
370 CALL cdkepsini(elbuf_str,mat_param(imat),
371 . lft ,llt ,ismstr ,mtn ,ithk ,
372 . pm ,geo ,ixtg(1,nft+1),x ,xreftg(1,1,nft+1),
373 . gbuf%FOR,gbuf%THK,gbuf%EINT,gbuf%STRA,
374 . px2 ,py2 ,px3 ,py3 ,x2s ,
375 . y2s ,x3s ,y3s ,gbuf%OFF ,imat ,
376 . uvar ,ipm ,nel ,
377 . nlay ,dir_a ,dir_b ,gbuf%SIGI ,npf ,
378 . tf ,irep )
379c
380 CALL c3epschk(lft, llt,nft, pm, geo,ixtg(1,nft+1),gbuf%STRA,thk,
381 . nel,cpt_eltens)
382c
383 IF (ismstr == 1) iparg(9)=11
384c
385 IF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19)) THEN
386 DO i=lft,llt
387 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
388 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
389 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
390 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
391 ENDDO
392 ENDIF
393C
394 DO ir =1,npg
395 ptf = (ir-1)*lenf
396 ptm = (ir-1)*lenm
397 pts = (ir-1)*lens
398 DO i=lft,llt
399 gbuf%FORPG(ptf+jj(1)+i) = gbuf%FOR(jj(1)+i)
400 gbuf%FORPG(ptf+jj(2)+i) = gbuf%FOR(jj(2)+i)
401 gbuf%FORPG(ptf+jj(3)+i) = gbuf%FOR(jj(3)+i)
402!
403 gbuf%MOMPG(ptm+jj(1)+i) = gbuf%MOM(jj(1)+i)
404 gbuf%MOMPG(ptm+jj(2)+i) = gbuf%MOM(jj(2)+i)
405 gbuf%MOMPG(ptm+jj(3)+i) = gbuf%MOM(jj(3)+i)
406 ENDDO
407 IF (mtn == 58 .and. ir > 1) THEN
408 uvar => elbuf_str%BUFLY(1)%MAT(ir,is,1)%VAR ! law58 => NLAY=1
409 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
410 DO i=1,nel*nuvar
411 uvar(i) = elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR(i)
412 ENDDO
413 END IF
414 ENDDO
415 ENDIF
416C-------------------------------------------
417C CALCULATION OF ELEMENTARY TIMESTEPS
418C-------------------------------------------
419c IGTYP=GEO(12,IXTG(5,I+NFT))
420 IF (igtyp /= 0 .AND. igtyp /= 1 .AND.
421 . igtyp /= 9 .AND. igtyp /= 10 .AND.
422 . igtyp /= 11 .AND. igtyp /= 16 .AND.
423 . igtyp /= 17 .AND. igtyp /= 51 .AND.
424 . igtyp /= 52 ) THEN
425 CALL ancmsg(msgid=25,
426 . anmode=aninfo,
427 . msgtype=msgerror,
428 . i1=igeo(1,iprop))
429 ENDIF
430 ndepar=numels+numelc+numelt+numelp+numelr+nft
431 DO i=lft,llt
432 dtelem(ndepar+i) = dt(i)
433 ENDDO
434C------------
435 ! Compute the initial volume
436 DO i=lft,llt
437 IF (gbuf%G_VOL > 0) gbuf%VOL(i) = area(i)*gbuf%THK(i)
438 ENDDO
439C
440 DEALLOCATE(dir_a)
441 DEALLOCATE(dir_b)
442 IF(ALLOCATED(indx)) DEALLOCATE(indx)
443C---
444 RETURN
c1buf3
subroutine c1buf3(geo, thk, off, thke, kshtree, shtree)
Definition c1buf3.F:32
c3coori
subroutine c3coori(x, xreftg, ixp, ngl, x1, x2, x3, y1, y2, y3, z1, z2, z3, ix1, ix2, ix3)
Definition c3coori.F:39
c3epschk
subroutine c3epschk(jft, jlt, nft, pm, geo, ixtg, gstr, thk, nel, cpt_eltens)
Definition c3init3.F:695
c3inmas
subroutine c3inmas(x, xreftg, ixtg, geo, pm, ms, tiner, thke, partsav, v, ipart, mstg, intg, ptg, igeo, imat, iprop, area, etnod, nshnod, sttg, sh3tree, mcp, mcptg, temp, sh3trim, isubstack, nlay, elbuf_str, stack, thki, rnoise, drape, perturb, ix1, ix2, ix3, nintemp, x2, x3, y3, idrape, indx)
Definition c3inmas.F:46
c3veok3
subroutine c3veok3(nvc, ix1, ix2, ix3)
Definition c3veok3.F:36
cdkderii
subroutine cdkderii(jft, jlt, pm, geo, px2, py2, px3, py3, stifn, stifr, ixtg, thk, sh3tree, aldt, uparam, ipm, igeo, pm_stack, isubstack, strtg, group_param, imat, iprop, area, dt, x1g, x2g, x3g, y1g, y2g, y3g, z1g, z2g, z3g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cdkderii.F:37
cdkepsini
subroutine cdkepsini(elbuf_str, mat_param, jft, jlt, ismstr, ilaw, ithk, pm, geo, ixtg, x, xreftg, for, thk, eint, gstr, px2g, py2g, px3g, py3g, x2s, y2s, x3s, y3s, off, imat, uvar, ipm, nel, nlay, dir_a, dir_b, sigi, npf, tf, irep)
Definition cdkepsini.F:44
cdkevec3
subroutine cdkevec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cdkevec3.F:38
cfailini4
subroutine cfailini4(elbuf_str, nptr, npts, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, mat_param, aldt, thk)
Definition cfailini.F:182
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
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
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
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
id
initmumps id
Definition multiplerhs_example.m:4
drape_mod
Definition drape_mod.F:54
drape_mod::stdrape
integer stdrape
Definition drape_mod.F:92
message_mod
Definition message_mod.F:1257
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
c3evec3
subroutine c3evec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x31, y31, z31, x2l, x3l, y3l)
Definition c3evec3.F:39
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
thickini
subroutine thickini(jft, jlt, nft, ptsh, numel, thk, thke, ix, nix, nsigsh, sigsh)
Definition thickini.F:36

◆ cdkpxpyi()

subroutine cdkpxpyi ( integer jft,
integer jlt,
integer ismstr,
px2g,
py2g,
px3g,
py3g,
px2,
py2,
px3,
py3,
x2,
y2,
x3,
y3,
x1g,
x2g,
x3g,
y1g,
y2g,
y3g,
z1g,
z2g,
z3g,
e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
area )

Definition at line 451 of file cdkinit3.F.

459C-----------------------------------------------
460C I m p l i c i t T y p e s
461C-----------------------------------------------
462#include "implicit_f.inc"
463C-----------------------------------------------
464C G l o b a l P a r a m e t e r s
465C-----------------------------------------------
466#include "mvsiz_p.inc"
467C-----------------------------------------------
468C D u m m y A r g u m e n t s
469C-----------------------------------------------
470 INTEGER JFT, JLT, ISMSTR
471C REAL
472 my_real
473 . px2(*), py2(*), px3(*),py3(*),
474 . px2g(*), py2g(*), px3g(*),py3g(*),
475 . x2(*), y2(*), x3(*), y3(*)
476 my_real
477 . x1g(mvsiz), x2g(mvsiz), x3g(mvsiz),
478 . y1g(mvsiz), y2g(mvsiz), y3g(mvsiz),
479 . z1g(mvsiz), z2g(mvsiz), z3g(mvsiz),
480 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
481 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
482 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),area(mvsiz)
483C-----------------------------------------------
484C L o c a l V a r i a b l e s
485C-----------------------------------------------
486 INTEGER I
487 my_real areai
488 my_real x21g(mvsiz), y21g(mvsiz), z21g(mvsiz),
489 . x31g(mvsiz), y31g(mvsiz), z31g(mvsiz)
490C=======================================================================
491C
492 IF (ismstr/=3)THEN
493 DO i=jft,jlt
494 x21g(i)=x2g(i)-x1g(i)
495 y21g(i)=y2g(i)-y1g(i)
496 z21g(i)=z2g(i)-z1g(i)
497 x31g(i)=x3g(i)-x1g(i)
498 y31g(i)=y3g(i)-y1g(i)
499 z31g(i)=z3g(i)-z1g(i)
500 ENDDO
501C
502 DO i=jft,jlt
503 y3(i)=e2x(i)*x31g(i)+e2y(i)*y31g(i)+e2z(i)*z31g(i)
504 x3(i)=e1x(i)*x31g(i)+e1y(i)*y31g(i)+e1z(i)*z31g(i)
505 x2(i)=e1x(i)*x21g(i)+e1y(i)*y21g(i)+e1z(i)*z21g(i)
506 y2(i)=e2x(i)*x21g(i)+e2y(i)*y21g(i)+e2z(i)*z21g(i)
507 ENDDO
508C
509 DO i=jft,jlt
510 areai = half/area(i)
511 px2(i)=y3(i)*areai
512 py2(i)=-x3(i)*areai
513 px3(i)=-y2(i)*areai
514 py3(i)=x2(i)*areai
515 ENDDO
516C
517 ELSE
518C
519 DO i=jft,jlt
520 px2(i) = px2g(i)
521 py2(i) = py2g(i)
522 px3(i) = px3g(i)
523 py3(i) = py3g(i)
524 ENDDO
525C
526 ENDIF
527C
528 RETURN