58 1 ELBUF_STR ,JFT ,JLT ,NFT ,IPARG ,
59 2 NEL ,MTN ,IPLA ,ITHK ,GROUP_PARAM,
60 3 PM ,GEO ,NPF ,TF ,BUFMAT ,
61 4 SSP ,RHO ,VISCMX ,DT1C ,SIGY ,
62 5 AREA ,EXX ,EYY ,EXY ,EXZ ,
63 6 EYZ ,KXX ,KYY ,KXY ,NU ,
64 7 OFF ,THK0 ,MAT ,PID ,MAT_ELEM ,
65 8 FOR ,MOM ,GSTR ,FAILWAVE ,FWAVE_EL ,
67 A G ,A11 ,A12 ,VOL0 ,INDXDEL ,
68 B NGL ,ZCFAC ,SHF ,GS ,EPSD_PG ,
70 D DIR_A ,DIR_B ,IGEO ,
71 E IPM ,IFAILURE ,NPG ,FHEAT ,
72 F TEMPEL ,DIE ,JTHE ,IEXPAN ,TEMPEL0 ,
73 G ISHPLYXFEM,PLY_EXX ,
74 H PLY_EYY ,PLY_EXY ,PLY_EXZ ,PLY_EYZ ,PLY_F ,
75 I DEL_PLY ,TH_IPLY ,SIG_IPLY ,E1X ,E1Y ,
76 J E1Z ,E2X ,E2Y ,E2Z ,E3X ,
77 K E3Y ,E3Z ,NG ,TABLE ,IXFEM ,
78 L OFFI ,SENSORS ,A11_IPLY ,ELCRKINI ,
79 M DIR1_CRK ,DIR2_CRK ,ALDT ,IDT_THERM ,THEACCFACT ,
80 N ISMSTR ,IR ,IS ,NLAY ,NPT ,
81 O IXLAY ,IXEL ,ISUBSTACK ,STACK ,
82 P F_DEF ,ITASK ,DRAPE ,VARNL ,NLOC_DMG ,
83 R INDX_DRAPE,THKE ,SEDRAPE ,NUMEL_DRAPE,DT ,
84 Q NCYCLE , SNPC ,STF ,NXLAYMAX ,IDEL7NOK ,
85 S USERL_AVAIL, MAXFUNC ,VARNL_NPTTOT, SBUFMAT ,SDIR_A ,
86 T SDIR_B ,FOR_G ,SSP_EQ ,IPART ,LIPART1,
105#include "implicit_f.inc"
109#include "mvsiz_p.inc"
113#include "param_c.inc"
114#include "com04_c.inc"
115#include "com08_c.inc"
116#include "scr18_c.inc"
117#include "impl1_c.inc"
118#include "timeri_c.inc"
122 TYPE(),
INTENT(INOUT) :: TIMERS
123 INTEGER,
INTENT(IN) :: USERL_AVAIL
124 INTEGER,
INTENT(IN) :: MAXFUNC
125 INTEGER,
INTENT(INOUT) :: IDEL7NOK
126 INTEGER,
INTENT(IN) :: NXLAYMAX
127 INTEGER,
INTENT(IN) :: VARNL_NPTTOT
128 INTEGER,
INTENT(IN) :: SBUFMAT
129 INTEGER,
INTENT(IN) :: SDIR_A
130 INTEGER,
INTENT(IN) :: SDIR_B
131 INTEGER,
INTENT(IN) :: STF
132 INTEGER,
INTENT(IN) :: SNPC
133 INTEGER JFT,JLT,NFT,IR,IS,NPT,NG,NPG,NLAY,NEL,MTN,IPLA,IOFC,ITHK,
134 . KFTS,JHBE,IFAILURE,JTHE,IEXPAN,ISHPLYXFEM,ISMSTR,
135 . IXLAY,IXEL,IXFEM,ISUBSTACK,ITASK , NCYCLE
136 INTEGER ,
INTENT(IN) :: SEDRAPE,NUMEL_DRAPE
137 INTEGER MAT(MVSIZ), PID(MVSIZ), INDXDEL(MVSIZ), NGL(MVSIZ),NPF(*),
138 . IGEO(NPROPGI,*),IPM(NPROPMI,*),IPARG(*),
139 . A11_IPLY(MVSIZ,*),ELCRKINI(*),FWAVE_EL(NEL)
140 INTEGER ,
DIMENSION(SEDRAPE) :: INDX_DRAPE
141 INTEGER,
INTENT(IN) :: IDT_THERM
142 my_real ,
intent(in) :: THEACCFACT
143 my_real ,
dimension(mvsiz) ,
intent(in) :: EPSD_PG
144 my_real PM(NPROPM,*), GEO(NPROPG,*),TF(*),THK(*),EINT(JLT,*),FOR(NEL,5),
145 . MOM(NEL,3),GSTR(NEL,8),BUFMAT(*),G(*),A11(*),A12(*),VOL0(*),
146 . SHF(*),GS(*),SIGY(MVSIZ),(MVSIZ),SSP(MVSIZ),VISCMX(MVSIZ),
147 . OFF(MVSIZ) ,THK0(MVSIZ) ,NU(MVSIZ),DT1C(MVSIZ),
148 . EXX(MVSIZ), EYY(MVSIZ), EXY(MVSIZ), EXZ(MVSIZ), EYZ(MVSIZ),
149 . KXX(MVSIZ), KYY(MVSIZ), KXY(MVSIZ), AREA(MVSIZ),
150 . ZCFAC(,2),ALPE(MVSIZ),DIR_A(SDIR_A),DIR_B(SDIR_B),TEMPEL(*),DIE(*),
151 . TEMPEL0(MVSIZ), PLY_F(MVSIZ,5,*),
152 . ply_exx(mvsiz,*),ply_eyy(mvsiz,*),ply_exy(mvsiz,*),
153 . ply_exz(mvsiz,*),ply_eyz(mvsiz,*),del_ply(mvsiz,3,*) ,
154 . th_iply(mvsiz,*), sig_iply(mvsiz,3,*),
155 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
156 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
157 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),offi(mvsiz,*),
158 . dir1_crk(*),dir2_crk(*),
159 . f_def(mvsiz,*),aldt(mvsiz),varnl(nel,*)
160 my_real,
DIMENSION(NEL),
INTENT(IN) :: thke
161 my_real,
dimension(mvsiz),
intent(inout) :: fheat
162 my_real,
dimension(mvsiz),
intent( out) :: ssp_eq
163 TYPE (TTABLE) TABLE(*)
164 TYPE (ELBUF_STRUCT_),
TARGET :: ELBUF_STR
165 TYPE (STACK_PLY) :: STACK
166 TYPE (FAILWAVE_STR_) ,
TARGET :: FAILWAVE
167 TYPE (GROUP_PARAM_) :: GROUP_PARAM
168 TYPE (DRAPE_) :: DRAPE(NUMEL_DRAPE)
169 TYPE (MAT_ELEM_) ,
INTENT(INOUT) :: MAT_ELEM
170 TYPE (NLOCAL_STR_) :: NLOC_DMG
171 TYPE (SENSORS_) ,
INTENT(IN) :: SENSORS
172 TYPE (DT_),
INTENT(IN) :: DT
173 my_real,
dimension(nel,5),
intent(inout) :: for_g
174 integer,
intent(in) :: LIPART1
176 INTEGER,
DIMENSION(LIPART1,NPART),
INTENT(IN) :: IPART
177 INTEGER,
DIMENSION(NEL),
INTENT(IN) :: IPARTC
181 INTEGER I,J,IT,MX,IGTYP,IFUNC_ALPHA,IPMAT_IPLY,ILAW,ILAY,LAYNPT_MAX,NLAY_MAX
182 INTEGER MAT_IPLY(MVSIZ,NPT),IDAMP_FREQ_RANGE
183 INTEGER MAT_USR,MAT_RAD
184 INTEGER,
DIMENSION(:) ,
ALLOCATABLE :: MATLY
185 my_real,
DIMENSION(:) ,
ALLOCATABLE :: THKLY
186 my_real,
DIMENSION(:,:),
ALLOCATABLE :: POSLY,THK_LY
187 my_real DTEMP(MVSIZ),ETIMP(MVSIZ),TENS(NEL,5),ETH(MVSIZ)
188 my_real EPSYZ(MVSIZ),EPSZX(MVSIZ)
189 my_real ALPHA,DF,DEINTTH,FSCAL_ALPHA,DM,ZSHIFT
192 TYPE(l_bufel_) ,
POINTER :: LBUF
193 TYPE(g_bufel_) ,
POINTER :: GBUF
194 TYPE(buf_damp_range_) ,
POINTER :: DAMP_BUF
199 gbuf => elbuf_str%GBUF
200 igtyp=igeo(11,pid(1))
202 dm = group_param%VISC_DM
203 IF (impl_s>0) dm = zero
204 idamp_freq_range = iparg(93)
205 damp_buf => elbuf_str%DAMP_RANGE
206 zcfac(1:mvsiz,1:2) = zero
213 ilaw = elbuf_str%bufly(ilay)%ilaw
214 if (ilaw > 28 .and. ilaw < 32 .or. ilaw == 99 .or. ilaw == 200)
then
222 IF (jthe > 0 .AND. (mtn < 28 .OR. mtn == 32))
THEN
223 die(jft:jlt) = eint(jft:jlt,1) + eint(jft:jlt,2)
228 IF (iexpan > 0 .AND. jthe > 0)
THEN
230 IF (tt == zero) tempel0(jft:jlt) = tempel(jft:jlt)
231 dtemp(jft:jlt) = tempel(jft:jlt) - tempel0(jft:jlt)
232 tempel0(jft:jlt) = tempel(jft:jlt)
234 IF (igtyp /= 11 .AND. igtyp /= 17 .AND. igtyp /=51 .AND. igtyp /= 52)
THEN
235 ifunc_alpha = ipm(219, mx)
236 fscal_alpha = pm(191, mx)
238 alpha = finter(ifunc_alpha,tempel(i),npf,tf,df)
239 alpha = alpha * fscal_alpha
240 eth(i) = alpha*dtemp(i)
241 deintth = -half*(for(i,1) + for(i,2))*eth(i)*thk0(i)*area(i)
242 gbuf%EINTTH(i) = gbuf%EINTTH(i) + deintth
243 eint(i,1) = eint(i,1) + deintth
249 IF(igtyp == 51 .OR. igtyp == 52)
THEN
251 laynpt_max =
max(laynpt_max , elbuf_str%BUFLY(ilay)%NPTT)
254 nlay_max =
max(nlay,npt,ixlay, elbuf_str%NLAY)
255 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
256 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
264 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
265 zshift = geo(199, pid(1))
268 1 jft ,jlt ,pm ,for ,mom ,thk ,
269 2 eint ,off ,gstr ,dir_a ,shf ,
270 3 mat ,area ,exx ,eyy ,exy ,nel ,
271 4 exz ,eyz ,kxx ,kyy ,kxy ,dm ,
272 5 pid ,tf ,npf ,mtn ,dt1c ,a11 ,
273 6 bufmat ,ssp ,rho ,viscmx ,iofc ,a12 ,
274 7 indxdel ,ngl ,zcfac ,gs ,sigy ,g ,
275 8 thk0 ,epsd_pg,ipla ,igeo ,ipm ,table ,
276 9 ir ,is ,f_def ,ismstr ,nu ,vol0 ,
277 a kfts ,zshift ,idamp_freq_range,mat_elem,damp_buf ,
279 ssp_eq(jft:jlt) = ssp(jft:jlt)
281 ELSE IF (mat_usr == 1)
THEN
284 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
285 . mat ,pid ,thkly ,matly ,posly ,
286 . igtyp ,ixfem ,ixlay ,nlay ,npt ,
287 . isubstack,stack ,drape ,nft ,thke ,
288 . nel ,thk_ly ,indx_drape,sedrape ,numel_drape)
291 1 jft ,jlt ,nel ,pm ,for ,mom ,
292 2 gstr ,thk ,eint ,off ,dir_a ,dir_b ,
293 3 mat ,area ,exx ,eyy ,exy ,exz ,
294 4 eyz ,kxx ,kyy ,kxy ,geo ,thk_ly ,
295 5 pid ,tf ,npf ,dt1c ,dm ,
296 6 bufmat ,ssp ,rho ,viscmx ,ipla ,iofc ,
297 7 indxdel ,ngl ,thkly ,zcfac ,ng ,
298 8 shf ,sigy ,thk0 ,epsd_pg,
299 9 posly ,igeo ,ipm ,failwave,fwave_el,
300 a ifailure,aldt ,tempel ,die ,
301 b e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,
302 c e3x ,e3y ,e3z ,table ,ixfem ,elcrkini,
303 d dir1_crk,dir2_crk,iparg ,jhbe ,ismstr ,jthe ,
304 e tens ,ir ,is ,nlay ,npt ,ixlay ,
305 f ixel ,f_def ,itask ,stack%PM ,isubstack,stack ,
306 g varnl ,nloc_dmg,nlay_max,laynpt_max,dt ,ssp_eq ,
314 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
315 . mat ,pid ,thkly ,matly ,posly ,
316 . igtyp ,ixfem ,ixlay ,nlay ,npt ,
317 . isubstack,stack ,drape ,nft ,thke ,
318 . nel ,thk_ly ,indx_drape, sedrape,numel_drape)
320 CALL mulawc(timers,elbuf_str ,
321 1 jft ,jlt ,nel ,pm ,for ,mom ,
322 2 gstr ,thk ,eint ,off ,dir_a ,dir_b ,
323 3 mat ,area ,exx ,eyy ,exy ,exz ,
324 4 eyz ,kxx ,kyy ,kxy ,geo ,thk_ly ,
325 5 pid ,tf ,npf ,mtn ,dt1c ,dm ,
326 6 bufmat ,ssp ,rho ,viscmx ,ipla ,iofc ,
328 8 shf ,gs ,sigy ,thk0 ,epsd_pg ,vol0 ,
329 9 posly ,igeo ,ipm ,failwave,fwave_el,
330 a ifailure,aldt ,tempel ,die ,fheat ,
331 b table ,ixfem ,elcrkini,
332 d sensors ,ng ,idt_therm,theaccfact,
333 e dir1_crk,dir2_crk,iparg ,jhbe ,ismstr ,jthe ,
334 f tens ,ir ,is ,nlay ,npt ,ixlay ,
335 g ixel ,ithk ,f_def ,ishplyxfem,
336 h itask ,isubstack,stack ,alpe ,
337 i ply_exx ,ply_eyy ,ply_exy ,ply_exz ,ply_eyz ,ply_f ,
338 j varnl ,etimp ,nloc_dmg,nlay_max,laynpt_max ,dt,
339 k ncycle ,snpc ,stf,impl_s ,imconv ,npropgi,
340 * npropmi ,npropm ,npropg,imon_mat,numgeo ,
341 * numstack, dt1 ,tt ,nxlaymax ,idel7nok,userl_avail,
342 * maxfunc,nummat,varnl_npttot, sbufmat ,sdir_a ,sdir_b ,nparg
343 * idamp_freq_range,damp_buf ,ssp_eq ,ipart ,lipart1,
347 IF (iexpan > 0 .AND. jthe > 0. and. idt_therm==0)
THEN
349 1 jft ,jlt ,gbuf%FORTH ,for ,eint ,
350 2 off ,eth ,thk0 ,exx ,eyy ,
351 3 pm ,npt ,area ,a11 ,a12 ,
352 4 mat ,mtn ,gbuf%EINTTH ,dir_a ,ir ,
353 5 is ,nlay ,thk ,nel ,igtyp ,
354 6 npf , tf , ipm ,tempel ,dtemp,
355 7 thkly ,posly,mom, matly )
358 IF (jthe > 0 .AND. (mtn < 28 .OR. mtn == 32))
THEN
360 die(i) = (eint(i,1) + eint(i,2) - die(i)) * pm(90,mat(1))
364 gbuf%TEMP(1:nel) = tempel(1:nel)
369 IF (ishplyxfem > 0)
THEN
370 ipmat_iply = 2 + 2*npt
373 mat_iply(i,j) = stack%IGEO(ipmat_iply + j ,isubstack)
382 . jft ,jlt ,ir ,is ,npt ,
383 . mat_iply ,ipm ,pm ,bufmat ,npf ,
384 . tf ,dt1c ,ngl ,off ,th_iply ,
385 . del_ply ,sig_iply ,offi ,a11_iply,for ,
386 . mom ,ply_f ,thk0 ,shf ,epszx ,
387 . epsyz ,area ,pid ,geo ,ssp ,
388 . posly ,thkly ,kxx ,kyy ,kxy ,
389 . exz ,eyz ,eint ,gstr ,nel ,
395 IF (mtn /=78) etimp(jft:jlt) = zcfac(jft:jlt,1)
398 DEALLOCATE(matly, thkly, posly, thk_ly)
subroutine c3forc3_crk(timers, xfem_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, crksky, iadtg, epsdot, offset, iparttg, thke, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, kfts, group_param, mat_elem, nel, istrain, ish3n, ithk, iofc, ipla, nft, ismstr, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, sensors, ptg, ixfem, inod_crk, iel_crk, iadtg_crk, elcutc, ixel, stack, isubstack, uxint_mean, uyint_mean, uzint_mean, nlevxf, nodedge, crkedge, drape_sh3n, ipri, nloc_dmg, indx_drape, igre, dt, ncycle, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine cmain3(timers, elbuf_str, jft, jlt, nft, iparg, nel, mtn, ipla, ithk, group_param, pm, geo, npf, tf, bufmat, ssp, rho, viscmx, dt1c, sigy, area, exx, eyy, exy, exz, eyz, kxx, kyy, kxy, nu, off, thk0, mat, pid, mat_elem, for, mom, gstr, failwave, fwave_el, thk, eint, iofc, g, a11, a12, vol0, indxdel, ngl, zcfac, shf, gs, epsd_pg, kfts, jhbe, alpe, dir_a, dir_b, igeo, ipm, ifailure, npg, fheat, tempel, die, jthe, iexpan, tempel0, ishplyxfem, ply_exx, ply_eyy, ply_exy, ply_exz, ply_eyz, ply_f, del_ply, th_iply, sig_iply, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ng, table, ixfem, offi, sensors, a11_iply, elcrkini, dir1_crk, dir2_crk, aldt, idt_therm, theaccfact, ismstr, ir, is, nlay, npt, ixlay, ixel, isubstack, stack, f_def, itask, drape, varnl, nloc_dmg, indx_drape, thke, sedrape, numel_drape, dt, ncycle, snpc, stf, nxlaymax, idel7nok, userl_avail, maxfunc, varnl_npttot, sbufmat, sdir_a, sdir_b, for_g, ssp_eq, ipart, lipart1, ipartc)