39
40
41
42#include "implicit_f.inc"
43#include "comlock.inc"
44
45
46
47#include "mvsiz_p.inc"
48
49
50
51#include "param_c.inc"
52#include "com08_c.inc"
53#include "scr02_c.inc"
54#include "scr07_c.inc"
55#include "scr17_c.inc"
56#include "scr18_c.inc"
57#include "sms_c.inc"
58#include "units_c.inc"
59
60
61
62 INTEGER JFT, JLT,NELTST,ITYPTST,ISMSTR,NFT,IOFC, JSMS,IGTYP,
63 . IGMAT,IMAT,MTN
64 INTEGER NGL(MVSIZ)
66 . pm(npropm,*), off(*),sti(*),stir(*),offg(*),ssp(mvsiz),
67 . viscmx(mvsiz),dt2t, mstg(*), dmeltg(*), ptg(3,*),shf(*), g(mvsiz),
68 . a11r(mvsiz),a1(mvsiz),aldt(mvsiz),thk0(mvsiz),
area(mvsiz),alpe(mvsiz)
69 INTEGER,INTENT(IN) :: G_DT, NEL
71 my_real,
DIMENSION(NEL),
INTENT(IN) :: zoffset
72 my_real,
DIMENSION(NEL),
INTENT(IN) :: ssp_eq
73
74
75
76 INTEGER INDX(MVSIZ),I, II, NINDX,IDT,IFLAG
78 my_real athk, mmin,fac,f_oset(nel),f_dte(nel)
79
80 DO i=jft,jlt
81 viscmx(i) = sqrt(one + viscmx(i)*viscmx(i)) - viscmx(i)
82 aldt(i) = aldt(i)*viscmx(i) / sqrt(alpe(i))
83 ENDDO
84
85
86 f_oset(jft:jlt) = one
87 f_dte(jft:jlt) = one
88 IF (nodadt/=0) THEN
89 IF(igtyp == 52 .OR.
90 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
91 . .AND. igmat > 0 )) THEN
92 DO i=jft,jlt
93 IF (off(i)==zero) THEN
94 sti(i) = zero
95 stir(i) = zero
96 ELSE
97 athk =
area(i) * thk0(i)
98 sti(i) = athk * a1(i) / aldt(i)**2
99 fac =a11r(i)*
area(i)/ aldt(i)**2
100 stir(i) = fac*(one_over_12* thk0(i)**3 + thk0(i)*zoffset(i)*zoffset(i)
101 . + thk0(i)*half * shf(i) *
area(i) * g(i)/a1(i))
102 ENDIF
103 ENDDO
104 ELSE
105 f_oset(jft:jlt)= one + zep2*abs(zoffset(jft:jlt))/thk0(jft:jlt)
106 DO i=jft,jlt
107 a1(i) = pm(24,imat)
108 g(i) = pm(22,imat)
109 ENDDO
110 IF (mtn == 58 .or. mtn == 158) THEN
111 iflag = 1
112 CALL cssp2a11(pm ,imat ,ssp ,a1 ,jlt ,iflag)
113 ELSEIF (mtn == 42 .or. mtn == 62 .or. mtn == 69 .or. mtn == 88) THEN
114 iflag = 2
115 CALL cssp2a11(pm ,imat ,ssp ,a1 ,jlt ,iflag)
116 DO i=jft,jlt
117 fac =
max(ssp_eq(i),ssp(i))/ssp(i)
118 f_oset(i) = fac*fac*f_oset(i)
119 ENDDO
120 END IF
121 DO i=jft,jlt
122 IF (off(i)==zero) THEN
123 sti(i) = zero
124 stir(i) = zero
125 ELSE
126 athk =
area(i) * thk0(i)
127 sti(i) = athk *f_oset(i)* a1(i) / aldt(i)**2
128 stir(i) = sti(i) * (thk0(i) * thk0(i) * one_over_12
129 . + half * shf(i) *
area(i) * g(i)/a1(i))
130 . + sti(i)*zoffset(i)*zoffset(i)
131
132
133
134 ENDIF
135 ENDDO
136 ENDIF
137
138 ELSEIF(idtmins == 2)THEN
139 IF(igtyp == 52 .OR.
140 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
141 . .AND. igmat > 0 )) THEN
142 DO i=jft,jlt
143 IF (off(i)==zero) THEN
144 sti(i) = zero
145 stir(i) = zero
146 ELSE
147 athk =
area(i) * thk0(i)
148 sti(i) = athk * a1(i) / aldt(i)**2
149 fac = a11r(i)*
area(i)/ aldt(i)**2
150 stir(i) = fac * (one_over_12* (thk0(i)**3) + thk0(i)*zoffset(i)*zoffset(i)
151 . + half * thk0(i)*shf(i) *
area(i) * g(i)/a1(i))
152 ENDIF
153 END DO
154 ELSE
155 DO i=jft,jlt
156 a1(i) = pm(24,imat)
157 g(i) = pm(22,imat)
158 ENDDO
159 DO i=jft,jlt
160 IF (off(i)==zero) THEN
161 sti(i) = zero
162 stir(i) = zero
163 ELSE
164 athk =
area(i) * thk0(i)
165 sti(i) = athk * a1(i) / aldt(i)**2
166 stir(i) = sti(i) * (thk0(i) * thk0(i) * one_over_12
167 . + half * shf(i) *
area(i) * g(i)/a1(i))
168 ENDIF
169 END DO
170 ENDIF
171
172 IF(jsms /= 0)THEN
173 DO i=jft,jlt
174 IF(offg(i) < zero .OR. off(i) == zero) cycle
175
176 mmin=mstg(i)*
min(ptg(1,i),ptg(2,i),ptg(3,i))
177
178
179
180
181 dmeltg(i)=
max(dmeltg(i),
182 . (dtmins/dtfacs)**2 * sti(i) - two*mmin)
183 dt(i) = dtfacs*
184 . sqrt((two*mmin+dmeltg(i))/
max(em20,sti(i)))
185 IF(dt(i)<dt2t)THEN
186 dt2t = dt(i)
187 neltst = ngl(i)
188 ityptst = 7
189 END IF
190 END DO
191 ENDIF
192
193 ELSE
194 f_oset(jft:jlt)= one + zep2*abs(zoffset(jft:jlt))/thk0(jft:jlt)
195 IF(igtyp==1.OR.igtyp==9) THEN
196 DO i=jft,jlt
197 f_dte(i) = one/sqrt(f_oset(i))
198 END DO
199 END IF
200 IF (mtn == 42 .or. mtn == 62 .or. mtn == 69) THEN
201 DO i=jft,jlt
202 fac = ssp(i)/
max(ssp_eq(i),ssp(i))
203 f_dte(i) = fac*f_dte(i)
204 ENDDO
205 DO i=jft,jlt
206 fac =
max(ssp_eq(i),ssp(i))/ssp(i)
207 f_oset(i) = fac*fac*f_oset(i)
208 ENDDO
209 END IF
210 ENDIF
211
212 DO i=jft,jlt
213 dt(i)=dtfac1(7)*f_dte(i)*aldt(i)/ssp(i)
214 END DO
215 IF(g_dt/=zero)THEN
216 DO i=jft,jlt
218 ENDDO
219 ENDIF
220
221 IF (idtmin(7)==0) RETURN
222
223 nindx=iofc
224 IF(idtmin(7)==1)THEN
225 DO 100 i=jft,jlt
226 IF(dt(i)>dtmin1(7).OR.off(i)<one
227 . .OR.offg(i)==two.OR.offg(i)<zero) GO TO 100
228 tstop = tt
229
230#include "lockon.inc"
231 WRITE(iout,1000) ngl(i)
232 WRITE(istdo,1000) ngl(i)
233#include "lockoff.inc"
234 100 CONTINUE
235 ELSEIF(idtmin(7)==2)THEN
236 DO 120 i=jft,jlt
237 IF(dt(i)>dtmin1(7).OR.off(i)<one
238 . .OR.offg(i)<zero) GO TO 120
239 off(i)=zero
240
241 ii=i+nft
242 nindx=nindx+1
243 indx(nindx)=i
244 idel7nok = 1
245
246#include "lockon.inc"
247 WRITE(iout,1200) ngl(i)
248 WRITE(istdo,1300) ngl(i),tt
249#include "lockoff.inc"
250 120 CONTINUE
251 iofc = nindx
252 ELSEIF(ismstr==2.AND.idtmin(7)==3)THEN
253 DO 140 i=jft,jlt
254 IF(dt(i)>dtmin1(7).OR.
255 . off(i)<one.OR.offg(i)==two.OR.offg(i)<zero) GO TO 140
256 offg(i)=two
257
258#include "lockon.inc"
259 WRITE(iout,1400) ngl(i)
260 WRITE(istdo,1400) ngl(i)
261#include "lockoff.inc"
262 140 CONTINUE
263 ELSEIF(idtmin(7)==5)THEN
264 DO 150 i=jft,jlt
265 IF(dt(i)>dtmin1(7).OR.off(i)<one.
266 . or.offg(i)==two.OR.offg(i)<zero) GO TO 150
267 mstop = 2
268
269#include "lockon.inc"
270 WRITE(iout,1000) ngl(i)
271 WRITE(istdo,1000) ngl(i)
272#include "lockoff.inc"
273 150 CONTINUE
274 ENDIF
275
276 IF(nodadt/=0.OR.(idtmins==2.AND.jsms/=0))RETURN
277
278
279 idt=0
280 DO i=jft,jlt
281 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t) idt=1
282 ENDDO
283
284 IF(idt==1)THEN
285 DO i=jft,jlt
286 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t)THEN
287 dt2t = dt(i)
288 neltst = ngl(i)
289 ityptst = 7
290 ENDIF
291 ENDDO
292 ENDIF
293
294 IF(idtmins==2)RETURN
295
296 DO i=jft,jlt
297 sti(i) =
area(i) * thk0(i) * f_oset(i) * a1(i) / aldt(i)**2
298 sti(i) = zep81 * zep81 * sti(i) * off(i)
299 stir(i)= zero
300 ENDDO
301
302 1000 FORMAT(1x,'-- MINIMUM TIME STEP 3N SHELL ELEMENT NUMBER ',i10)
303 1200 FORMAT(1x,'-- DELETE 3N SHELL ELEMENT NUMBER ',i10)
304 1300 FORMAT(1x,'-- DELETE 3N SHELL ELEMENT :',i10,' AT TIME :',g11.4)
305 1400 FORMAT(1x,'-- CONSTANT TIME STEP 3N SHELL ELEMENT NUMBER ',i10)
306
307 RETURN
subroutine cssp2a11(pm, imat, ssp, a11, nel, iflag)
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
subroutine area(d1, x, x2, y, y2, eint, stif0)