35
36
37
38#include "implicit_f.inc"
39#include "comlock.inc"
40
41
42
43#include "mvsiz_p.inc"
44
45
46
47#include "com08_c.inc"
48#include "param_c.inc"
49#include "scr02_c.inc"
50#include "scr07_c.inc"
51#include "scr17_c.inc"
52#include "scr18_c.inc"
53#include "sms_c.inc"
54#include "units_c.inc"
55
56
57
58 INTEGER, INTENT(IN) :: NEL
59 INTEGER, INTENT(IN) :: IGTYP
60 INTEGER, INTENT(IN) :: JSMS
62 INTEGER,INTENT(IN) :: G_DT
63 INTEGER JFT,JLT,NELTST ,,MAT(MVSIZ),PID(MVSIZ),
64 . NGL(MVSIZ)
66 . pm(npropm,*), geo(npropg,*), offg(*), sti(*), stir(*),
67 . msp(*), dmelp(*),al(mvsiz)
68
69
70
71 INTEGER I
73 . ssp(mvsiz), dt(mvsiz), dmp(mvsiz), fac(mvsiz),
74 . a1, b1, b2, b3, young,g,aa,bb,
75 . phi,shf,dsh(mvsiz),sl2i(mvsiz),
76 . facdt(mvsiz),phii(mvsiz),cst,phmax,
77 . kphi(mvsiz),phmin,fsh(mvsiz)
78
79 dt(1:mvsiz) = zero
80
81 DO i=1,nel
82 dmp(i)=
max(geo(16,pid(i)),geo(17,pid(i)))
83 ENDDO
84
85
86
87
88 DO i=1,nel
89 young = pm(20,mat(i))
90 g = pm(22,mat(i))
91 cst = six_over_5*young/g
92 a1 =geo(1,pid(i))
93 b1 =geo(2,pid(i))
94 b2 =geo(18,pid(i))
96 sl2i(i) = a1*al(i)**2 / bb
97 facdt(i) = one_over_12*sl2i(i)
98 phmax = cst/facdt(i)
99 phmin =
min(b1,b2)*phmax/bb
100 kphi(i) = (four+phmin)/(one+phmin)
101 phii(i) = kphi(i)/(one+facdt(i))
102 phii(i) =
max(one,phii(i))
103 fsh(i) = al(i)/(facdt(i)+cst)
104 fsh(i) =
max(one,fsh(i))
105 ENDDO
106 IF (igtyp == 18) THEN
107 fsh(1:nel) = one
108 kphi(1:nel) =
max(one,sl2i(1:nel))
109 END IF
110 IF (idtmins /= 2 .OR. jsms == 0) THEN
111 IF (nodadt /= 0 .OR. idtmins == 2) THEN
112 DO i=jft,jlt
113 sti(i) = zero
114 stir(i) = zero
115 ssp(i) =pm(27,mat(i))
116 fac(i)=zero
117 IF (offg(i) /= zero) THEN
118 young =pm(20,mat(i))
119 g =pm(22,mat(i))
120 a1 =geo(1,pid(i))
121 b1 =geo(2,pid(i))
122 b2 =geo(18,pid(i))
123 b3 =geo(4,pid(i))
124 dmp(i)=dmp(i)*sqrt(two)
125 aa =(sqrt(one +dmp(i)*dmp(i))-dmp(i))
126 aa = al(i) * aa * aa
128 stir(i) =
max(g*b3,kphi(i)*young*bb) / aa
129 sti(i) = fsh(i)*a1 * young / aa
130 ENDIF
131 ENDDO
132 IF (idtmin(5) == 0) RETURN
133 ELSE
134 DO i=jft,jlt
135 sti(i) = zero
136 stir(i) = zero
137 ssp(i) =pm(27,mat(i))
138 young =pm(20,mat(i))
139 a1 =geo(1,pid(i))
140 dmp(i)=dmp(i)*sqrt(two)
141 IF (offg(i) > zero) sti(i) = fsh(i)*a1 * young / al(i)
142 ENDDO
143 ENDIF
144 ELSE
145
146 DO i=jft,jlt
147 sti(i) = zero
148 stir(i) = zero
149 ssp(i) =pm(27,mat(i))
150 fac(i)=zero
151 IF (offg(i) /= zero) THEN
152 young =pm(20,mat(i))
153 g =pm(22,mat(i))
154 a1 =geo(1,pid(i))
155 b1 =geo(2,pid(i))
156 b2 =geo(18,pid(i))
157 b3 =geo(4,pid(i))
158 dmp(i)=dmp(i)*sqrt(two)
159 aa =(sqrt(one +dmp(i)*dmp(i))-dmp(i))
160 aa = al(i) * aa * aa
162 stir(i) =
max(g*b3,four*young*bb) / aa
163 sti(i) = a1 * young / aa
164
165 sl2i(i)= a1*al(i)**2 /
max(b1,b2,em30)
166 shf = one-geo(37,pid(i))
167 phi = twelve*young/(five/six*g)/
max(em30,sl2i(i))
168 dsh(i) = dmp(i)
170 . sqrt(twelve/
max(em30,sl2i(i)))*sqrt(one+phi*shf))
171 aa = sqrt(one+dsh(i)*dsh(i))-dsh(i)
172 aa = al(i) * aa * aa
173 sti(i) =
max(sti(i),twelve*bb*young/al(i)/al(i) / aa)
174 ENDIF
175 ENDDO
176
177 DO i=jft,jlt
178 IF (offg(i) /= zero) THEN
179
180
181 dmelp(i)=
max(dmelp(i),
182 . half*(dtmins/dtfacs)**2 * sti(i) - msp(i))
183 dt(i)=dtmins
184 IF (dt(i) < dt2t) THEN
185 dt2t = dt(i)
186 neltst = ngl(i)
187 ityptst = 5
188 ENDIF
189 ENDIF
190 ENDDO
191
192 RETURN
193 ENDIF
194
195 DO i=jft,jlt
196 fac(i) =sqrt(one+dmp(i)*dmp(i))-dmp(i)
197 dt(i)=dtfac1(5)*fac(i)*al(i)/ssp(i)/sqrt(fsh(i))
198 ENDDO
199
200 DO i=jft,jlt
201 IF (dt(i) < dtmin1(5) .AND. offg(i) == one) THEN
202 IF (idtmin(5) == 1 ) THEN
203 tstop = tt
204#include "lockon.inc"
205 WRITE(iout,*)
206 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
207 WRITE(istdo,*)
208 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
209#include "lockoff.inc"
210 ELSEIF (idtmin(5) == 2) THEN
211 offg(i)=zero
212#include "lockon.inc"
213 WRITE(iout,*) '-- DELETE OF BEAM ELEMENT NUMBER',ngl(i)
214#include "lockoff.inc"
215 idel7nok = 1
216 ELSEIF (idtmin(5) == 5) THEN
217 mstop = 2
218#include "lockon.inc"
219 WRITE(iout,*)
220 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
221 WRITE(istdo,*)
222 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
223#include "lockoff.inc"
224 ENDIF
225 ENDIF
226 ENDDO
227
228 IF (nodadt /= 0) RETURN
229
230 DO i=jft,jlt
231 IF (dt(i) < dt2t .and. offg(i) > zero) THEN
232 dt2t=dt(i)
233 neltst =ngl(i)
234 ityptst=5
235 ENDIF
236 ENDDO
237
238 IF (g_dt /= zero) THEN
239 DO i=jft,jlt
241 ENDDO
242 ENDIF
243
244 RETURN
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)