OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
m25cplrc2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine m25cplrp2 (jft, jlt, wplaref, thk, off, etse, wpla, dir, npt, cc, epdr, icc, wwpla, shf, fmax, cb, cn, nel, degmb, f1, f2, f12, f11, f22, f33, e11, e22, nu12, nu21, g12, g23, g31, de, epsd, israte, sigy, depsxx, depsyy, depsxy, depsyz, depszx, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, signxx, signyy, signxy, signyz, signzx, tsaiwu, asrate, epsd_pg)

Function/Subroutine Documentation

◆ m25cplrp2()

subroutine m25cplrp2 ( integer jft,
integer jlt,
wplaref,
thk,
off,
etse,
wpla,
dir,
integer npt,
cc,
epdr,
integer, dimension(*) icc,
wwpla,
shf,
fmax,
cb,
cn,
integer nel,
degmb,
f1,
f2,
f12,
f11,
f22,
f33,
e11,
e22,
nu12,
nu21,
g12,
g23,
g31,
de,
intent(inout) epsd,
integer israte,
sigy,
depsxx,
depsyy,
depsxy,
depsyz,
depszx,
sigoxx,
sigoyy,
sigoxy,
sigoyz,
sigozx,
signxx,
signyy,
signxy,
signyz,
signzx,
tsaiwu,
intent(in) asrate,
intent(in) epsd_pg )

Definition at line 28 of file m25cplrc2.F.

37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com08_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER JFT, JLT, NPT,ICC(*), ISRATE,NEL
53C REAL
54 my_real ,INTENT(IN) :: asrate
55 my_real ,DIMENSION(NEL) ,INTENT(IN) :: epsd_pg
56 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: epsd
57 my_real
58 . thk(*), off(*), wpla(*), dir(*),cc(*),
59 . epdr(*),wwpla(*),shf(*),fmax(mvsiz),
60 . cb(mvsiz), cn(mvsiz), degmb(mvsiz),
61 . e11(mvsiz), e22(mvsiz), nu12(mvsiz), nu21(mvsiz),
62 . g12(mvsiz), g23(mvsiz), g31(mvsiz),
63 . f1(mvsiz), f2(mvsiz), f12(mvsiz), f11(mvsiz), f22(mvsiz),
64 . f33(mvsiz), wplaref(mvsiz),sigy(*),etse(*),
65 . depsxx(mvsiz),depsyy(mvsiz),depsxy(mvsiz),depsyz(mvsiz),
66 . depszx(mvsiz),sigoxx(nel),sigoyy(nel),sigoxy(nel),
67 . sigoyz(nel),sigozx(nel),signxx(nel),signyy(nel),signxy(nel),
68 . signyz(nel),signzx(nel),tsaiwu(nel)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I
73C REAL
74 my_real
75 . dp1(mvsiz), dp2(mvsiz), dp3(mvsiz),
76 . lamda(mvsiz), coef(mvsiz),
77 . s1(mvsiz), s2(mvsiz), s3(mvsiz), s4(mvsiz), s5(mvsiz),
78 . ds1(mvsiz), ds2(mvsiz), ds3(mvsiz), de(mvsiz),
79 . de1(mvsiz), de2(mvsiz), wvec(mvsiz), t1(mvsiz),
80 . t2(mvsiz), t3(mvsiz), epspfac(mvsiz),
81 . a11(mvsiz), a12(mvsiz), a22(mvsiz),
82 . so1(mvsiz), so2(mvsiz), so3(mvsiz),
83 . scale, fyld, cnn,ht,yld(mvsiz),sig(nel,5)
84C-----------------------------------------------
85 DO i=jft,jlt
86 sig(i,1) = sigoxx(i)
87 sig(i,2) = sigoyy(i)
88 sig(i,3) = sigoxy(i)
89 sig(i,4) = sigoyz(i)
90 sig(i,5) = sigozx(i)
91 ENDDO
92!
93C
94!! temporary replaced by (the same) ROTO_SIG() in order to do not affect
95!! the other multidimensional buffer ARRAYS which are still not modified
96! CALL ROTO_SIG(JFT,JLT,SIG,DIR,NEL)
97!! CALL ROTO(JFT,JLT,SIG,DIR)
98! DO I=JFT,JLT
99! EPS(I,3)=HALF*EPS(I,3)
100! EPS(I,4)=HALF*EPS(I,4)
101! EPS(I,5)=HALF*EPS(I,5)
102! ENDDO
103C
104! CALL ROTOV(JFT,JLT,EPS,DIR,NEL)
105C
106! DO I=JFT,JLT
107! EPS(I,3)=TWO*EPS(I,3)
108! EPS(I,4)=TWO*EPS(I,4)
109! EPS(I,5)=TWO*EPS(I,5)
110! ENDDO
111C-----------------------------
112C DEFORMATIONS ELASTIQUES
113C-----------------------------
114 DO i=jft,jlt
115 de1(i)= max(de(i),sign(one,sig(i,1)))
116 de2(i)= max(de(i),sign(one,sig(i,2)))
117 scale = (half+sign(half,de1(i)-one))
118 * *(half+sign(half,de2(i)-one))
119C
120 s1(i) = sig(i,1)/de1(i)-nu12(i)*sig(i,2)*scale
121 s2(i) = sig(i,2)/de2(i)-nu21(i)*sig(i,1)*scale
122 s1(i)=s1(i)/e11(i)
123 s2(i)=s2(i)/e22(i)
124 s3(i)=sig(i,3)/de1(i)/de2(i)/g12(i)
125 s4(i)=sig(i,4)/max(de2(i)*g23(i)*shf(i),em30)
126 s5(i)=sig(i,5)/max(de1(i)*g31(i)*shf(i),em30)
127 ENDDO
128C
129 IF (npt == 1) THEN
130 DO i=jft,jlt
131 degmb(i)= degmb(i)
132 . -(sig(i,1)*s1(i)+sig(i,2)*s2(i)+sig(i,3)*s3(i))
133 ENDDO
134 ENDIF
135C
136 DO i=jft,jlt
137 s1(i)=s1(i)+depsxx(i)
138 s2(i)=s2(i)+depsyy(i)
139 s3(i)=s3(i)+depsxy(i)
140 s4(i)=s4(i)+depsyz(i)
141 s5(i)=s5(i)+depszx(i)
142C
143 de1(i)= max(de(i),sign(one,s1(i)))
144 de2(i)= max(de(i),sign(one,s2(i)))
145 scale = (half+sign(half,de1(i)-one))
146 * *(half+sign(half,de2(i)-one))
147C
148 a12(i)=one -nu12(i)*nu21(i)*scale
149 a11(i)=e11(i)*de1(i)/a12(i)
150 a22(i)=e22(i)*de2(i)/a12(i)
151 a12(i) = nu21(i)*a11(i)*scale
152 ENDDO
153C-------------------------------------------------------------------
154C CONTRAINTES ELASTIQUES
155C-----------------------------
156 DO i=jft,jlt
157 t1(i) =a11(i)*s1(i)+a12(i)*s2(i)
158 t2(i) =a12(i)*s1(i)+a22(i)*s2(i)
159 t3(i) =de1(i)*de2(i)*g12(i)*s3(i)
160 sig(i,4)=de2(i)*g23(i)*shf(i)*s4(i)
161 sig(i,5)=de1(i)*g31(i)*shf(i)*s5(i)
162 ENDDO
163C
164 IF (npt == 1) THEN
165 DO i=jft,jlt
166 degmb(i) = degmb(i)+(t1(i)*s1(i)+t2(i)*s2(i)+t3(i)*s3(i))
167 ENDDO
168 ENDIF
169C-------------------------------------------------------------------
170C PLASTICITE
171C-------------------------------------------------------------------
172 DO i=jft,jlt
173 so1(i)=sig(i,1)
174 so2(i)=sig(i,2)
175 so3(i)=sig(i,3)
176 ENDDO
177C
178 DO i=jft,jlt
179 wvec(i)=f1(i) *t1(i) +f2(i) *t2(i) +
180 . f11(i)*t1(i)*t1(i)+f22(i)*t2(i)*t2(i) +
181 . f33(i)*t3(i)*t3(i)+
182 . two*f12(i)*t1(i)*t2(i)
183!!c equiv crit for output
184!! SEQ_OUTPUT(I) = WVEC(I)
185 ENDDO
186C
187 DO i=jft,jlt
188 IF (israte == 0) THEN
189 epsd(i) = max(abs(depsxx(i)),abs(depsyy(i)),abs(depsxy(i)),
190 . abs(depsyz(i)),abs(depszx(i)))/max(dt1,em20)
191 ELSE
192 epsd(i) = asrate*epsd_pg(i) + (one-asrate)*epsd(i)
193 END IF
194 IF (epsd(i) > epdr(i) .AND. cc(i) /= zero) THEN
195 epspfac(i)=one + cc(i) * log(epsd(i)/epdr(i))
196 ELSE
197 epspfac(i)=one
198 ENDIF
199 coef(i)=zero
200 fyld= (one +cb(i)*wpla(i)**cn(i))*epspfac(i)
201 IF(icc(i) == 1 .OR. icc(i) == 3) THEN
202 fmax(i) = fmax(i)*epspfac(i)
203 ENDIF
204 IF (icc(i) == 2 .OR. icc(i) == 4) THEN
205 wwpla(i) = epspfac(i)
206 ELSE
207 wwpla(i) = one
208 ENDIF
209 fyld= min(fmax(i),fyld)
210 IF (wvec(i) > fyld .AND. off(i) == one) coef(i) = one
211 wvec(i)=one
212 cnn=cn(i)-one
213 IF(wpla(i)>zero) wvec(i)=epspfac(i)*wpla(i)**cnn
214 yld(i) = fyld
215 tsaiwu(i) = max(min(wvec(i)/fyld,one),tsaiwu(i))
216 ENDDO
217C
218 DO i=jft,jlt
219 dp1(i)=f1(i)+2*f11(i)*so1(i)+2*f12(i)*so2(i)
220 dp2(i)=f2(i)+2*f22(i)*so2(i)+2*f12(i)*so1(i)
221 dp3(i)=two*f33(i)*so3(i)
222 ENDDO
223C
224 DO i=jft,jlt
225 ds1(i)=t1(i)-so1(i)
226 ds2(i)=t2(i)-so2(i)
227 ds3(i)=t3(i)-so3(i)
228 ENDDO
229C
230 DO i=jft,jlt
231 lamda(i)=(dp1(i)*ds1(i)+dp2(i)*ds2(i)+dp3(i)*ds3(i))*coef(i)
232 ENDDO
233C
234 DO i=jft,jlt
235 IF (lamda(i) == zero) cycle
236 lamda(i)=lamda(i)*coef(i)/
237 . (dp1(i)*(a11(i)*dp1(i)+a12(i)*dp2(i))+
238 . dp2(i)*(a12(i)*dp1(i)+a22(i)*dp2(i))+
239 . two*dp3(i)*g12(i)*dp3(i)+
240 . (so1(i)*dp1(i)+so2(i)*dp2(i)+two*so3(i)*dp3(i))
241 . *cn(i)*cb(i)*wvec(i) )
242 ENDDO
243C
244 DO i=jft,jlt
245 dp1(i)=lamda(i)*dp1(i)
246 dp2(i)=lamda(i)*dp2(i)
247 dp3(i)=lamda(i)*dp3(i)
248 ENDDO
249C
250 DO i=jft,jlt
251 t1(i)=t1(i)-a11(i)*dp1(i)-a12(i)*dp2(i)
252 t2(i)=t2(i)-a12(i)*dp1(i)-a22(i)*dp2(i)
253 t3(i)=t3(i)-g12(i)*dp3(i)*two
254 ENDDO
255C
256 DO i=jft,jlt
257 wpla(i)=wpla(i)+half*
258 . (dp1(i)*(t1(i)+so1(i))+
259 . dp2(i)*(t2(i)+so2(i))+
260 . two*dp3(i)*(t3(i)+so3(i))) / wplaref(i)
261 wpla(i)= max(wpla(i),zero)
262 wwpla(i)= wpla(i)/wwpla(i)
263 ENDDO
264C
265 DO i=jft,jlt
266 sig(i,1)=t1(i)
267 sig(i,2)=t2(i)
268 sig(i,3)=t3(i)
269 ENDDO
270C-------------------
271C PLASTICITY END
272C-------------------
273C------for QEPH
274 DO i=jft,jlt
275 sigy(i)=yld(i)*sigy(i)
276 IF (coef(i) == one) THEN
277 ht=cn(i)*cb(i)*exp((cn(i)-one)*log(max(wpla(i),em20)))
278 IF(yld(i)>=fmax(i)) ht=em10
279 etse(i)= ht/(ht+e11(i))
280 ELSE
281 etse(i) = one ! ETSE is used whatever the value of COEF
282 END IF
283 END DO
284C-------------------------------------------------------------------
285C RETOUR DANS LE REPERE COQUE
286C-----------------------------
287!! temporary replaced by (the same) ROTO_SIG() in order to do not affect
288!! the other multidimensional buffer ARRAYS which are still not modified
289! CALL UROTO_SIG(JFT,JLT,SIG,DIR,NEL)
290!! CALL UROTO(JFT,JLT,SIG,DIR)
291!
292 DO i=jft,jlt
293 signxx(i) = sig(i,1)
294 signyy(i) = sig(i,2)
295 signxy(i) = sig(i,3)
296 signyz(i) = sig(i,4)
297 signzx(i) = sig(i,5)
298 ENDDO
299!
300C
301 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21