33
34
35
36#include "implicit_f.inc"
37
38
39
40#include "mvsiz_p.inc"
41
42
43
44
45
46
47 INTEGER, INTENT(IN) :: IINT
48 INTEGER NEL
50 . fhour(nel,3,4),jr0(*),js0(*),jt0(*) ,
51 . sigy(*) ,sig0(nel,6),svm1(*),svm2(*),nu,
52 . cc(mvsiz,3,3),
cg(mvsiz,3,3),g33(mvsiz,3,3)
53
54
55
56 INTEGER I, J,K,IKT
58 . s1,s2,s3,svm0,sr1,sr2,sr3,sr4,
59 . ss1,ss2,ss3,ss4,st1,st2,st3,st4,svmr,svms,svmt,
60 . svm,svmrst,coef,coef1, jr_1,js_1,jt_1,nu1,nu2,t1,t2,
61 . rs,st,rt,vt1(4),vt2(4),max1,min1,max2,min2,max0,min0,
62 . sr5,sr6,ss5,ss6, st5,st6
63
64
65 coef= threehundred24
66 coef1= onep333
67 ikt = iint
68 IF (ikt ==2) THEN
69 coef1= coef/(ten*ikt)
71 ELSEIF (ikt > 2) THEN
72 coef1= coef/(ten*ikt)
74 ENDIF
75 nu1 =one/(one - nu)
76 nu2 =nu*nu1
77 DO i=1,nel
78 svm1(i) = zero
79 svm2(i) = zero
80 IF (sigy(i)<zep9ep30) THEN
81 s1 =sig0(i,1)-sig0(i,2)
82 s2 =sig0(i,2)-sig0(i,3)
83 s3 =sig0(i,1)-sig0(i,3)
84 svm0 = (s1*s1+s2*s2+s3*s3)*half + three*(sig0(i,4)*sig0(i,4)
85 . +sig0(i,5)*sig0(i,5)+sig0(i,6)*sig0(i,6))
86 jr_1 = one/
max(em20,jr0(i))
87 js_1 = one/
max(em20,js0(i))
88 jt_1 = one/
max(em20,jt0(i))
89 j=2
90 k=1
91 t1 = nu2*(cc(i,j,2)-cc(i,k,2))
92 t2 = jr0(i)*jt_1*fhour(i,1,1)+jt0(i)*jr_1*fhour(i,3,3)
93 sr1 =(cc(i,j,1)-cc(i,k,1)-t1)*fhour(i,1,3)+
94 . (cc(i,j,3)-cc(i,k,3)-t1)*fhour(i,3,1)+
95 . (
cg(i,j,2)-
cg(i,k,2))*t2
96 j=3
97 k=2
98 t1 = nu2*(cc(i,j,2)-cc(i,k,2))
99 sr2 =(cc(i,j,1)-cc(i,k,1)-t1)*fhour(i,1,3)+
100 . (cc(i,j,3)-cc(i,k,3)-t1)*fhour(i,3,1)+
101 . (
cg(i,j,2)-
cg(i,k,2))*t2
102 j=3
103 k=1
104 t1 = nu2*(cc(i,j,2)-cc(i,k,2))
105 sr3 =(cc(i,j,1)-cc(i,k,1)-t1)*fhour(i,1,3)+
106 . (cc(i,j,3)-cc(i,k,3)-t1)*fhour(i,3,1)+
107 . (
cg(i,j,2)-
cg(i,k,2))*t2
108 j=1
110 sr4 =(
cg(i,1,j)-t1)*fhour(i,1,3)+(
cg(i,3,j)-t1)*fhour(i,3,1)+
111 . g33(i,j,2)*t2
112 j=2
114 sr5 =(
cg(i,1,j)-t1)*fhour(i,1,3)+(
cg(i,3,j)-t1)*fhour(i,3,1)+
115 . g33(i,j,2)*t2
116 j=3
118 sr6 =(
cg(i,1,j)-t1)*fhour(i,1,3)+(
cg(i,3,j)-t1)*fhour(i,3,1)+
119 . g33(i,j,2)*t2
120 svmr =half*(sr1*sr1+sr2*sr2+sr3*sr3)+three*(sr4*sr4+sr5*sr5+sr6*sr6)
121 j=2
122 k=1
123 t1 = nu2*(cc(i,j,3)-cc(i,k,3))
124 t2 = jr0(i)*js_1*fhour(i,1,1)+js0(i)*jr_1*fhour(i,2,2)
125 ss1 =(cc(i,j,1)-cc(i,k,1)-t1)*fhour(i,1,2)+
126 . (cc(i,j,2)-cc(i,k,2)-t1)*fhour(i,2,1)+
127 . (
cg(i,j,1)-
cg(i,k,1))*t2
128 j=3
129 k=2
130 t1 = nu2*(cc(i,j,3)-cc(i,k,3))
131 ss2 =(cc(i,j,1)-cc(i,k,1)-t1)*fhour(i,1,2)+
132 . (cc(i,j,2)-cc(i,k,2)-t1)*fhour(i,2,1)+
133 . (
cg(i,j,1)-
cg(i,k,1))*t2
134 j=3
135 k=1
136 t1 = nu2*(cc(i,j,3)-cc(i,k,3))
137 ss3 =(cc(i,j,1)-cc(i,k,1)-t1)*fhour(i,1,2)+
138 . (cc(i,j,2)-cc(i,k,2)-t1)*fhour(i,2,1)+
139 . (
cg(i,j,1)-
cg(i,k,1))*t2
140 j=1
142 ss4 =(
cg(i,1,j)-t1)*fhour(i,1,2)+(
cg(i,2,j)-t1)*fhour(i,2,1)+
143 . g33(i,j,1)*t2
144 j=2
146 ss5 =(
cg(i,1,j)-t1)*fhour(i,1,2)+(
cg(i,2,j)-t1)*fhour(i,2,1)+
147 . g33(i,j,1)*t2
148 j=3
150 ss6 =(
cg(i,1,j)-t1)*fhour(i,1,2)+(
cg(i,2,j)-t1)*fhour(i,2,1)+
151 . g33(i,j,1)*t2
152 svms =half*(ss1*ss1+ss2*ss2+ss3*ss3)+three*(ss4*ss4+ss5*ss5+ss6*ss6)
153 j=2
154 k=1
155 t1 = nu2*(cc(i,j,1)-cc(i,k,1))
156 t2 = js0(i)*jt_1*fhour(i,2,2)+jt0(i)*js_1*fhour(i,3,3)
157 st1 =(cc(i,j,2)-cc(i,k,2)-t1)*fhour(i,2,3)+
158 . (cc(i,j,3)-cc(i,k,3)-t1)*fhour(i,3,2)+
159 . (
cg(i,j,3)-
cg(i,k,3))*t2
160 j=3
161 k=2
162 t1 = nu2*(cc(i,j,1)-cc(i,k,1))
163 st2 =(cc(i,j,2)-cc(i,k,2)-t1)*fhour(i,2,3)+
164 . (cc(i,j,3)-cc(i,k,3)-t1)*fhour(i,3,2)+
165 . (
cg(i,j,3)-
cg(i,k,3))*t2
166 j=3
167 k=1
168 t1 = nu2*(cc(i,j,1)-cc(i,k,1))
169 st3 =(cc(i,j,2)-cc(i,k,2)-t1)*fhour(i,2,3)+
170 . (cc(i,j,3)-cc(i,k,3)-t1)*fhour(i,3,2)+
171 . (
cg(i,j,3)-
cg(i,k,3))*t2
172 j=1
174 st4 =(
cg(i,2,j)-t1)*fhour(i,2,3)+(
cg(i,3,j)-t1)*fhour(i,3,2)+
175 . g33(i,j,3)*t2
176 j=2
178 st5 =(
cg(i,2,j)-t1)*fhour(i,2,3)+(
cg(i,3,j)-t1)*fhour(i,3,2)+
179 . g33(i,j,3)*t2
180 j=3
182 st6 =(
cg(i,2,j)-t1)*fhour(i,2,3)+(
cg(i,3,j)-t1)*fhour(i,3,2)+
183 . g33(i,j,3)*t2
184 svmt =half*(st1*st1+st2*st2+st3*st3)+three*(st4*st4+st5*st5+st6*st6)
185
186 rs =half*sr1*ss1
187 rt =half*sr1*st1
188 st =half*ss1*st1
189 vt2(1) = rs+rt+st
190 vt2(2) = rs-rt-st
191 vt2(3) = -rs+rt-st
192 vt2(4) = -rs-rt+st
193 max0 =
max(vt2(1),vt2(2),vt2(3),vt2(4))
194 min0 =
min(vt2(1),vt2(2),vt2(3),vt2(4))
195 rs =half*sr2*ss2
196 rt =half*sr2*st2
197 st =half*ss2*st2
198 vt2(1) = rs+rt+st
199 vt2(2) = rs-rt-st
200 vt2(3) = -rs+rt-st
201 vt2(4) = -rs-rt+st
202 max0 =max0+
max(vt2(1),vt2(2),vt2(3),vt2(4))
203 min0 =min0+
min(vt2(1),vt2(2),vt2(3),vt2(4))
204 rs =half*sr3*ss3
205 rt =half*sr3*st3
206 st =half*ss3*st3
207 vt2(1) = rs+rt+st
208 vt2(2) = rs-rt-st
209 vt2(3) = -rs+rt-st
210 vt2(4) = -rs-rt+st
211 max0 =max0+
max(vt2(1),vt2(2),vt2(3),vt2(4))
212 min0 =min0+
min(vt2(1),vt2(2),vt2(3),vt2(4))
213 svmrst = svm0+coef*(svmr+svms+svmt)
214 svm1(i) = sqrt(abs(svmrst+coef*max0))
215 svm2(i) = sqrt(
max(svmrst+coef*min0,zero))
216 svm2(i) =
min(svm2(i),svm0)
217 ENDIF
218 ENDDO
219
220 RETURN
subroutine cg(dim, mat, rhs, sol, max_iter, tol)