39
40
41
42#include "implicit_f.inc"
43
44
45
46#include "mvsiz_p.inc"
47
48
49
50#include "com08_c.inc"
51#include "param_c.inc"
52
53
54
55 INTEGER JLT, IELECI(MVSIZ),NPC(*),IELESI(MVSIZ),
56 . IFUNCTK,INTTH,IFORM
57
59 . tint,frad,drad,dydx,xthe,
60 . pm(npropm,*),tf(*),tempi1(mvsiz),tempi2(mvsiz),tempm1(mvsiz),
61 . tempm2(mvsiz),penrad(mvsiz),phis1(mvsiz),phis2(mvsiz),
62 . kthe,areas1(mvsiz),areas2(mvsiz),gapv(mvsiz),
63 . fni(mvsiz),hs1(mvsiz), hs2(mvsiz), hm1(mvsiz), hm2(mvsiz),
64 . condints1(mvsiz),condints2(mvsiz),phim1(mvsiz),phim2(mvsiz),
65 . condintm1(mvsiz),condintm2(mvsiz),areac(mvsiz),phi(mvsiz),
66 . condint
67
68
69
70
71 INTEGER I, II,L,NB3M, I3N,LS,J,IE,MAT
72
74 . ts1, ts2, tm1 ,tm2, dist, conds1 ,conds2 ,tstifm1 ,
75 . tstifm ,tstift,tm,p,rstiff,ts,condm1,condm2,conds,condm,
76 . cond,rstif
78 . finter
79 EXTERNAL finter
80
81
82
83 IF (iform == 0) THEN
84
85 IF(ifunctk==0)THEN
86 rstif = one/
max(em30,kthe)
87
88 DO i=1,jlt
89 phis1(i) = zero
90 phis2(i) = zero
91 phim1(i) = zero
92 phim2(i) = zero
93
94 ts1 = tempi1(i)
95 ts2 = tempi2(i)
96 ts = hs1(i)*ts1+hs2(i)*ts2
97 condints1(i) = zero
98 condints2(i) = zero
99 condintm1(i) = zero
100 condintm2(i) = zero
101
102
103
104
105
106 IF(penrad(i) <= zero) THEN
107
108
109
110 mat = ieleci(i)
111 conds1 = pm(75,mat) + pm(76,mat)*ts1
112 conds2 = pm(75,mat) + pm(76,mat)*ts2
113 cond = hs1(i)*conds1 + hs2(i)*conds2
114 dist = penrad(i) + gapv(i)
115 tstifm =
max(dist,zero) /cond
116 tstift = tstifm + rstif
117
118 phi(i) = areac(i) * (tint - ts)*dt1 / tstift
119
120 condint = areac(i)/tstift
121 condints1(i) = hs1(i) *condint
122 condints2(i) = hs2(i) *condint
123 ELSEIF(penrad(i) <= drad) THEN
124
125
126
127 phi(i) = frad * areac(i) * (tint*tint+ts*ts)
128 . * (tint + ts) * (tint - ts) * dt1
129 ENDIF
130
131 phis1(i) = hs1(i) * phi(i)
132 phis2(i) = hs2(i) * phi(i)
133
134 ENDDO
135
136 ELSE
137
138
139
140
141 DO i=1,jlt
142 phis1(i) = zero
143 phis2(i) = zero
144 phim1(i) = zero
145 phim2(i) = zero
146
147 ts1 = tempi1(i)
148 ts2 = tempi2(i)
149 ts = hs1(i)*ts1+hs2(i)*ts2
150 condints1(i) = zero
151 condints2(i) = zero
152 condintm1(i) = zero
153 condintm2(i) = zero
154
155
156
157
158
159
160
161
162
163
164 IF(penrad(i) <= zero) THEN
165
166
167
168 mat = ieleci(i)
169
170
171
172
173 p = xthe * fni(i) / areac(i)
174 rstiff = one /
max(em30,finter(ifunctk,p,npc,tf,dydx)*kthe)
175 cond = pm(75,mat)+pm(76,mat)*ts
176 dist = penrad(i) + gapv(i)
177 tstifm =
max(dist,zero) / cond
178 tstift = tstifm + rstiff
179
180 condint = areac(i)/tstift
181 condints1(i) = hs1(i) *condint
182 condints2(i) = hs2(i) *condint
183
184 phi(i) = areac(i) * (tint - ts)*dt1 / tstift
185
186 ELSEIF(penrad(i) <= drad)THEN
187
188
189
190 phi(i) = frad * areac(i) * (tint*tint+ts*ts)
191 . * (tint + ts) * (tint - ts) * dt1
192 ENDIF
193
194 phis1(i) = hs1(i) * phi(i)
195 phis2(i) = hs2(i) * phi(i)
196
197 ENDDO
198
199 ENDIF
200
201 ELSE
202
203 IF(ifunctk==0)THEN
204
205
206
207
208 rstif = one/
max(em30,kthe)
209 DO i=1,jlt
210 phis1(i) = zero
211 phis2(i) = zero
212 phim1(i) = zero
213 phim2(i) = zero
214
215 ts1 = tempi1(i)
216 ts2 = tempi2(i)
217 tm1 = tempm1(i)
218 tm2 = tempm2(i)
219 ts = hs1(i)*ts1+hs2(i)*ts2
220 tm = hm1(i)*tm1+hm2(i)*tm2
221 condints1(i) = zero
222 condints2(i) = zero
223 condintm1(i) = zero
224 condintm2(i) = zero
225
226
227
228
229
230 IF(penrad(i) <= zero) THEN
231
232
233
234
235 mat = ieleci(i)
236 conds1 = pm(75,mat)+pm(76,mat)*ts1
237 conds2 = pm(75,mat)+pm(76,mat)*ts2
238 mat = ielesi(i)
239 condm1 = pm(75,mat)+pm(76,mat)*tm1
240 condm2 = pm(75,mat)+pm(76,mat)*tm2
241 conds = hs1(i)*conds1+hs2(i)*conds2
242 condm = hm1(i)*condm1+hm2(i)*condm2
243 cond = (condm+conds)/2
244 dist = penrad(i) + gapv(i)
245 tstifm =
max(dist,zero) /cond
246 tstift = tstifm + rstif
247
248 phi(i) = areac(i) * (tm - ts)*dt1 / tstift
249
250 condint = areac(i)/tstift
251 condints1(i) = hs1(i) *condint
252 condints2(i) = hs2(i) *condint
253 condintm1(i) = hm1(i) *condint
254 condintm2(i) = hm2(i) *condint
255
256 ELSEIF(penrad(i) <= drad) THEN
257
258
259
260 phi(i) = frad * areac(i) * (tm*tm+ts*ts)
261 . * (tm + ts) * (tm - ts) * dt1
262 ENDIF
263
264 phis1(i) = hs1(i) * phi(i)
265 phis2(i) = hs2(i) * phi(i)
266 phim1(i) = -hm1(i) * phi(i)
267 phim2(i) = -hm2(i) * phi(i)
268 ENDDO
269
270 ELSE
271
272 DO i=1,jlt
273 phis1(i) = zero
274 phis2(i) = zero
275 phim1(i) = zero
276 phim2(i) = zero
277
278 ts1 = tempi1(i)
279 ts2 = tempi2(i)
280 tm1 = tempm1(i)
281 tm2 = tempm2(i)
282 ts = hs1(i)*ts1+hs2(i)*ts2
283 tm = hm1(i)*tm1+hm2(i)*tm2
284 condints1(i) = zero
285 condints2(i) = zero
286 condintm1(i) = zero
287 condintm2(i) = zero
288
289 IF(penrad(i) <= zero) THEN
290
291
292
293 p = xthe * fni(i) / areac(i)
294 rstiff = one /
max(em30,finter(ifunctk,p,npc,tf,dydx)*kthe)
295 mat = ieleci(i)
296 conds1 = pm(75,mat)+pm(76,mat)*ts1
297 conds2 = pm(75,mat)+pm(76,mat)*ts2
298 mat = ielesi(i)
299 condm1 = pm(75,mat)+pm(76,mat)*tm1
300 condm2 = pm(75,mat)+pm(76,mat)*tm2
301 conds = hs1(i)*conds1+hs2(i)*conds2
302 condm = hm1(i)*condm1+hm2(i)*condm2
303 cond = (condm+conds)/2
304 dist = penrad(i) + gapv(i)
305 tstifm =
max(dist,zero) /cond
306 tstift = tstifm + rstiff
307
308 condint = areac(i)/tstift
309 condints1(i) = hs1(i) *condint
310 condints2(i) = hs2(i) *condint
311 condintm1(i) = hm1(i) *condint
312 condintm2(i) = hm2(i) *condint
313
314 phi(i) = areac(i) * (tm - ts)*dt1 / tstift
315
316 ELSEIF(penrad(i) <= drad)THEN
317
318
319
320 phi(i) = frad * areac(i) * (tm*tm+ts*ts)
321 . * (tm + ts) * (tm - ts) * dt1
322 ENDIF
323
324 phis1(i) = hs1(i) * phi(i)
325 phis2(i) = hs2(i) * phi(i)
326 phim1(i) = -hm1(i) * phi(i)
327 phim2(i) = -hm2(i) * phi(i)
328
329
330 ENDDO
331 ENDIF
332 ENDIF
333
334 RETURN