44
45
46
47#include "implicit_f.inc"
48
49
50
51#include "mvsiz_p.inc"
52
53
54
55#include "param_c.inc"
56
57
58
59
60 INTEGER JFT,JLT,IPLA,NEL,IOFC,JTHE,IPT,NPTT,IMAT,ISRATE
61 INTEGER NGL(MVSIZ),IOFF_DUCT(*),INLOC
62 INTEGER, INTENT(IN) :: VP
63 my_real ,
DIMENSION(NEL),
INTENT(IN) :: epspxx,epspyy,epspxy,epspyz,epspzx
64 my_real ,
DIMENSION(NEL),
INTENT(IN) :: epsd_pg
67 my_real,
DIMENSION(NEL),
INTENT(IN) :: loff
68 my_real pm(npropm,*),eint(nel,2),
69 . off(*),sigy(*),vol(*),gs(*),thk(*),
70 . tstar(*),dpla(*),sigksi(mvsiz,5),etse(mvsiz),
71 . depsxx(mvsiz),depsyy(mvsiz),depsxy(mvsiz),depsyz(mvsiz),
72 . depszx(mvsiz),pla(nel),
73 . sigbakxx(nel),sigbakyy(nel),sigbakxy(nel),
74 . sigoxx(nel),sigoyy(nel),sigoxy(nel),sigoyz(nel),sigozx(nel),
75 . off_old(mvsiz),thklyl(nel),dplanl(nel)
76
77 my_real signxx(nel),signyy(nel),signxy(nel),
78 . signyz(nel),signzx(nel),epchk(mvsiz),g_imp(mvsiz)
79
81 my_real,
DIMENSION(NEL) ,
INTENT(INOUT) :: tempel
82 my_real,
DIMENSION(NEL) ,
INTENT(INOUT) :: fheat
83 my_real,
DIMENSION(NEL) ,
INTENT(INOUT) :: epsd
84
85
86
87 INTEGER ICC,IRTY,I,J,NPIF
89 . dav,deve1,deve2,deve3,deve4,z3,z4,fisokin,
90 . epif,young,ti,tm,g,a11,a12,nu,
91 .
ymax(mvsiz),plap(mvsiz),
92 . epdr(mvsiz),yld(mvsiz),epsdot(mvsiz),
93 . t(mvsiz),rhocp,tref,tmelt
94
95
96 ezz(1:mvsiz) = zero
97
98
99 young = pm(20,imat)
100 nu = pm(21,imat)
101 g = pm(22,imat)
102 a11 = pm(24,imat)
103 a12 = pm(25,imat)
104 ca = pm(38,imat)
105 cb = pm(39,imat)
106 cn = pm(40,imat)
107 epmx = pm(41,imat)
109 cc = pm(43,imat)
110 icc = nint(pm(49,imat))
111 irty = nint(pm(50,imat))
112 z3 = pm(51,imat)
113 fisokin= pm(55,imat)
114
115
116 DO i=jft,jlt
117 epdr(i) =
max(em20,pm(44,imat)*dt1)
118 ENDDO
119
120 IF (irty == 1) THEN
121 rhocp = pm(53,imat)
122 z4 = pm(52,imat)
123 tref = pm(54,imat)
124 IF (jthe /= 0) THEN
125 DO i=jft,jlt
126 tempel(i) = tref + rhocp*(eint(i,1)+eint(i,2))/vol(i)
127 ENDDO
128 ENDIF
129 ELSE
130 rhocp = pm(69,imat)
131 tref = pm(79,imat)
132 tmelt = pm(80,imat)
133 DO i=jft,jlt
134 tstar(i) =
max( zero, (tempel(i)-tref)/(tmelt-tref) )
135 ENDDO
136 END IF
137
138
139
140
141
142 IF (vp == 1) THEN
143 DO i=jft,jlt
144 epsdot(i) = epsd(i)*dt1
145 ENDDO
146
147 ELSEIF (vp == 2) THEN
148 DO i=jft,jlt
149 epsd(i) = asrate*epsd_pg(i) + (one-asrate)*epsd(i)
150 epsdot(i) = epsd(i) * dt1
151 ENDDO
152
153 ELSEIF (vp == 3) THEN
154 DO i=jft,jlt
155 dav = (epspxx(i)+epspyy(i))*third
156 deve1 = epspxx(i) - dav
157 deve2 = epspyy(i) - dav
158 deve3 = - dav
159 deve4 = half*epspxy(i)
160 epsdot(i) = half*(deve1**2 + deve2**2 + deve3**2) + deve4**2
161 epsdot(i) = sqrt(three*epsdot(i))/three_half
162 IF (israte > 0) THEN
163 epsdot(i) = asrate*epsdot(i) + (one - asrate)*epsd(i)
164 ENDIF
165 epsd(i) = epsdot(i)
166 epsdot(i) = epsdot(i)*dt1
167 ENDDO
168 ENDIF
169
170
171
172 CALL m2cplr(jft ,jlt ,ezz ,off_old ,pla ,
173 2 ipla ,tempel ,z3 ,z4 ,
174 3 irty ,etse ,gs ,epsdot ,
175 4 israte ,yld ,g ,a11 ,a12 ,
176 5 nu ,ca ,cb ,cn ,
ymax ,
177 6 epchk ,young ,cc ,epdr ,icc ,
178 7 dpla ,tstar ,fisokin ,g_imp ,sigksi ,
179 8 hardm ,nel ,depsxx ,depsyy ,depsxy ,
180 9 depsyz ,depszx ,signxx ,signyy ,signxy ,
181 a signyz ,signzx ,sigbakxx ,sigbakyy ,sigbakxy,
182 b sigoxx ,sigoyy ,sigoxy ,sigoyz ,sigozx ,
183 c vp )
184
185
186
187
188 IF (vp == 1) THEN
189 DO i=jft,jlt
190 epsdot(i) = dpla(i)/
max(em20,dt1)
191 epsd(i) = asrate*epsdot(i) + (one - asrate)*epsd(i)
192 ENDDO
193 ENDIF
194
195 DO i=jft,jlt
196 sigy(i) = sigy(i) + yld(i)/nptt
197 ENDDO
198
199
200
201 DO i=jft,jlt
202 IF (off(i) == off_old(i) .and. off(i) > zero) THEN
203 IF (off(i) == one .and. epchk(i) >= epmx) THEN
204 off(i)= four_over_5
205 ioff_duct(i) = 1
206 ELSE IF (off(i) < one ) THEN
207 off(i) = off(i)*four_over_5
208 ENDIF
209 ENDIF
210 ENDDO
211
212
213
214 DO i=jft,jlt
215 IF (inloc > 0) THEN
216 IF (loff(i) == one) THEN
217 ezz(i) = -nu*(signxx(i)-sigoxx(i)+signyy(i)-sigoyy(i))/young
218 ezz(i) = ezz(i) -
max(dplanl(i),zero)*half*(signxx(i)+signyy(i))/yld(i)
219 ENDIF
220 ELSE
221 ezz(i) = -(depsxx(i)+depsyy(i))*nu-(one - two*nu)*ezz(i)
222 ezz(i) = ezz(i)/(one-nu)
223 ENDIF
224 thk(i) = thk(i) + ezz(i) * thklyl(i)*off(i)
225 ENDDO
226
227
228
229 IF (jthe /= 0) THEN
230
231 DO i=1,nel
232 fheat(i) = fheat(i) + sigy(i)*dpla(i)*vol(i)
233 ENDDO
234 ELSEIF(rhocp > zero)THEN
235 IF(irty /= 1)THEN
236 DO i=1,nel
237 tempel(i) = tempel(i) + sigy(i)*dpla(i) / rhocp
238
239
240 ENDDO
241 ENDIF
242 END IF
243
244 RETURN
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
subroutine m2cplr(jft, jlt, ezz, off, pla, ipla, temp, z3, z4, irty, etse, gs, epsp, israte, yld, g, a1, a2, nu, ca0, cb0, cn, ymax0, epchk, young, cc, epdr, icc, dpla, tstar, fisokin, gama_imp, signor, hardm, nel, depsxx, depsyy, depsxy, depsyz, depszx, signxx, signyy, signxy, signyz, signzx, sigbakxx, sigbakyy, sigbakxy, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, vp)