57 1 ELBUF_STR,JFT ,JLT ,NEL ,
58 2 MTN ,ISMSTR ,PM ,NCC ,
60 4 R ,GEO ,PARTSAV ,DT2T ,
61 5 NELTST ,ITYPTST ,STIFN ,STIFR ,
62 6 FSKY ,IADP ,OFFSET ,IPARTP ,
63 7 TANI ,FX1 ,FX2 ,FY1 ,
64 8 FY2 ,FZ1 ,FZ2 ,MX1 ,
65 9 MX2 ,MY1 ,MY2 ,MZ1 ,
66 A MZ2 ,IGEO ,IPM ,BUFMAT ,
67 B NPT ,NPF ,TF ,GRESAV ,
68 C GRTH ,IGRTH ,MSP ,DMELP ,
69 D IOUTPRT ,ITASK ,JTHE ,TEMP ,
70 E FTHE ,FTHESKY ,IEXPAN ,H3D_DATA ,
71 F JSMS ,IGRE ,NFT ,IFAIL ,
72 G SBUFMAT ,SNPC ,STF ,NUMMAT ,
73 H NUMGEO ,IOUT ,ISTDO ,IDEL7NOK ,
74 I IDYNA ,IMCONV ,IMPL_S ,MAT_PARAM,
75 J PRELD1 ,STF_F ,DT ,SENSORS ,
86 use element_mod ,
only : nixp
90#include "implicit_f.inc"
100#include "com08_c.inc"
101#include "parit_c.inc"
105 INTEGER,
INTENT(IN) :: NFT,IGRE,JSMS,IFAIL
106 INTEGER ,
INTENT(IN) :: SBUFMAT
107 INTEGER ,
INTENT(IN) :: SNPC
108 INTEGER ,
INTENT(IN) :: STF
109 INTEGER ,
INTENT(IN) :: NUMMAT
110 INTEGER ,
INTENT(IN) :: NUMGEO
111 INTEGER ,
INTENT(IN) :: IOUT
112 INTEGER ,
INTENT(IN) :: ISTDO
113 INTEGER ,
INTENT(IN) :: IMPL_S
114 INTEGER ,
INTENT(IN) :: IDYNA
115 INTEGER ,
INTENT(IN) :: IMCONV
116 INTEGER ,
INTENT(INOUT) :: IDEL7NOK
117 INTEGER,
INTENT(IN) :: NTABLE
118 TYPE(TTABLE),
DIMENSION(NTABLE),
INTENT(INOUT) :: TABLE
119 INTEGER NCC(NIXP,*),IADP(2,*),IPARTP(*),IGEO(NPROPGI,*),
120 . IPM(NPROPMI,*),NPF(*),GRTH(*),IGRTH(*)
121 INTEGER JFT,JLT,NELTST,ITYPTST,OFFSET,NEL,JTHE,
122 . MTN,ISMSTR,NPT,IOUTPRT,ITASK,IEXPAN
124 . PM(NPROPM,*), X(*), F(*), M(*), V(*), R(*),GEO(NPROPG,*),TF(*),
125 . bufmat(*),partsav(*),stifn(*),stifr(*),fsky(*),tani(15,*),
126 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
127 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
128 . mx1(mvsiz),my1(mvsiz),mz1(mvsiz),
129 . mx2(mvsiz),my2(mvsiz),mz2(mvsiz),
130 . gresav(*),msp(*),dmelp(*),temp(*),fthe(*),
132 my_real,
INTENT(IN) :: preld1,stf_f
134 TYPE (ELBUF_STRUCT_),
TARGET :: ELBUF_STR
135 TYPE (H3D_DATABASE) :: H3D_DATA
136 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
137 TYPE (DT_),
INTENT(IN) :: DT
138 type (sensors_),
INTENT(INOUT) :: SENSORS
142 INTEGER I, IFLAG, IGTYP, NUVAR, IFUNC_ALPHA, IMAT
143 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
144 . NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),IPT
146 . STI(MVSIZ),STIR(MVSIZ),OFF(MVSIZ),AL(MVSIZ),EXX(MVSIZ),
147 . EXY(MVSIZ),EXZ(MVSIZ),KXX(MVSIZ),KYY(MVSIZ),KZZ(MVSIZ),
148 . F1(MVSIZ),F2(MVSIZ),F3(MVSIZ),M1(MVSIZ),M2(MVSIZ),M3(MVSIZ),
149 . X1(MVSIZ),X2(MVSIZ),X3(MVSIZ),Y1(MVSIZ),Y2(MVSIZ),
150 . Y3(MVSIZ),Z1(MVSIZ),Z2(MVSIZ),Z3(MVSIZ),RX1G(MVSIZ),RX2G(MVSIZ),
151 . RY1G(MVSIZ),RY2G(MVSIZ),RZ1G(MVSIZ),RZ2G(MVSIZ),
152 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
153 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),vx1g(mvsiz),vx2g(mvsiz),
154 . vy1g(mvsiz),vy2g(mvsiz),vz1g(mvsiz),vz2g(mvsiz),
155 . f11(mvsiz), f12(mvsiz), f21(mvsiz),
156 . f22(mvsiz), f31(mvsiz), f32(mvsiz),
157 . m11(mvsiz), m12(mvsiz), m21(mvsiz),
158 . m22(mvsiz), m31(mvsiz), m32(mvsiz),tempel(mvsiz),dtemp(mvsiz),
159 . fscal_alpha,eth(mvsiz),deintth,
alpha,df,vl12(mvsiz),dtinv
161 my_real :: kc,phix, ca,cb,
area, fphi(mvsiz,2),die(mvsiz)
162 my_real ,
DIMENSION(NEL) :: sigx,sapt,vecnul
163 my_real ,
DIMENSION(:) ,
POINTER
164 my_real ,
DIMENSION(:) ,
POINTER :: el_temp
165 TYPE(g_bufel_) ,
POINTER :: GBUF
167 TARGET :: TEMPEL,VECNUL
172 GBUF => elbuf_str%GBUF
177 2 ngl, nc1, nc2, nc3,
181 igtyp = igeo(11,pid(1))
185 1 gbuf%SKEW,r, al, nc1,
189 5 rx2g, ry1g, ry2g, rz1g,
190 6 rz2g, e1x, e1y, e1z,
191 7 e2x, e2y, e2z, e3x,
193 IF (ismstr /= 0)
CALL ppxpy3(gbuf%LENGTH,al,nel)
196 2 gbuf%OFF, dt2t, neltst, ityptst,
197 3 sti, stir, msp, dmelp,
198 4 gbuf%G_DT,gbuf%DT, al, mat,
199 5 pid, ngl, nel, igtyp,
204 3 e1x, e1y, e1z, e2x,
205 4 e2y, e2z, e3x, e3y,
206 5 e3z, vx1g, vx2g, vy1g,
207 6 vy2g, vz1g, vz2g, nel)
209 1 r, geo, gbuf%OFF,off,
210 2 exx, exy, exz, kxx,
212 4 nc2, nc3, rx1g, rx2g,
213 5 ry1g, ry2g, rz1g, rz2g,
214 6 e1x, e1y, e1z, e2x,
215 7 e2y, e2z, e3x, e3y,
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)
231 ifunc_alpha = mat_param(imat)%THERM%FUNC_THEXP
232 fscal_alpha = mat_param(imat)%THERM%SCALE_THEXP
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 ,
286 9 numgeo ,iout ,istdo ,npropmi ,npropm ,
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)
321 die(i) = (gbuf%EINT(i)+gbuf%EINT(nel+i)-die(i)) * mat_param(imat)%THERM%EFRAC
327 iflag = mod(ncycle,ncpri)
330 1 pm, v, gbuf%EINT,geo,
331 2 partsav, ipartp, tani, gbuf%FOR,
332 3 gbuf%MOM, gresav, grth, igrth,
333 4 gbuf%OFF, nel, al, nc1,
334 5 nc2, nc3, e1x, e1y,
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))
357 sigx(1:nel) = f1(1:nel)/sapt(1:nel)
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,
368 . al ,f1 ,f2 ,f3 ,m1 ,
369 . m2 ,m3 ,sti ,stir ,nel,
371 . f31 ,f32 ,m11 ,m12 ,m21,
379 ca = mat_param(imat)%THERM%AS
380 cb = mat_param(imat)%THERM%BS
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)