64
65
66
67 USE elbufdef_mod
70 USE sensor_mod
71 USE python_funct_mod
72 use element_mod , only : nixr
73
74
75
76#include "implicit_f.inc"
77
78
79
80#include "mvsiz_p.inc"
81
82
83
84#include "param_c.inc"
85#include "parit_c.inc"
86#include "com04_c.inc"
87
88
89
90 type(python_), intent(in) :: PYTHON
91 INTEGER, INTENT(IN) :: STF
92 INTEGER, INTENT(IN) :: SANIN
93 INTEGER, INTENT(IN) :: IRESP
94 INTEGER, INTENT(IN) :: SNPC
95 INTEGER, INTENT(IN) :: IGRE,
96 INTEGER, INTENT(IN) :: NFT
97 INTEGER, INTENT(IN) :: JSMS
98 INTEGER IXR(,*), NPF(*),IADR(3,*),IPARTR(*),
99 . IGEO(NPROPGI,*),JFT,JLT,NELTST ,ITYPTST,OFFSET,
100 . NEL,MTN,GRTH(*),IGRTH(*),FLG_KJ2,IPM(NPROPMI,*),FLAG_SLIPRING_UPDATE,
101 . FLAG_RETRACTOR_UPDATE
103 . geo(npropg,*),x(*),f(*),tf(stf),skew(lskew,*),fsky(*),
104 . vr(*), v(*), ar(*), stifn(*),stifr(*),ms(*), in(*),
105 . anim(*),partsav(*),tani(15,*),
106 . fr_wave(*),bufmat(*),bufgeo(*),pm(*),rby(*),
107 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
108 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
109 . mx1(mvsiz),my1(mvsiz),mz1(mvsiz),
110 . mx2(mvsiz),my2(mvsiz),mz2(mvsiz),gresav(*),
111 . msrt(*), dmelrt(*)
112 DOUBLE PRECISION XDP(3,*)
113 TYPE(TTABLE) TABLE(*)
114
115 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
116 TYPE(H3D_DATABASE) :: H3D_DATA
117 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) , INTENT(IN) :: SENSOR_TAB
118
119
120
121 INTEGER NGL(MVSIZ),PID(MVSIZ),NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),
122 . MID(MVSIZ)
123
125 . sti(3,mvsiz),stir(3,mvsiz),
126 . al(mvsiz),
127 . fr_w_e(mvsiz),off(mvsiz),bid
129 . exx2(mvsiz), eyx2(mvsiz), ezx2(mvsiz),
130 . exy2(mvsiz), eyy2(mvsiz), ezy2(mvsiz),
131 . exz2(mvsiz), eyz2(mvsiz), ezz2(mvsiz),
132 . al2(mvsiz),x1(mvsiz),y1(mvsiz),z1(mvsiz),
133 . x2(mvsiz),y2(mvsiz),z2(mvsiz),
134 .
135 . exx(mvsiz),eyx(mvsiz),ezx(mvsiz),
136 . exy(mvsiz),eyy(mvsiz),ezy(mvsiz),
137 . exz(mvsiz),eyz(mvsiz),ezz(mvsiz),
138 . xcr(mvsiz),xm(mvsiz),rx1(mvsiz),rx2(mvsiz),
139 . ry1(mvsiz),ry2(mvsiz),rz1(mvsiz),rz2(mvsiz),xin(mvsiz),
140 . ak(mvsiz),xkm(mvsiz),xcm(mvsiz),xkr(mvsiz),
141 . vx1(mvsiz),vx2(mvsiz),
142 . vy1(mvsiz),vy2(mvsiz),vz1(mvsiz),vz2(mvsiz),vx3(mvsiz),
143 . vy3(mvsiz),vz3(mvsiz)
144 INTEGER IGTYP,I,I0,NUVAR,IADBUF
145 double precision
146 . x1dp(3,mvsiz),x2dp(3,mvsiz),x3dp(3,mvsiz),
147 . al2dp(mvsiz),aldp(mvsiz)
148
149 TYPE(G_BUFEL_),POINTER :: GBUF
150 INTEGER II(9)
151
152 gbuf => elbuf_str%GBUF
153
154 fx1(1:mvsiz) = zero
155 fx2(1:mvsiz) = zero
156 fy1(1:mvsiz) = zero
157 fy2(1:mvsiz) = zero
158 fz1(1:mvsiz) = zero
159 fz2(1:mvsiz) = zero
160 mx1(1:mvsiz) = zero
161 mx2(1:mvsiz) = zero
162 my1(1:mvsiz) = zero
163 my2(1:mvsiz) = zero
164 mz1(1:mvsiz) = zero
165 mz2(1:mvsiz) = zero
166
167 DO i=1,9
168 ii(i) = (i-1)*nel + 1
169 ENDDO
170
171 i0 = ixr(1,1)
172 igtyp = igeo(11,i0)
173
174 bid = zero
175
176 fr_w_e(1:nel) = zero
177
178
180 1 x, vr, ixr, xdp,
181 2 x1dp, x2dp, ngl, x1,
182 3 y1, z1, x2, y2,
183 4 z2, pid, mid, rx1,
184 5 ry1, rz1, rx2, ry2,
185 6 rz2, nc1, nc2, nel)
187 1 geo, gbuf%OFF, sensor_tab, gbuf%TOTDEPL(ii(1)),
188 2 gbuf%TOTDEPL(ii(2)),gbuf%TOTDEPL(ii(3)),gbuf%LENGTH(ii(1)), gbuf%LENGTH(ii(2)),
189 3 gbuf%LENGTH(ii(3)), gbuf%TOTROT(ii(1)), gbuf%TOTROT(ii(2)), gbuf%TOTROT(ii(3)),
190 4 igeo, pid, nel, nsensor )
191
192 DO i=jft,jlt
193 IF (gbuf%OFF(i) /= -ten) THEN
194 off(i)=
min(one,abs(gbuf%OFF(i)))
195 ELSE
196
197 off(i)=zero
198 ENDIF
199 ENDDO
200
202 1 gbuf%SKEW, v, exx2, eyx2,
203 2 ezx2, exy2, eyy2, ezy2,
204 3 exz2, eyz2, ezz2, al2dp,
205 4 x1dp, x2dp, al2, aldp,
206 5 gbuf%SKEW_ERR,ngl, al, exx,
207 6 eyx, ezx, exy, eyy,
208 7 ezy, exz, eyz, ezz,
209 8 rx1, ry1, rz1, rx2,
210 9 ry2, rz2, vx1, vx2,
211 a vy1, vy2, vz1, vz2,
212 b nc1, nc2, nel)
213
214
215 IF (nslipring > 0) THEN
217 1 x, v, ixr, xdp,
218 2 x3dp, nc3, vx3, vy3,
219 3 vz3, nel)
220 ENDIF
221
222 nuvar = nint(geo(25,i0))
223 DO i=jft,jlt
224 mid(i) = ixr(5,i)
225 iadbuf = ipm(7,mid(i)) - 1
226 nuvar =
max(nuvar, nint(bufmat(iadbuf + 4)))
227 ENDDO
228
230 1 skew, ipm, igeo, mid,
231 2 pid, geo, bufmat, gbuf%FOR(ii(1)),
232 3 gbuf%FOR(ii(2)), gbuf%FOR(ii(3)), gbuf%EINT, gbuf%TOTDEPL(ii(1)),
233 4 gbuf%TOTDEPL(ii(2)), gbuf%TOTDEPL(ii(3)), npf, tf,
234 5 off, gbuf%DEP_IN_TENS(ii(1)),gbuf%DEP_IN_TENS(ii(2)),gbuf%DEP_IN_TENS
235 6 gbuf%DEP_IN_COMP(ii(1)),gbuf%DEP_IN_COMP(ii(2)),gbuf%DEP_IN_COMP(ii(3)),gbuf%FOREP(ii(1)),
236 7 gbuf%FOREP(ii(2)), gbuf%FOREP(ii(3)),
237 8 gbuf%LENGTH(ii(3)), gbuf%MOM(ii(1)), gbuf%MOM(ii(2)), gbuf%MOM(ii(3)),
238 9 gbuf%TOTROT(ii(1)), gbuf%TOTROT(ii(2)), gbuf%TOTROT(ii(3)), gbuf%ROT_IN_TENS(ii(1)),
239 a gbuf%ROT_IN_TENS(ii(2)),gbuf%ROT_IN_TENS(ii(3)),gbuf%MOMEP(ii(1)), gbuf%MOMEP(ii(2)),
240 b gbuf%MOMEP(ii(3)), gbuf%ROT_IN_COMP(ii(1)),gbuf%ROT_IN_COMP(ii(2)),gbuf%ROT_IN_COMP(ii(3)),
241 c anim, gbuf%POSX, gbuf%POSY, gbuf%POSZ,
242 d gbuf%POSXX, gbuf%POSYY, gbuf%POSZZ, fr_wave,
243 e gbuf%E6, nel, exx2, eyx2,
244 f ezx2, exy2, eyy2, ezy2,
245 g exz2, eyz2, ezz2, al2dp,
246 h ngl, gbuf%RUPTCRIT, gbuf%LENGTH_ERR, aldp,
247 i gbuf%YIELD(ii(1)), gbuf%YIELD(ii(2)), gbuf%YIELD(ii(3)), gbuf%YIELD(ii(4)),
248 j gbuf%YIELD(ii(5)), gbuf%YIELD(ii(6)), exx, eyx,
249 k ezx, exy, eyy, ezy,
250 l exz, eyz, ezz, xcr,
251 m rx1, ry1, rz1, rx2,
252 n ry2, rz2, xin, ak,
253 o xm, xkm, xcm, xkr,
254 p vx1, vx2, vy1, vy2,
255 q vz1, vz2, nuvar, gbuf%VAR,
256 r gbuf%MASS, gbuf%DEFINI(ii(1)), gbuf%DEFINI(ii(2)), gbuf%DEFINI(ii(3)),
257 s gbuf%DEFINI(ii(4)), gbuf%DEFINI(ii(5)), gbuf%DEFINI(ii(6)), gbuf%SLIPRING_STRAND,
258 t gbuf%DFS, gbuf%RINGSLIP, gbuf%LENGTH(ii(2)), gbuf%LENGTH(ii(3)),
259 u gbuf%SLIPRING_ID, gbuf%UPDATE, gbuf%RETRACTOR_ID
260 v gbuf%ADD_NODE(nel+1), nc1, nc2, nc3,
261 w x1dp, x2dp, x3dp, vx3,
262 x vy3, vz3, flag_slipring_update, flag_retractor_update,
263 y sensor_tab, gbuf%INTVAR(ii(1)), gbuf%SLIPRING_FRAM_ID, gbuf%FRAM_FACTOR,
264 z gbuf%INTVAR(ii(2)), gbuf%INTVAR(ii(3)), gbuf%INTVAR(ii(4)), gbuf%INTVAR(ii(5)),
265 1 gbuf%INTVAR(ii(6)), gbuf%INTVAR(ii(7)), gbuf%INTVAR(ii(8)), gbuf%INTVAR(ii(9)),
266 2 nft , nsensor, stf, sanin,
267 3 iresp, snpc)
268
269 DO i=jft,jlt
270 IF (gbuf%UPDATE(i) == -1) THEN
271 gbuf%OFF(i) = off(i)
272 gbuf%UPDATE(i) = 0
273 ELSEIF (gbuf%OFF(i) /= -ten .AND. off(i) < one) THEN
274 gbuf%OFF(i) = off(i)
275 ENDIF
276 ENDDO
277
279 1 jft, jlt, gbuf%OFF, dt2t,
280 2 neltst, ityptst, sti, stir,
281 3 ms, in, msrt, dmelrt,
282 4 gbuf%G_DT,gbuf%DT, ngl, xcr,
283 5 xin, xm, xkm, xcm,
284 6 xkr, nc1, nc2, jsms)
286 1 gbuf%EINT,partsav, ixr, geo,
287 2 v, ipartr, gbuf%MASS,gresav,
288 3 grth, igrth, gbuf%OFF, nc1,
289 4 nc2, x, vr, nel,
290 5 igre)
292 1 gbuf%FOR(ii(1)),gbuf%FOR(ii(2)),gbuf%FOR(ii(3)),gbuf%MOM(ii(1)),
293 2 gbuf%MOM(ii(2)),gbuf%MOM(ii(3)),tani, al,
294 3 h3d_data, nel)
295 IF (iparit == 0) THEN
297 1 f, gbuf%FOR(ii(1)),gbuf%FOR(ii(2)),gbuf%FOR(ii(3)),
298 2 ar, gbuf%MOM(ii(1)),gbuf%MOM(ii(2)),gbuf%MOM(ii(3)),
299 3 sti, stir, stifn, stifr,
300 4 fx1, fx2, fy1, fy2,
301 5 fz1, fz2, mx1, mx2,
302 6 my1, my2, mz1, mz2,
303 7 al, exx, eyx, ezx,
304 8 exy, eyy, ezy, exz,
305 9 eyz, ezz, nc1, nc2,
306 a nel)
307 ELSE
309 1 gbuf%FOR(ii(1)),gbuf%FOR(ii(2)),gbuf%FOR(ii(3)),gbuf%MOM(ii(1)),
310 2 gbuf%MOM(ii(2)),gbuf%MOM(ii(3)),sti, stir,
311 3 fsky, fsky, iadr, fx1,
312 4 fx2, fy1, fy2, fz1,
313 5 fz2, mx1, mx2, my1,
314 6 my2, mz1, mz2, exx,
315 7 eyx, ezx, exy, eyy,
316 8 ezy, exz, eyz, ezz,
317 9 al, nel, nft)
318 ENDIF
319
320 RETURN
subroutine r23_114_coor3(x, v, ixr, xdp, x3dp, nc3, vx3, vy3, vz3, nel)
subroutine r23bilan(eint, partsav, ixr, geo, v, ipartr, mass, gresav, grth, igrth, off_dum, nc1, nc2, x, vr, nel, igre)
subroutine r23coor3(x, vr, ixr, xdp, x1dp, x2dp, ngl, x1, y1, z1, x2, y2, z2, pid, mat, rx1, ry1, rz1, rx2, ry2, rz2, nc1, nc2, nel)
subroutine r23l114def3(python, skew, ipm, igeo, mid, pid, geo, uparam, fx, fy, fz, e, dx, dy, dz, npf, tf, off, dpx, dpy, dpz, dpx2, dpy2, dpz2, fxep, fyep, fzep, x0, y0, z0, xmom, ymom, zmom, rx, ry, rz, rpx, rpy, rpz, xmep, ymep, zmep, rpx2, rpy2, rpz2, anim, posx, posy, posz, posxx, posyy, poszz, fr_wave, e6, nel, exx2, eyx2, ezx2, exy2, eyy2, ezy2, exz2, eyz2, ezz2, al2dp, ngl, crit_new, x0_err, aldp, yieldx, yieldy, yieldz, yieldx2, yieldy2, yieldz2, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, xcr, rx1, ry1, rz1, rx2, ry2, rz2, xin, ak, xm, xkm, xcm, xkr, vx1, vx2, vy1, vy2, vz1, vz2, nuvar, uvar, mass, dx0, dy0, dz0, rx0, ry0, rz0, slipring_strand, dfs, ring_slip, x02, lmin, slipring_id, update_flag, retractor_id, add_node1, add_node2, nc1, nc2, nc3, x1dp, x2dp, x3dp, vx3, vy3, vz3, flag_slipring_update, flag_retractor_update, sensor_tab, uiner, fr_id, fram_factor, eps_old, fx_b2, dpx_b2, yieldx_b2, xx_old_b2, fxep_b2, posx_b2, eps_old_b2, nft, nsensor, stf, sanin, iresp, snpc)
subroutine r23sens3(geo, off, sensor_tab, dx, dy, dz, x0, y0, z0, rx, ry, rz, igeo, pid, nel, nsensor)
subroutine r2len3(jft, jlt, off, dt2t, neltst, ityptst, sti, stir, ms, in, msrt, dmelrt, g_dt, dtel, ngl, xcr, xin, xm, xkm, xcm, xkr, nc1, nc2, jsms)
subroutine r4cum3(f, forx, fory, forz, xm, xmom, ymom, zmom, sti, stir, stifn, stifr, fx1, fx2, fy1, fy2, fz1, fz2, mx1, mx2, my1, my2, mz1, mz2, al, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, nc1, nc2, nel)
subroutine r4cum3p(forx, fory, forz, xmom, ymom, zmom, sti, stir, fsky, fskyv, iadr, fx1, fx2, fy1, fy2, fz1, fz2, mx1, mx2, my1, my2, mz1, mz2, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, al, nel, nft)
subroutine r4evec3(rloc, v, exx2, eyx2, ezx2, exy2, eyy2, ezy2, exz2, eyz2, ezz2, al2dp, x1dp, x2dp, al2, aldp, rloc_err, ngl, al, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, rx1, ry1, rz1, rx2, ry2, rz2, vx1, vx2, vy1, vy2, vz1, vz2, nc1, nc2, nel)
subroutine r4tors(forx, fory, forz, xmom, ymom, zmom, tani, al, h3d_data, nel)