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