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
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82C-----------------------------------------------
83C G l o b a l P a r a m e t e r s
84C-----------------------------------------------
85#include "mvsiz_p.inc"
86C-----------------------------------------------
87C C o m m o n B l o c k s
88C-----------------------------------------------
89#include "com01_c.inc"
90#include "com04_c.inc"
91#include "param_c.inc"
92#include "scr03_c.inc"
93#include "vect01_c.inc"
94#include "scry_c.inc"
95C-----------------------------------------------
96C D u m m y A r g u m e n t s
97C-----------------------------------------------
98 INTEGER IXTG(NIXTG,*),IPART(*), OFFSET, NEL, ITHK, ISIGSH,
99 . ISH3N,NSIGSH,NLAY,NPTR,NPTS,NPTT,IL,IR,IS,IT,IYLDINI,
100 . IGEO(NPROPGI,*),IPM(NPROPMI,*),IUSER, NSHNOD(*),NPF(*),
101 . PTSH3N(*), SH3TREE(*),IPARG(*),CPT_ELTENS,SH3TRIM(*),
102 . ISUBSTACK,IGEO_STACK(*),PERTURB(NPERTURB),IDRAPE
103 my_real
104 . PM(NPROPM,*),X(*),GEO(NPROPG,*),XMAS(*),
105 . IN(*),DTELEM(*), XREFTG(3,3,*),THK(*),SIGSH(NSIGSH,*),
106 . STIFN(*),STIFR(*),PARTSAV(20,*), V(*), SKEW(LSKEW,*),
107 . MSTG(*),INTG(*),PTG(3,*),ETNOD(*), STTG(*),BUFMAT(*),
108 . MCP(*),MCPS(*),TEMP(*),PART_AREA(*),TF(*),
109 . RNOISE(*),SH3ANG(*),GEO_STACK(*),STRTG(*),ELE_AREA(*)
110 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
111 TYPE (STACK_PLY) :: STACK
112 TYPE (GROUP_PARAM_) :: GROUP_PARAM
113 TYPE (NLOCAL_STR_) :: NLOC_DMG
114 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
115 TYPE (DRAPEG_) :: DRAPEG
116 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
117 TYPE (glob_therm_) ,intent(in) :: glob_therm
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER I,J,NDEPAR,IGTYP,IMAT,IPROP,IGMAT,NVC,IHBE,NPG,MPT,
122 . PTM,PTF,PTS,NUVAR,NUVARR,ID,LENF,LENM,LENS,IREP,IPG
123 INTEGER JJ(5),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
124 . mat(mvsiz),pid(mvsiz),ngl(mvsiz)
125 INTEGER LAYNPT_MAX,LAY_MAX,NPT_ALL
126 my_real,
127 . DIMENSION(MVSIZ) :: px2,py2,px3,py3,x2s,y2s,x3s,y3s,
128 . area,aldt,iorthloc,dt
129 my_real x1(mvsiz), x2(mvsiz), x3(mvsiz) ,x4(mvsiz),
130 . y1(mvsiz), y2(mvsiz), y3(mvsiz),y4(mvsiz),
131 . z1(mvsiz), z2(mvsiz), z3(mvsiz),z4(mvsiz),
132 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
133 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
134 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
135 . x31(mvsiz), y31(mvsiz), z31(mvsiz),
136 . x2l(mvsiz), x3l(mvsiz), y3l(mvsiz)
137 my_real, ALLOCATABLE, DIMENSION(:) :: dir_a,dir_b
138
139 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDX
140 my_real,
141 . DIMENSION(:) ,POINTER :: UVAR
142 parameter(laynpt_max = 10)
143 parameter(lay_max = 100)
144 INTEGER MATLY(MVSIZ*LAY_MAX)
145 my_real
146 . POSLY(MVSIZ,LAY_MAX*LAYNPT_MAX)
147C-----------------------------------------------
148 TYPE(BUF_LAY_) ,POINTER :: BUFLY
149 TYPE(L_BUFEL_) ,POINTER :: LBUF
150 TYPE(g_bufel_) ,POINTER :: GBUF
151C=======================================================================
152 gbuf => elbuf_str%GBUF
153 iorthloc = 0
154 imat = ixtg(1,1+nft) ! mat N
155 iprop = ixtg(nixtg-1,1+nft) ! property N
156C IGTYP = GEO(12,IPROP)
157 igtyp = igeo(11,iprop)
158 igmat = igeo(98,iprop)
159 id = igeo(1,iprop)
160 irep = iparg(35)
161C
162 nlay = elbuf_str%NLAY
163 nptr = elbuf_str%NPTR
164 npts = elbuf_str%NPTS
165 nptt = elbuf_str%NPTT
166 npg = nptr*npts
167 IF (npt /= 0) npt = nptt*nlay
168 lenf = nel*gbuf%G_FORPG/npg
169 lenm = nel*gbuf%G_MOMPG/npg
170 lens = nel*gbuf%G_STRPG/npg
171!
172 DO i=1,5
173 jj(i) = nel*(i-1)
174 ENDDO
175C
176 DO i=lft,llt
177 mat(i) = imat
178 pid(i) = iprop
179 ENDDO
180C-----------------------------------------------
181 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
182 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
183 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
184 CALL c3veok3(nvc ,ix1 ,ix2 ,ix3 )
185 CALL c3evec3(lft ,llt ,area,
186 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
187 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
188 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
189 . x31, y31, z31 ,x2l ,x3l ,y3l )
190C-----------------------------------------------------------------------
191! Initialize element temperature from /initemp
192!
193 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
194 CALL initemp_shell(elbuf_str,temp,nel,numnod,numeltg,3,nixtg,ixtg)
195 END IF
196C-----------------------------------------------------------------------
197 IF(idrape > 0 ) THEN
198 ALLOCATE(indx(numeltg))
199 indx = 0
200 indx(1:numeltg) = drapeg%INDX(numelc + 1 : numelc + numeltg)
201 ELSE
202 ALLOCATE(indx(0))
203 ENDIF
204 CALL c3inmas(x,xreftg(1,1,nft+1),ixtg,geo,pm,xmas,in,thk,
205 . partsav,v,ipart(nft+1),mstg(nft+1),intg(nft+1),
206 . ptg(1,nft+1),igeo ,imat ,iprop ,area ,
207 . etnod,nshnod,sttg(nft+1),sh3tree,mcp ,
208 . mcps(nft+1) , temp,sh3trim,isubstack,nlay,
209 . elbuf_str,stack,gbuf%THK_I,rnoise,drape ,
210 . perturb,ix1 ,ix2 ,ix3 ,glob_therm%NINTEMP,
211 . x2l ,x3l ,y3l ,idrape , indx)
212C-----------------------------------------------
213 npt_all = 0
214 DO il=1,nlay
215 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
216 ENDDO
217 mpt = max(1,npt_all)
218 IF(npt_all == 0 ) npt_all = nlay
219 IF (iparg(6) == 0.OR.npt==0) mpt=0
220C
221 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0) THEN
222 ALLOCATE(dir_a(npt_all*nel*2))
223 ALLOCATE(dir_b(npt_all*nel*2))
224 dir_a = zero
225 dir_b = zero
226 ELSE
227 ALLOCATE(dir_a(nlay*nel*2))
228 ALLOCATE(dir_b(nlay*nel*2))
229 dir_a = zero
230 dir_b = zero
231 npt_all = nlay
232 ENDIF
233 nuvar = 0
234 nuvarr = 0
235 IF (mtn>=29) THEN
236 DO i=lft,llt
237 imat = ixtg(1,i+nft)
238 nuvar = max(nuvar,ipm(8,imat))
239 nuvarr = max(nuvarr,ipm(221,imat))
240 ENDDO
241 ENDIF
242C---------------------------
243 CALL cdkevec3(lft ,llt ,area,
244 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
245 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
246 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
247C------------
248C Tags total area of the part (needed in /ADMAS for shells)
249C------------
250 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
251 DO i=lft,llt
252 j = ipart(i+nft)
253C PART_AREA(J) = PART_AREA(J) + AREA(I)
254 ele_area(numelc+i+nft) = area(i)
255 IF (gbuf%G_AREA > 0) gbuf%AREA(i) = area(i)
256 ENDDO
257 ENDIF
258C------------
259 CALL cdkderii(lft,llt,pm,geo,px2,py2,px3,py3,
260 . stifn ,stifr ,ixtg(1,nft+1),thk, sh3tree,
261 . aldt ,bufmat ,ipm ,igeo,stack%PM,
262 . isubstack,strtg(nft+1),group_param,
263 . imat ,iprop,area, dt ,
264 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
265 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
266 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
267C
268 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh3tree,sh3tree)
269c---------------------------
270c---- Init UVAR
271 IF (mtn == 35) THEN
272 CALL cm35in3(elbuf_str,thk,area,nel,nlay,
273 . nptr,npts,nptt,igtyp)
274 ENDIF
275C
276 IF (( isigsh/=0 .OR. ithkshel == 2) .and. mpt>0) THEN
277 CALL layini1(
278 . elbuf_str ,lft ,llt ,geo ,igeo ,
279 . mat ,pid ,matly ,posly ,igtyp ,
280 . nlay ,mpt ,isubstack ,stack ,drape ,
281 . nft ,gbuf%THK ,nel ,idrape ,stdrape ,
282 . indx)
283 END IF
284C------------
285 is = 1
286 DO ir =1,npg
287 ipg = ir
288 ptf = (ir-1)*lenf
289 ptm = (ir-1)*lenm
290 pts = (ir-1)*lens
291c
292 CALL cmaini3(elbuf_str,pm ,geo ,nel ,nlay ,
293 . skew ,igeo ,ixtg(1,nft+1),nixtg ,numeltg ,
294 . nsigsh ,sigsh ,ptsh3n ,igtyp ,iorthloc ,
295 . ipm ,id ,aldt ,mat_param,
296 . ir ,is ,isubstack,stack ,irep ,
297 . drape ,sh3ang(nft+1),geo_stack,igeo_stack,
298 . igmat ,imat ,iprop ,nummat,
299 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
300 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
301 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,x ,
302 . npt_all ,idrape ,stdrape ,indx)
303C-----------------------------------------------------------------------
304C CALCUL DES CONTRAINTES INITIALES
305C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
306 IF ((isigsh /= 0 .OR. ithkshel == 2).AND. ish3n == 30 ) THEN
307 IF (mpt>0)
308 . CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
309 . nlay ,irep ,nel ,
310 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
311 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
312 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
313 . idrape, igtyp)
314 ihbe = 11
315 CALL csigini4(elbuf_str,ihbe ,
316 1 lft ,llt ,nft ,mpt ,istrain,
317 2 gbuf%THK ,gbuf%EINT,gbuf%STRPG(pts+1),gbuf%HOURG,
318 3 gbuf%FORPG(ptf+1),gbuf%MOMPG(ptm+1),sigsh ,nsigsh ,numeltg ,
319 4 ixtg ,nixtg ,numsh3n ,ptsh3n ,igeo ,
320 5 ir ,is ,ir ,npg ,gbuf%G_PLA,
321 6 gbuf%PLA,thk ,igtyp ,nel ,isigsh ,
322 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
323 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
324 ELSEIF ( ithkshel == 1 .AND. ish3n == 30 ) THEN
325 CALL thickini(lft ,llt ,nft ,ptsh3n,numeltg,
326 2 gbuf%THK,thk ,ixtg ,nixtg ,nsigsh ,
327 3 sigsh )
328 ENDIF
329C
330 IF (iuser == 1.AND.mtn>=28) THEN
331 CALL cuserini4(elbuf_str,
332 1 lft ,llt ,nft ,nel ,istrain ,
333 2 sigsh ,nsigsh ,numelc ,ixtg ,nixtg ,
334 3 numsh3n ,ptsh3n ,ir ,is ,npt ,
335 4 igtyp ,igeo ,nlay ,npg ,ipg )
336 ENDIF
337C-----------------------------------------------------------------------
338 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87)) THEN
339 CALL cmatini4(elbuf_str,
340 1 lft ,llt ,nft ,nel ,istrain ,
341 2 sigsh ,nsigsh ,numelc ,ixtg ,nixtg ,
342 3 numsh3n ,ptsh3n ,ir ,is ,npt ,
343 4 igtyp ,igeo ,nlay ,npg ,ipg )
344 ENDIF
345 ENDDO
346C----------------------------------------
347c Failure model initialisation
348C----------------------------------------
349 CALL cfailini4(elbuf_str,nptr ,npts ,nptt ,nlay ,
350 . sigsh ,nsigsh ,ptsh3n ,rnoise ,perturb ,
351 . mat_param,aldt ,thk )
352C-----------------------------------------------------------------------
353C CALCUL DES DEFORMATIONS INITIALES (MEMBRANE)
354C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
355 IF (istrain == 1 .AND. nxref > 0) THEN
356 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR !
357 CALL cdkepsini(elbuf_str,mat_param(imat),
358 . lft ,llt ,ismstr ,mtn ,ithk ,
359 . pm ,geo ,ixtg(1,nft+1),x ,xreftg(1,1,nft+1),
360 . gbuf%FOR,gbuf%THK,gbuf%EINT,gbuf%STRA,
361 . px2 ,py2 ,px3 ,py3 ,x2s ,
362 . y2s ,x3s ,y3s ,gbuf%OFF ,imat ,
363 . uvar ,ipm ,nel ,
364 . nlay ,dir_a ,dir_b ,gbuf%SIGI ,npf ,
365 . tf ,irep )
366c
367 CALL c3epschk(lft, llt,nft, pm, geo,ixtg(1,nft+1),gbuf%STRA,thk,
368 . nel,cpt_eltens)
369c
370 IF (ismstr == 1) iparg(9)=11
371c
372 IF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19)) THEN
373 DO i=lft,llt
374 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
375 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
376 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
377 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
378 ENDDO
379 ENDIF
380C
381 DO ir =1,npg
382 ptf = (ir-1)*lenf
383 ptm = (ir-1)*lenm
384 pts = (ir-1)*lens
385 DO i=lft,llt
386 gbuf%FORPG(ptf+jj(1)+i) = gbuf%FOR(jj(1)+i)
387 gbuf%FORPG(ptf+jj(2)+i) = gbuf%FOR(jj(2)+i)
388 gbuf%FORPG(ptf+jj(3)+i) = gbuf%FOR(jj(3)+i)
389!
390 gbuf%MOMPG(ptm+jj(1)+i) = gbuf%MOM(jj(1)+i)
391 gbuf%MOMPG(ptm+jj(2)+i) = gbuf%MOM(jj(2)+i)
392 gbuf%MOMPG(ptm+jj(3)+i) = gbuf%MOM(jj(3)+i)
393 ENDDO
394 IF (mtn == 58 .and. ir > 1) THEN
395 uvar => elbuf_str%BUFLY(1)%MAT(ir,is,1)%VAR ! law58 => NLAY=1
396 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
397 DO i=1,nel*nuvar
398 uvar(i) = elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR(i)
399 ENDDO
400 END IF
401 ENDDO
402 ENDIF
403C-------------------------------------------
404C CALCUL DES DT ELEMENTAIRES
405C-------------------------------------------
406c IGTYP=GEO(12,IXTG(5,I+NFT))
407 IF (igtyp /= 0 .AND. igtyp /= 1 .AND.
408 . igtyp /= 9 .AND. igtyp /= 10 .AND.
409 . igtyp /= 11 .AND. igtyp /= 16 .AND.
410 . igtyp /= 17 .AND. igtyp /= 51 .AND.
411 . igtyp /= 52 ) THEN
412 CALL ancmsg(msgid=25,
413 . anmode=aninfo,
414 . msgtype=msgerror,
415 . i1=igeo(1,iprop))
416 ENDIF
417 ndepar=numels+numelc+numelt+numelp+numelr+nft
418 DO i=lft,llt
419 dtelem(ndepar+i) = dt(i)
420 ENDDO
421C------------
422 ! Compute the initial volume
423 DO i=lft,llt
424 IF (gbuf%G_VOL > 0) gbuf%VOL(i) = area(i)*gbuf%THK(i)
425 ENDDO
426C
427 DEALLOCATE(dir_a)
428 DEALLOCATE(dir_b)
429 IF(ALLOCATED(indx)) DEALLOCATE(indx)
430C---
431 RETURN
432 END
433!||====================================================================
434!|| cdkpxpyi ../starter/source/elements/sh3n/coquedk/cdkinit3.F
435!||--- called by ------------------------------------------------------
436!|| cdkepsini ../starter/source/elements/sh3n/coquedk/cdkepsini.F
437!||====================================================================
438 SUBROUTINE cdkpxpyi(JFT ,JLT ,ISMSTR ,
439 . PX2G,PY2G,PX3G,PY3G,
440 . PX2 ,PY2 ,PX3 ,PY3 ,
441 . X2 , Y2 ,X3 , Y3 ,
442 . X1G ,X2G ,X3G ,Y1G ,Y2G ,
443 . Y3G ,Z1G ,Z2G ,Z3G ,
444 . E1X ,E2X ,E3X ,E1Y ,E2Y ,
445 . E3Y ,E1Z ,E2Z ,E3Z ,AREA )
446C-----------------------------------------------
447C I m p l i c i t T y p e s
448C-----------------------------------------------
449#include "implicit_f.inc"
450C-----------------------------------------------
451C G l o b a l P a r a m e t e r s
452C-----------------------------------------------
453#include "mvsiz_p.inc"
454C-----------------------------------------------
455C D u m m y A r g u m e n t s
456C-----------------------------------------------
457 INTEGER JFT, JLT, ISMSTR
458C REAL
459 my_real
460 . px2(*), py2(*), px3(*),py3(*),
461 . px2g(*), py2g(*), px3g(*),py3g(*),
462 . x2(*), y2(*), x3(*), y3(*)
463 my_real
464 . x1g(mvsiz), x2g(mvsiz), x3g(mvsiz),
465 . y1g(mvsiz), y2g(mvsiz), y3g(mvsiz),
466 . z1g(mvsiz), z2g(mvsiz), z3g(mvsiz),
467 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
468 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
469 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),area(mvsiz)
470C-----------------------------------------------
471C L o c a l V a r i a b l e s
472C-----------------------------------------------
473 INTEGER I
474 my_real AREAI
475 my_real X21G(MVSIZ), Y21G(MVSIZ), Z21G(MVSIZ),
476 . X31G(MVSIZ), Y31G(MVSIZ), Z31G(MVSIZ)
477C=======================================================================
478C
479 IF (ismstr/=3)THEN
480 DO i=jft,jlt
481 x21g(i)=x2g(i)-x1g(i)
482 y21g(i)=y2g(i)-y1g(i)
483 z21g(i)=z2g(i)-z1g(i)
484 x31g(i)=x3g(i)-x1g(i)
485 y31g(i)=y3g(i)-y1g(i)
486 z31g(i)=z3g(i)-z1g(i)
487 ENDDO
488C
489 DO i=jft,jlt
490 y3(i)=e2x(i)*x31g(i)+e2y(i)*y31g(i)+e2z(i)*z31g(i)
491 x3(i)=e1x(i)*x31g(i)+e1y(i)*y31g(i)+e1z(i)*z31g(i)
492 x2(i)=e1x(i)*x21g(i)+e1y(i)*y21g(i)+e1z(i)*z21g(i)
493 y2(i)=e2x(i)*x21g(i)+e2y(i)*y21g(i)+e2z(i)*z21g(i)
494 ENDDO
495C
496 DO i=jft,jlt
497 areai = half/area(i)
498 px2(i)=y3(i)*areai
499 py2(i)=-x3(i)*areai
500 px3(i)=-y2(i)*areai
501 py3(i)=x2(i)*areai
502 ENDDO
503C
504 ELSE
505C
506 DO i=jft,jlt
507 px2(i) = px2g(i)
508 py2(i) = py2g(i)
509 px3(i) = px3g(i)
510 py3(i) = py3g(i)
511 ENDDO
512C
513 ENDIF
514C
515 RETURN
516 END
517C
518!||====================================================================
519!|| cdkdefoi ../starter/source/elements/sh3n/coquedk/cdkinit3.F
520!||--- called by ------------------------------------------------------
521!|| cdkepsini ../starter/source/elements/sh3n/coquedk/cdkepsini.F
522!||====================================================================
523 SUBROUTINE cdkdefoi(JFT ,JLT ,NEL ,VL ,GSTR ,
524 . PX2 ,PY2 ,PX3 ,PY3 ,
525 . E1X ,E2X ,E3X ,E1Y ,E2Y ,
526 . E3Y ,E1Z ,E2Z ,E3Z ,
527 . EXX ,EYY ,EXY ,EYZ ,EZX )
528C-----------------------------------------------
529C I m p l i c i t T y p e s
530C-----------------------------------------------
531#include "implicit_f.inc"
532C-----------------------------------------------
533C G l o b a l P a r a m e t e r s
534C-----------------------------------------------
535#include "mvsiz_p.inc"
536C-----------------------------------------------
537C D u m m y A r g u m e n t s
538C-----------------------------------------------
539 INTEGER JFT, JLT,NEL
540C REAL
541 my_real
542 . vl(3,3,*),gstr(nel,8),px2(*),py2(*),px3(*),py3(*)
543 my_real
544 . exx(mvsiz) , eyy(mvsiz) , exy(mvsiz) ,
545 . ezx(mvsiz) , eyz(mvsiz) ,
546 . e1x(mvsiz) , e1y(mvsiz) , e1z(mvsiz) ,
547 . e2x(mvsiz) , e2y(mvsiz) , e2z(mvsiz) ,
548 . e3x(mvsiz) , e3y(mvsiz) , e3z(mvsiz)
549C-----------------------------------------------
550C L o c a l V a r i a b l e s
551C-----------------------------------------------
552 INTEGER I
553 my_real VX1(MVSIZ) , VX2(MVSIZ) , VX3(MVSIZ) ,
554 . VY1(MVSIZ) , VY2(MVSIZ) , VY3(MVSIZ) ,
555 . VZ1(MVSIZ) , VZ2(MVSIZ) , VZ3(MVSIZ) ,
556 . VX12(MVSIZ), VX13(MVSIZ),
557 . VY12(MVSIZ), VY13(MVSIZ)
558 my_real TMP1, TMP2, FAC1
559C=======================================================================
560 DO I=jft,jlt
561 vx1(i)=e1x(i)*vl(1,1,i)+e1y(i)*vl(2,1,i)+e1z(i)*vl(3,1,i)
562 vx2(i)=e1x(i)*vl(1,2,i)+e1y(i)*vl(2,2,i)+e1z(i)*vl(3,2,i)
563 vx3(i)=e1x(i)*vl(1,3,i)+e1y(i)*vl(2,3,i)+e1z(i)*vl(3,3,i)
564C
565 vy3(i)=e2x(i)*vl(1,3,i)+e2y(i)*vl(2,3,i)+e2z(i)*vl(3,3,i)
566 vy2(i)=e2x(i)*vl(1,2,i)+e2y(i)*vl(2,2,i)+e2z(i)*vl(3,2,i)
567 vy1(i)=e2x(i)*vl(1,1,i)+e2y(i)*vl(2,1,i)+e2z(i)*vl(3,1,i)
568C
569 vz1(i)=e3x(i)*vl(1,1,i)+e3y(i)*vl(2,1,i)+e3z(i)*vl(3,1,i)
570 vz2(i)=e3x(i)*vl(1,2,i)+e3y(i)*vl(2,2,i)+e3z(i)*vl(3,2,i)
571 vz3(i)=e3x(i)*vl(1,3,i)+e3y(i)*vl(2,3,i)+e3z(i)*vl(3,3,i)
572 ENDDO
573C
574 DO i=jft,jlt
575C
576 vx12(i)=-vx1(i) + vx2(i)
577 vy12(i)=-vy1(i) + vy2(i)
578 vx13(i)=-vx1(i) + vx3(i)
579 vy13(i)=-vy1(i) + vy3(i)
580C
581 exx(i)=px2(i)*vx12(i) + px3(i)*vx13(i)
582 eyy(i)=py2(i)*vy12(i) + py3(i)*vy13(i)
583C
584 exy(i)=py2(i)*vx12(i) + py3(i)*vx13(i)
585 . + px2(i)*vy12(i) + px3(i)*vy13(i)
586 eyz(i)=zero
587 ezx(i)=zero
588 ENDDO
589C
590 DO i=jft,jlt
591 gstr(i,1)=gstr(i,1)+exx(i)
592 gstr(i,2)=gstr(i,2)+eyy(i)
593 gstr(i,3)=gstr(i,3)+exy(i)
594 ENDDO
595C
596 RETURN
597 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:671
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:528
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:446
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: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
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:1249
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
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:889
starter
program starter
Definition starter.F:39
thickini
subroutine thickini(jft, jlt, nft, ptsh, numel, thk, thke, ix, nix, nsigsh, sigsh)
Definition thickini.F:36