OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdkinit3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| cdkinit3 ../starter/source/elements/sh3n/coquedk/cdkinit3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| c1buf3 ../starter/source/elements/shell/coque/c1buf3.F
30!|| c3coori ../starter/source/elements/sh3n/coque3n/c3coori.F
31!|| c3epschk ../starter/source/elements/sh3n/coque3n/c3init3.F
32!|| c3evec3 ../starter/source/elements/sh3n/coque3n/c3evec3.F
33!|| c3inmas ../starter/source/elements/sh3n/coque3n/c3inmas.F
34!|| c3veok3 ../starter/source/elements/sh3n/coque3n/c3veok3.F
35!|| cdkderii ../starter/source/elements/sh3n/coquedk/cdkderii.F
36!|| cdkepsini ../starter/source/elements/sh3n/coquedk/cdkepsini.F
37!|| cdkevec3 ../starter/source/elements/sh3n/coquedk/cdkevec3.F
38!|| cm35in3 ../starter/source/materials/mat/mat035/cm35in3.F
39!|| cmaini3 ../starter/source/elements/sh3n/coquedk/cmaini3.F
40!|| cmatini4 ../starter/source/materials/mat_share/cmatini4.F
41!|| corth3 ../starter/source/elements/shell/coque/corth3.F
42!|| csigini4 ../starter/source/elements/shell/coqueba/scigini4.F
43!|| cuserini4 ../starter/source/elements/shell/coqueba/cuserini4.F
44!|| initemp_shell ../starter/source/materials/therm/initemp_shell.F90
45!|| layini1 ../starter/source/elements/shell/coqueba/layini1.F
46!|| thickini ../starter/source/elements/shell/coqueba/thickini.F
47!||--- uses -----------------------------------------------------
48!|| drape_mod ../starter/share/modules1/drape_mod.F
49!|| initemp_shell_mod ../starter/source/materials/therm/initemp_shell.F90
50!|| message_mod ../starter/share/message_module/message_mod.F
51!|| stack_mod ../starter/share/modules1/stack_mod.F
52!||====================================================================
53 SUBROUTINE cdkinit3(ELBUF_STR,GROUP_PARAM,
54 1 IXTG ,PM ,X ,GEO ,
55 2 XMAS ,IN ,NVC ,DTELEM,
56 3 XREFTG,OFFSET,NEL ,ITHK ,THK ,
57 4 ISIGSH,SIGSH ,STIFN ,STIFR,PARTSAV ,
58 5 V ,IPART ,MSTG ,INTG ,PTG,
59 8 SKEW ,ISH3N ,NSIGSH ,IGEO ,IPM ,
60 9 IUSER ,ETNOD,NSHNOD ,STTG ,PTSH3N,
61 A BUFMAT,SH3TREE ,MCP ,MCPS , TEMP ,
62 B IPARG,CPT_ELTENS,PART_AREA ,NPF, TF ,
63 C SH3TRIM,ISUBSTACK,STACK,RNOISE ,DRAPE,
64 D SH3ANG,GEO_STACK,IGEO_STACK,STRTG,
65 E PERTURB,IYLDINI,ELE_AREA,NLOC_DMG,
66 G IDRAPE ,DRAPEG,MAT_PARAM,GLOB_THERM)
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
445 END
446!||====================================================================
447!|| cdkpxpyi ../starter/source/elements/sh3n/coquedk/cdkinit3.F
448!||--- called by ------------------------------------------------------
449!|| cdkepsini ../starter/source/elements/sh3n/coquedk/cdkepsini.F
450!||====================================================================
451 SUBROUTINE cdkpxpyi(JFT ,JLT ,ISMSTR ,
452 . PX2G,PY2G,PX3G,PY3G,
453 . PX2 ,PY2 ,PX3 ,PY3 ,
454 . X2 , Y2 ,X3 , Y3 ,
455 . X1G ,X2G ,X3G ,Y1G ,Y2G ,
456 . Y3G ,Z1G ,Z2G ,Z3G ,
457 . E1X ,E2X ,E3X ,E1Y ,E2Y ,
458 . E3Y ,E1Z ,E2Z ,E3Z ,AREA )
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
529 END
530C
531!||====================================================================
532!|| cdkdefoi ../starter/source/elements/sh3n/coquedk/cdkinit3.F
533!||--- called by ------------------------------------------------------
534!|| cdkepsini ../starter/source/elements/sh3n/coquedk/cdkepsini.F
535!||====================================================================
536 SUBROUTINE cdkdefoi(JFT ,JLT ,NEL ,VL ,GSTR ,
537 . PX2 ,PY2 ,PX3 ,PY3 ,
538 . E1X ,E2X ,E3X ,E1Y ,E2Y ,
539 . E3Y ,E1Z ,E2Z ,E3Z ,
540 . EXX ,EYY ,EXY ,EYZ ,EZX )
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
609 END
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
cdkdefoi
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)
Definition cdkinit3.F:541
cdkpxpyi
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)
Definition cdkinit3.F:459
cdkinit3
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)
Definition cdkinit3.F:67
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
my_real
#define my_real
Definition cppsort.cpp:32
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
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