56 1 ELBUF_STR,JFT ,JLT ,NEL ,
57 2 MTN ,ISMSTR ,PM ,NCC ,
59 4 R ,GEO ,PARTSAV ,DT2T ,
60 5 NELTST ,ITYPTST ,STIFN ,STIFR ,
61 6 FSKY ,IADP ,OFFSET ,IPARTP ,
62 7 TANI ,FX1 ,FX2 ,FY1 ,
63 8 FY2 ,FZ1 ,FZ2 ,MX1 ,
64 9 MX2 ,MY1 ,MY2 ,MZ1 ,
65 A MZ2 ,IGEO ,IPM ,BUFMAT ,
66 B NPT ,NPF ,TF ,GRESAV ,
67 C GRTH ,IGRTH ,MSP ,DMELP ,
68 D IOUTPRT ,ITASK ,JTHE ,TEMP ,
69 E FTHE ,FTHESKY ,IEXPAN ,H3D_DATA ,
70 F JSMS ,IGRE ,NFT ,IFAIL ,
71 G SBUFMAT ,SNPC ,STF ,NUMMAT ,
72 H NUMGEO ,IOUT ,ISTDO ,IDEL7NOK ,
73 I IDYNA ,IMCONV ,IMPL_S ,MAT_PARAM,
74 J PRELD1 ,STF_F ,DT ,SENSORS ,
88#include "implicit_f.inc"
103 INTEGER,
INTENT(IN) :: NFT,IGRE,,IFAIL
104 INTEGER ,
INTENT(IN) :: SBUFMAT
105 INTEGER ,
INTENT(IN) :: SNPC
106 INTEGER ,
INTENT(IN) :: STF
107 INTEGER ,
INTENT(IN) :: NUMMAT
108 INTEGER ,
INTENT(IN) :: NUMGEO
109 INTEGER ,
INTENT(IN) :: IOUT
110 INTEGER ,
INTENT(IN) :: ISTDO
111 INTEGER ,
INTENT(IN) :: IMPL_S
112 INTEGER ,
INTENT(IN) :: IDYNA
113 INTEGER ,
INTENT(IN) :: IMCONV
114 INTEGER ,
INTENT(INOUT) :: IDEL7NOK
115 INTEGER,
INTENT(IN) :: NTABLE
116 TYPE(TTABLE),
DIMENSION(NTABLE),
INTENT(INOUT) :: TABLE
117 INTEGER NCC(NIXP,*),IADP(2,*),IPARTP(*),IGEO(NPROPGI,*),
118 . IPM(NPROPMI,*),NPF(*),GRTH(*),(*)
119 INTEGER JFT,JLT,NELTST,ITYPTST,OFFSET,NEL,JTHE,
120 . MTN,ISMSTR,NPT,,ITASK,IEXPAN
122 . PM(NPROPM,*), X(*), F(*), M(*), V(*), R(*),GEO(NPROPG,*),TF(*),
123 . bufmat(*),partsav(*),stifn(*),stifr(*),fsky(*),tani(15,*),
124 . fx1(mvsiz),fy1(mvsiz
125 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
126 . mx1(mvsiz),my1(mvsiz),mz1(mvsiz),
127 . mx2(mvsiz),my2(mvsiz),mz2(mvsiz),
128 . gresav(*),msp(*),dmelp(*),temp(*),fthe(*),
130 my_real,
INTENT(IN) :: preld1,stf_f
132 TYPE (ELBUF_STRUCT_),
TARGET :: ELBUF_STR
133 TYPE (H3D_DATABASE) :: H3D_DATA
134 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
135 TYPE (DT_),
INTENT(IN) :: DT
136 type (sensors_),
INTENT(INOUT) :: SENSORS
140 INTEGER I,IFLAG,IGTYP,NUPARAM,NUVAR,NFUNC,IFUNC_ALPHA,IMAT
141 INTEGER MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ),IFUNC(100),
142 . NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),IPT
144 . STI(MVSIZ),STIR(MVSIZ),OFF(MVSIZ),AL(MVSIZ),EXX(MVSIZ),
145 . EXY(MVSIZ),EXZ(MVSIZ),KXX(MVSIZ),KYY(MVSIZ),KZZ(MVSIZ),
146 . F1(MVSIZ),F2(MVSIZ),F3(MVSIZ),M1(MVSIZ),M2(MVSIZ),M3(MVSIZ),
147 . X1(MVSIZ),X2(MVSIZ),X3(MVSIZ),Y1(MVSIZ),Y2(MVSIZ),
148 . Y3(MVSIZ),Z1(MVSIZ),Z2(MVSIZ),Z3(MVSIZ),RX1G(MVSIZ),RX2G(MVSIZ),
149 . RY1G(MVSIZ),RY2G(MVSIZ),RZ1G(MVSIZ),RZ2G(MVSIZ),
150 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
151 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),vx1g(mvsiz),vx2g(mvsiz),
152 . vy1g(mvsiz),vy2g(mvsiz),vz1g(mvsiz),vz2g(mvsiz),
153 . f11(mvsiz), f12(mvsiz), f21(mvsiz),
154 . f22(mvsiz), f31(mvsiz), f32(mvsiz),
155 . m11(mvsiz), m12(mvsiz), m21(mvsiz),
156 . m22(mvsiz), m31(mvsiz), m32(mvsiz),tempel(mvsiz),dtemp(mvsiz),
157 . fscal_alpha,eth(mvsiz),deintth,
alpha,df,vl12(mvsiz),dtinv
159 my_real :: kc,phix, ca,cb,
area, fphi(mvsiz,2),die(mvsiz)
160 my_real ,
DIMENSION(NEL) :: sigx,sapt,vecnul
161 my_real ,
DIMENSION(:) ,
POINTER :: uvar
162 my_real ,
DIMENSION(:) ,
POINTER :: el_temp
163 TYPE(g_bufel_) ,
POINTER :: GBUF
164 TYPE(BUF_LAY_) ,
POINTER :: BUFLY
165 TARGET :: TEMPEL,VECNUL
170 GBUF => elbuf_str%GBUF
175 2 ngl, nc1, nc2, nc3,
180 1 gbuf%SKEW,r, al, nc1,
184 5 rx2g, ry1g, ry2g, rz1g,
185 6 rz2g, e1x, e1y, e1z,
188 IF (ismstr /= 0)
CALL ppxpy3(
189 1 gbuf%LENGTH,al, nel)
190 igtyp = igeo(11,pid(1))
193 2 gbuf%OFF, dt2t, neltst, ityptst,
194 3 sti, stir, msp, dmelp,
195 4 gbuf%G_DT,gbuf%DT, al, mat,
196 5 pid, ngl, nel, igtyp,
201 3 e1x, e1y, e1z, e2x,
202 4 e2y, e2z, e3x, e3y,
203 5 e3z, vx1g, vx2g, vy1g,
204 6 vy2g, vz1g, vz2g, nel)
206 1 r, geo, gbuf%OFF,off,
207 2 exx, exy, exz, kxx,
209 4 nc2, nc3, rx1g, rx2g,
210 5 ry1g, ry2g, rz1g, rz2g,
211 6 e1x, e1y, e1z, e2x,
212 7 e2y, e2z, e3x, e3y,
216 nuparam = ipm(9,mat(1))
221 tempel(i) = half *( temp(nc1(i)) + temp(nc2(i)))
222 die(i) = gbuf%EINT(i) + gbuf%EINT(nel + i)
226 IF (iexpan > 0 .AND. jthe > 0)
THEN
227 IF (tt == zero) gbuf%TEMP(1:nel) = tempel(1:nel)
228 dtemp(1:nel) = tempel(1:nel) - gbuf%TEMP(1:nel)
229 gbuf%TEMP(1:nel) = tempel(1:nel)
232 ifunc_alpha = ipm(219, mat(i))
233 fscal_alpha = pm(191, mat(i))
234 alpha = fscal_alpha*finter(ifunc_alpha,tempel(i),npf,tf,df)
235 eth(i) =
alpha*dtemp(i)
236 deintth = - half*gbuf%FOR(i)*eth(i)*al(i)*off(i)
237 gbuf%EINTTH(i) = gbuf%EINTTH(i) + deintth
242 el_temp => tempel(1:nel)
243 else if (igtyp == 3)
then
244 if (elbuf_str%gbuf%g_temp > 0)
then
245 el_temp => elbuf_str%gbuf%temp
247 el_temp => vecnul(1:nel
249 else if (igtyp == 18)
then
250 if (elbuf_str%bufly(1)%l_temp > 0)
then
251 el_temp => elbuf_str%bufly(1)%lbuf(1,1,1)%temp
253 el_temp => vecnul(1:nel)
263 . elbuf_str,nel ,mtn ,jthe ,ifail ,
264 . ipm ,pm ,geo ,el_temp ,off ,
265 . mat ,pid ,ngl ,tt ,dt1 ,
266 . al ,npf ,tf ,exx ,exy ,
267 . exz ,kxx ,kyy ,kzz ,f1 ,
268 . f2 ,f3 ,m1 ,m2 ,m3 ,
269 . bufmat ,npropg ,npropmi ,npropm ,nummat ,
270 . numgeo ,sbufmat ,snpc ,stf ,iout ,
271 . istdo ,nuvar ,uvar ,gbuf%EPSD,imat ,
272 . gbuf%FOR ,gbuf%MOM ,gbuf%EINT,ismstr ,mat_param(imat),
275 ELSEIF (igtyp == 18)
THEN
278 1 nel ,npt ,mtn ,imat ,
279 2 pid ,ngl ,pm ,ipm ,
280 3 geo ,off ,gbuf%FOR ,gbuf%MOM ,
281 4 gbuf%EINT ,al ,gbuf%EPSD ,bufmat ,npf ,
282 5 tf ,exx ,exy ,exz ,kxx ,
283 6 kyy ,kzz ,f1 ,f2 ,f3 ,
284 7 m1 ,m2 ,m3 ,jthe ,el_temp ,
285 8 ifail ,sbufmat ,snpc ,stf ,nummat ,
287 a npropg ,tt ,dt1 ,idel7nok ,isigi ,
288 b imconv ,ismstr ,mat_param(imat),
294 CALL pdamp3(pm ,geo ,off ,imat ,pid(1),
295 . nel ,ngl ,exx ,exy ,exz ,
296 . kxx ,kyy ,kzz ,al ,f1 ,
297 . f2 ,f3 ,m1 ,m2 ,m3 ,
298 . impl_s ,idyna ,dt1 )
306 . off ,eth ,gbuf%FOR ,gbuf%EINT )
308 ELSEIF(igtyp == 18)
THEN
310 . nel ,npt ,mat ,pid ,pm ,
311 . geo ,al ,eth ,off ,gbuf%FOR ,
316 deintth = -half*gbuf%FOR(i)*eth(i)*al(i)*off(i)
317 gbuf%EINT(i) = gbuf%EINT(i) + deintth
321 die(i) = (gbuf%EINT(i) + gbuf%EINT(nel + i) - die(i))*pm(90,mat(i))
327 iflag = mod(ncycle,ncpri)
331 2 partsav, ipartp, tani, gbuf%FOR,
332 3 gbuf%MOM, gresav, grth, igrth,
333 4 gbuf%OFF, nel, al, nc1,
335 6 e1z, e2x, e2y, e2z,
336 7 mat, pid, vx1g, vx2g,
337 8 vy1g, vy2g, vz1g, vz2g,
339 a z1, z2, itask, h3d_data,
340 b igre, sensors,gbuf%G_WPLA,gbuf%WPLA)
344 IF (preld1>zero)
THEN
345 dtinv = dt1/
max(dt1**2,em20)
347 vl12(i) = exx(i)*dtinv
349 CALL preload_axial(nel,preld1,gbuf%BPRELD,vl12,stf_f,f1 )
350 IF (igtyp == 18)
THEN
354 sapt(i) = sapt(i) + geo(400+ipt,pid(i))
359 elbuf_str%BUFLY(1)%LBUF(1,1,ipt)%SIG(1:nel) = sigx(1:nel
362 gbuf%FOR(1:nel) = f1(1:nel)
367 CALL pfint3(gbuf%FOR ,gbuf%MOM ,geo ,gbuf%OFF ,off,
369 . m2 ,m3 ,sti ,stir ,nel,
370 . pid ,f11 ,f12 ,f21 ,f22,
371 . f31 ,f32 ,m11 ,m12 ,m21,
382 kc = (ca + cb*tempel(i))*dt2t *
area/al(i)
383 phix = kc*(temp(nc2(i)) - temp(nc1(i)))
387 fphi(i,1) = half * die(i) + phix
388 fphi(i,2) = half * die(i) - phix
394 IF (iparit == 0)
THEN
396 1 f, sti, stifn, fx1,
397 2 fx2, fy1, fy2, fz1,
398 3 fz2, nc1, nc2, nc3,
399 4 e1x, e1y, e1z, e2x,
400 5 e2y, e2z, e3x, e3y,
401 6 e3z, f11, f12, f21,
402 7 f22, f31, f32, fphi,
405 1 m, stir, stifr, mx1,
406 2 mx2, my1, my2, mz1,
407 3 mz2, nc1, nc2, nc3,
408 4 e1x, e1y, e1z, e2x,
409 5 e2y, e2z, e3x, e3y,
410 6 e3z, m11, m12, m21,
411 7 m22, m31, m32, nel)
414 1 sti, fsky, fsky, iadp,
415 2 fx1, fx2, fy1, fy2,
416 3 fz1, fz2, nc1, nc2,
417 4 nc3, e1x, e1y, e1z,
418 5 e2x, e2y, e2z, e3x,
419 6 e3y, e3z, f11, f12,
420 7 f21, f22, f31, f32,
421 8 fphi, fthesky, nel, nft,
425 1 stir, fsky, fsky, iadp,
426 2 mx1, mx2, my1, my2,
427 3 mz1, mz2, nc1, nc2,
428 4 nc3, e1x, e1y, e1z,
429 5 e2x, e2y, e2z, e3x,
430 6 e3y, e3z, m11, m12,
431 7 m21, m22, m31, m32,
subroutine main_beam18(elbuf_str, nel, npt, mtn, imat, pid, ngl, pm, ipm, geo, off, for, mom, eint, al, epsd, bufmat, npf, tf, exx, exy, exz, kxx, kyy, kzz, f1, f2, f3, m1, m2, m3, jthe, tempel, ifail, sbufmat, snpc, stf, nummat, numgeo, iout, istdo, npropmi, npropm, npropg, time, dtime, idel7nok, isigi, imconv, ismstr, mat_param, ntable, table)
subroutine main_beam3(elbuf_str, nel, ilaw, jthe, ifail, ipm, pm, geo, tempel, off, mat, pid, ngl, time, dtime, al, npf, tf, exx, exy, exz, kxx, kyy, kzz, f1, f2, f3, m1, m2, m3, bufmat, npropg, npropmi, npropm, nummat, numgeo, sbufmat, snpc, stf, iout, istdo, nuvar, uvar, epsd, imat, for, mom, eint, ismstr, mat_param, ntable, table)
subroutine pforc3(elbuf_str, jft, jlt, nel, mtn, ismstr, pm, ncc, x, f, m, v, r, geo, partsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadp, offset, ipartp, tani, fx1, fx2, fy1, fy2, fz1, fz2, mx1, mx2, my1, my2, mz1, mz2, igeo, ipm, bufmat, npt, npf, tf, gresav, grth, igrth, msp, dmelp, ioutprt, itask, jthe, temp, fthe, fthesky, iexpan, h3d_data, jsms, igre, nft, ifail, sbufmat, snpc, stf, nummat, numgeo, iout, istdo, idel7nok, idyna, imconv, impl_s, mat_param, preld1, stf_f, dt, sensors, ntable, table)