67
68
69
70 USE mat_elem_mod
73 USE group_param_mod
76 use glob_therm_mod
77 use initemp_shell_mod
78
79
80
81#include "implicit_f.inc"
82
83
84
85#include "mvsiz_p.inc"
86
87
88
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"
95
96
97
98 INTEGER IXTG(NIXTG,*),IPART(*), , 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
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
116 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
117 TYPE (glob_therm_) ,intent(in) :: glob_therm
118
119
120
121 INTEGER I,J,,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
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
141 . DIMENSION(:) ,POINTER :: uvar
142 parameter(laynpt_max = 10)
143 parameter(lay_max = 100)
144 INTEGER MATLY(MVSIZ*LAY_MAX)
146 . posly(mvsiz,lay_max*laynpt_max)
147
148 TYPE(BUF_LAY_) ,POINTER :: BUFLY
149 TYPE(L_BUFEL_) ,POINTER :: LBUF
150 TYPE(G_BUFEL_) ,POINTER :: GBUF
151
152 gbuf => elbuf_str%GBUF
153 iorthloc = 0
154 imat = ixtg(1,1+nft)
155 iprop = ixtg(nixtg-1,1+nft)
156
157 igtyp = igeo(11,iprop)
158 igmat = igeo(98,iprop)
160 irep = iparg(35)
161
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
175
176 DO i=lft,llt
177 mat(i) = imat
178 pid(i) = iprop
179 ENDDO
180
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 )
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 )
190
191
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
196
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)
212
213 npt_all = 0
214 DO il=1,nlay
215 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
216 ENDDO
218 IF(npt_all == 0 ) npt_all = nlay
219 IF (iparg(6) == 0.OR.npt==0) mpt=0
220
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
242
244 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
245 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
246 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
247
248
249
250 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
251 DO i=lft,llt
252 j = ipart(i+nft)
253
254 ele_area(numelc+i+nft) =
area(i)
255 IF (gbuf%G_AREA > 0) gbuf%AREA(i) =
area(i)
256 ENDDO
257 ENDIF
258
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 )
267
268 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh3tree,sh3tree)
269
270
271 IF (mtn == 35) THEN
273 . nptr,npts,nptt,igtyp)
274 ENDIF
275
276 IF (( isigsh/=0 .OR. ithkshel == 2) .and. mpt>0) THEN
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
284
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
291
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)
303
304
305
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
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
329
330 IF (iuser == 1.AND.mtn>=28) THEN
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
337
338 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87)) THEN
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
346
347
348
349 CALL cfailini4(elbuf_str,nptr ,npts ,nptt ,nlay ,
350 . sigsh ,nsigsh ,ptsh3n ,rnoise ,perturb ,
351 . mat_param,aldt ,thk )
352
353
354
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 )
366
367 CALL c3epschk(lft, llt,nft, pm, geo,ixtg(1,nft+1),gbuf%STRA,thk,
368 . nel,cpt_eltens)
369
370 IF (ismstr == 1) iparg(9)=11
371
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(
376 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
377 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
378 ENDDO
379 ENDIF
380
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
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
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
403
404
405
406
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
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
421
422
423 DO i=lft,llt
424 IF (gbuf%G_VOL > 0) gbuf%VOL(i) =
area(i)*gbuf%THK(i)
425 ENDDO
426
427 DEALLOCATE(dir_a)
428 DEALLOCATE(dir_b)
429 IF(ALLOCATED(indx)) DEALLOCATE(indx)
430
431 RETURN
subroutine c1buf3(geo, thk, off, thke, kshtree, shtree)
subroutine c3coori(x, xreftg, ixp, ngl, x1, x2, x3, y1, y2, y3, z1, z2, z3, ix1, ix2, ix3)
subroutine c3epschk(jft, jlt, nft, pm, geo, ixtg, gstr, thk, nel, cpt_eltens)
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)
subroutine c3veok3(nvc, ix1, ix2, ix3)
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)
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)
subroutine cdkevec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine cfailini4(elbuf_str, nptr, npts, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, mat_param, aldt, thk)
subroutine cm35in3(elbuf_str, thk, area, nel, nlay, nptr, npts, nptt, igtyp)
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)
subroutine cmatini4(elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)
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)
subroutine cuserini4(elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)
subroutine area(d1, x, x2, y, y2, eint, stif0)
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)
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)
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)
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)
subroutine thickini(jft, jlt, nft, ptsh, numel, thk, thke, ix, nix, nsigsh, sigsh)