52
53
54
55 USE elbufdef_mod
56
57
58
59#include "implicit_f.inc"
60#include "comlock.inc"
61
62
63
64#include "com08_c.inc"
65#include "param_c.inc"
66#include "parit_c.inc"
67#include "units_c.inc"
68#include "scr23_c.inc"
69
70
71
72 INTEGER, INTENT(IN) :: IGRE
73 INTEGER NFT,NEL,KXX(NIXX,*),IXX(*), NPC(*),ISKY(*),
74 . IPARTX(*),NELTST ,ITYPTST,
75 . ITAB(*),GRTH(*),IGRTH(*)
76
78 . geo(npropg,*), pm(*), x(3,*),vr(3,*), v(3,*), f(3,*), ar(3,*),
79 . ev(*),pld(*),skew(lskew,*),fskyi(*),
80 . stifn(*),stifr(*),ms(*), in(*),partsav(*),
81 . bufmat(*),bufgeo(*) ,gresav(*)
82
83 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
84
85
86
87
89 . dt1u,
90 . dte, dtc, xkm, xcm, xkr, xcr, xm, xine, eusr
91 INTEGER I, J, K, IPROP, , ISENS, NX,
92 . NB1, NB2, NB3, NB4, , NBFI, UID,
93 . IGTYP,NUVAR,NUVARN,NUPARAM,
94 . NISKYL,,
95 . UIX(MAXNX),KVAR,KVARN
97 . xusr(3,maxnx),vusr(3,maxnx),vrusr(3,maxnx),umass(maxnx),
98 . uforc(3,maxnx),ustifm(maxnx), ustifr(maxnx), uvisr(maxnx),
99 . umomt(3,maxnx),uvism(maxnx),uiner(maxnx)
100
101 TYPE(G_BUFEL_),POINTER :: GBUF
102
103 gbuf => elbuf_str%GBUF
104
105 dt1u=dt1
106
107 DO i=1,nel
108 j=i+nft
109
110 imat =kxx(1,j)
111 iprop=kxx(2,j)
112 nx =kxx(3,j)
113
114 IF (iparit /= 0) THEN
115#include "lockon.inc"
116 niskyl = nisky
117 nisky
118#include "lockoff.inc"
119 END IF
120
121 igtyp = nint(geo(12,iprop))
122 nuvar = nint(geo(25,iprop))
123 nuvarn= nint(geo(35,iprop))
124
125
126
127
128
129
130
131
132
133 kvar = nuvar*(i-1)+1
134 kvarn = nuvarn*nx*(i-1)+1
135
136
137 CALL xcoor3(x ,kxx(1,j) ,ixx ,itab ,nx ,
138 2 uid ,uix ,xusr )
139
140
141 CALL xdefo3(v ,vr ,kxx(1,j) ,ixx ,nx ,
142 2 vusr ,vrusr )
143
150
151 IF (igtyp == 28) THEN
152
153 keusr=0
154 eusr =zero
156 2 xusr ,vusr ,vrusr ,uix ,uid ,
157 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
158 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
159 5 uvism ,uvisr ,uforc ,umomt ,
160 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
161 ELSEIF (igtyp == 29) THEN
162 keusr=0
163 eusr =zero
164 dte =ep20
165 DO k=1,nx
166 umass(k)=zero
167 uiner(k)=zero
168 ustifm(k)=zero
169 ustifr(k)=zero
170 uvism(k)=zero
171 uvisr(k)=zero
172 uforc(1,k)=zero
173 uforc(2,k)=zero
174 uforc(3,k)=zero
175 umomt(1,k)=zero
176 umomt(2,k)=zero
177 umomt(3,k)=zero
178 ENDDO
180 2 xusr ,vusr ,vrusr ,uix ,uid ,
181 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
182 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
183 5 uvism ,uvisr ,uforc ,umomt ,
184 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
185 ELSEIF (igtyp == 30) THEN
186 keusr=0
187 eusr =zero
188 dte=ep20
189 DO k=1,nx
190 umass(k)=zero
191 uiner(k)=zero
192 ustifm(k)=zero
193 ustifr(k)=zero
194 uvism(k)=zero
195 uvisr(k)=zero
196 uforc(1,k)=zero
197 uforc(2,k)=zero
198 uforc(3,k)=zero
199 umomt(1,k)=zero
200 umomt(2,k)=zero
201 umomt(3,k)=zero
202 ENDDO
204 2 xusr ,vusr ,vrusr ,uix ,uid ,
205 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
206 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
207 5 uvism ,uvisr ,uforc ,umomt ,
208 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
209 ELSEIF (igtyp == 31) THEN
210 keusr=0
211 eusr =zero
212 dte=ep20
213 DO k=1,nx
214 umass(k)=zero
215 uiner(k)=zero
216 ustifm(k)=zero
217 ustifr(k)=zero
218 uvism(k)=zero
219 uvisr(k)=zero
220 uforc(1,k)=zero
221 uforc(2,k)=zero
222 uforc(3,k)=zero
223 umomt(1,k)=zero
224 umomt(2,k)=zero
225 umomt(3,k)=zero
226 ENDDO
228 2 xusr ,vusr ,vrusr ,uix ,uid ,
229 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
230 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
231 5 uvism ,uvisr ,uforc ,umomt ,
232 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
233 ENDIF
234
235
236 IF (gbuf%OFF(i) /= zero) THEN
237 IF (dte < dt2t) THEN
238 dt2t=dte
239 neltst =kxx(5,j)
240 ityptst=100
241 ENDIF
242 ELSE
243 DO k=1,nx
244 ustifr(k)=zero
245 ustifm(k)=zero
246 uvisr(k) =zero
247 uvism(k) =zero
248 uforc(1,k)=zero
249 uforc(2,k)=zero
250 uforc(3,k)=zero
251 umomt(1,k)=zero
252 umomt(2,k)=zero
253 umomt(3,k)=zero
254 ENDDO
255 ENDIF
256
258 1 nx, kxx(1,j), ixx, x,
259 2 v, vr, umass, uiner,
260 3 uforc, umomt, keusr, eusr,
261 4 gbuf%EINT(i),partsav, ipartx(j), gresav,
262 5 grth, igrth(j), igre)
263
264 IF (iparit == 0) THEN
265 CALL xcum3(nx,kxx(1,j),ixx,uforc ,ustifm,
266 2 uvism,ms, f, stifn )
267 ELSE
268 CALL xcum3p(nx,kxx(1,j),ixx,uforc ,ustifm,
269 2 uvism, ms, niskyl, fskyi ,isky)
270 ENDIF
271 ENDDO
272
273 RETURN
void sav_buf_point(int *buf, int *i)
subroutine xbilan3(nx, kxx, ixx, x, v, vr, umass, uiner, forc, torq, keusr, eusr, eint, partsav, ipart, gresav, grth, igrth, igre)
subroutine xcoor3(x, kxx, ixx, itab, nx, uid, uix, xusr)
subroutine xcum3(nx, kxx, ixx, uforc, ustifm, uviscm, ms, f, stifn)
subroutine xcum3p(nx, kxx, ixx, uforc, ustifm, uviscm, ms, niskyl, fskyi, isky)
subroutine xdefo3(v, vr, kxx, ixx, nx, vusr, vrusr)
subroutine xforc28(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
subroutine xforc29(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
subroutine xforc30(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
subroutine xforc31(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)