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

Go to the source code of this file.

Functions/Subroutines

subroutine czlkect3 (jft, jlt, vol, hc, rx, ry, sx, sy, rx2, ry2, sx2, sy2, rhx, rhy, shx, shy, gs, nplat, iplat, k11, k12, k13, k14, k22, k23, k24, k33, k34, k44, m11, m12, m13, m14, m22, m23, m24, m33, m34, m44, mf11, mf12, mf13, mf14, mf22, mf23, mf24, mf33, mf34, mf44, fm12, fm13, fm14, fm23, fm24, fm34)

Function/Subroutine Documentation

◆ czlkect3()

subroutine czlkect3 ( integer jft,
integer jlt,
vol,
hc,
rx,
ry,
sx,
sy,
rx2,
ry2,
sx2,
sy2,
rhx,
rhy,
shx,
shy,
gs,
integer nplat,
integer, dimension(*) iplat,
k11,
k12,
k13,
k14,
k22,
k23,
k24,
k33,
k34,
k44,
m11,
m12,
m13,
m14,
m22,
m23,
m24,
m33,
m34,
m44,
mf11,
mf12,
mf13,
mf14,
mf22,
mf23,
mf24,
mf33,
mf34,
mf44,
fm12,
fm13,
fm14,
fm23,
fm24,
fm34 )

Definition at line 28 of file czlkect3.F.

36C--------------------------------------------------------------------------------------------------
37C-----------------------------------------------
38C I M P L I C I T T Y P E S
39C-----------------------------------------------
40#include "implicit_f.inc"
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C D U M M Y A R G U M E N T S
44C-----------------------------------------------
45C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
46 INTEGER JFT,JLT,NPLAT,IPLAT(*) ,IKGEO
47 my_real
48 . vol(*),hc(mvsiz,2),rx(*) ,ry(*) ,sx(*) ,sy(*) ,
49 . rx2(*) ,ry2(*) ,sx2(*) ,sy2(*) ,
50 . rhx(mvsiz,4) ,rhy(mvsiz,4) ,shx(mvsiz,4) ,shy(mvsiz,4) ,
51 . k11(3,3,*),k12(3,3,*),k13(3,3,*),k14(3,3,*),
52 . k22(3,3,*),k23(3,3,*),k24(3,3,*),k33(3,3,*),
53 . m11(3,3,*),m12(3,3,*),m13(3,3,*),m14(3,3,*),
54 . m22(3,3,*),m23(3,3,*),m24(3,3,*),m33(3,3,*),
55 . mf11(3,3,*),mf12(3,3,*),mf13(3,3,*),mf14(3,3,*),
56 . mf22(3,3,*),mf23(3,3,*),mf24(3,3,*),mf33(3,3,*),
57 . fm12(3,3,*),fm13(3,3,*),fm14(3,3,*),
58 . fm23(3,3,*),fm24(3,3,*),fm34(3,3,*),
59 . k34(3,3,*),k44(3,3,*),m34(3,3,*),m44(3,3,*),
60 . mf34(3,3,*),mf44(3,3,*),gs(*)
61C---------------|[KIJ][MFIJ]|----
62C-----KE(6x6)= | |
63C---------------|[FMIJ]{MIJ]|----
64C-----------------------------------------------
65C L O C A L V A R I A B L E S
66C-----------------------------------------------
67 INTEGER EP,I,J,NF,M
68 my_real
69 . cs1(mvsiz),cs2(mvsiz),cs3(mvsiz),ds1(mvsiz),qs1(mvsiz),
70 . c1,c2,ds2(mvsiz),qs2(mvsiz),m1c1(2,2,mvsiz),
71 . m1c2(2,2,mvsiz),m1c3(2,2,mvsiz),m2c1(2,2,mvsiz),
72 . m2c2(2,2,mvsiz),m2c3(2,2,mvsiz),
73 . m1c11(2,2,mvsiz),m1c12(2,2,mvsiz),m1c13(2,2,mvsiz),
74 . m1c14(2,2,mvsiz),m1c22(2,2,mvsiz),m1c23(2,2,mvsiz),
75 . m1c24(2,2,mvsiz),m1c33(2,2,mvsiz),m1c34(2,2,mvsiz),
76 . m1c44(2,2,mvsiz),
77 . m2c11(2,2,mvsiz),m2c12(2,2,mvsiz),m2c13(2,2,mvsiz),
78 . m2c14(2,2,mvsiz),m2c22(2,2,mvsiz),m2c23(2,2,mvsiz),
79 . m2c24(2,2,mvsiz),m2c33(2,2,mvsiz),m2c34(2,2,mvsiz),
80 . m2c44(2,2,mvsiz),
81 . m3c11(2,2,mvsiz),m3c12(2,2,mvsiz),m3c13(2,2,mvsiz),
82 . m3c14(2,2,mvsiz),m3c22(2,2,mvsiz),m3c23(2,2,mvsiz),
83 . m3c24(2,2,mvsiz),m3c33(2,2,mvsiz),m3c34(2,2,mvsiz),
84 . m3c44(2,2,mvsiz),dcx(mvsiz),dcy(mvsiz),c11,
85 . dh(mvsiz),hs1(mvsiz),hs2(mvsiz)
86C-----------Attention Matrice sym Kii ne calcul que la moitie---------72
87 nf=nplat+1
88#include "vectorize.inc"
89C--------Constante parts---------------
90 DO m=jft,jlt
91 ep=iplat(m)
92 c2=vol(ep)
93 dcx(m)=hc(ep,1)*c2
94 dcy(m)=hc(ep,2)*c2
95 ENDDO
96C----------shear----R : -1 1 1 -1; S: -1 -1 1 1--
97 DO ep=jft,jlt
98 cs1(ep) = dcx(ep)*sy2(ep)+dcy(ep)*sx2(ep)
99 cs2(ep) = dcx(ep)*ry2(ep)+dcy(ep)*rx2(ep)
100 cs3(ep) =-dcx(ep)*sy(ep)*ry(ep)-dcy(ep)*sx(ep)*rx(ep)
101 ENDDO
102C--------add non-constant part for the case of orthopic---------------
103 DO m=jft,jlt
104 ep=iplat(m)
105 c2=vol(ep)
106 dh(m)=gs(ep)*c2
107 ENDDO
108C
109 DO ep=jft,jlt
110 hs1(ep) = third*dh(ep)*(sy2(ep)+sx2(ep))
111 hs2(ep) = third*dh(ep)*(ry2(ep)+rx2(ep))
112 ENDDO
113C------R : -1 1 1 -1; S: -1 -1 1 1 ------------------
114 DO ep=jft,jlt
115C------------------r1r1=1,s1s1=1, r1s1=1 ,r1s1=1------------------
116 k11(3,3,ep) = cs1(ep)+cs2(ep)+cs3(ep)+cs3(ep)
117C------------------r2r2=1,s2s2=1, r2s2=-1 ,r2s2=-1------------------
118 k22(3,3,ep) = cs1(ep)+cs2(ep)-cs3(ep)-cs3(ep)
119 k33(3,3,ep) = k11(3,3,ep)
120 k44(3,3,ep) = k22(3,3,ep)
121C------------------r1r2=-1,s1s2=1, r1s2=1 ,r2s1=-1------------------
122 k12(3,3,ep) =-cs1(ep)+cs2(ep)+cs3(ep)-cs3(ep)
123C------------------r1r3=-1,s1s3=-1, r1s3=-1 ,r3s1=-1------------------
124 k13(3,3,ep) =-cs1(ep)-cs2(ep)-cs3(ep)-cs3(ep)
125C------------------r1r4=1,s1s4=-1, r1s4=-1 ,r4s1=1------------------
126 k14(3,3,ep) = - k12(3,3,ep)
127C------------------r2r3=1,s2s3=-1, r2s3=1 ,r3s2=-1------------------
128 k23(3,3,ep) = cs1(ep)-cs2(ep)+cs3(ep)-cs3(ep)
129C------------------r2r4=-1,s2s4=-1, r2s4=1 ,r4s2=1------------------
130 k24(3,3,ep) =-k22(3,3,ep)
131C------------------r3r4=-1,s3s4=1, r3s4=1 ,r4s3=-1------------------
132 k34(3,3,ep) =k12(3,3,ep)
133 ENDDO
134C--------non constant part---hIhJ-
135 DO ep=jft,jlt
136 c11 =hs1(ep)+hs2(ep)
137 k11(3,3,ep) = k11(3,3,ep)+c11
138 k22(3,3,ep) = k22(3,3,ep)+c11
139 k33(3,3,ep) = k33(3,3,ep)+c11
140 k44(3,3,ep) = k44(3,3,ep)+c11
141 k12(3,3,ep) = k12(3,3,ep)-c11
142 k13(3,3,ep) = k13(3,3,ep)+c11
143 k14(3,3,ep) = k14(3,3,ep)-c11
144 k23(3,3,ep) = k23(3,3,ep)-c11
145 k24(3,3,ep) = k24(3,3,ep)+c11
146 k34(3,3,ep) = k34(3,3,ep)-c11
147 ENDDO
148C-------bending terms----------------
149C------KC1 ------
150 DO ep=jft,jlt
151C------M1C1: 11,12,22 ------
152 m1c1(1,1,ep) = rhy(ep,1)*rhy(ep,1)
153 m1c1(2,2,ep) = rhx(ep,1)*rhx(ep,1)
154 m1c1(1,2,ep) = -rhy(ep,1)*rhx(ep,1)
155 m1c1(2,1,ep) = m1c1(1,2,ep)
156C------M1C2: 13,14,23,24 ------
157 m1c2(1,1,ep) = rhy(ep,1)*rhy(ep,3)
158 m1c2(2,2,ep) = rhx(ep,1)*rhx(ep,3)
159 m1c2(1,2,ep) = -rhy(ep,1)*rhx(ep,3)
160 m1c2(2,1,ep) = -rhy(ep,3)*rhx(ep,1)
161C------M1C3: 33,34,44 ------
162 m1c3(1,1,ep) = rhy(ep,3)*rhy(ep,3)
163 m1c3(2,2,ep) = rhx(ep,3)*rhx(ep,3)
164 m1c3(1,2,ep) = -rhy(ep,3)*rhx(ep,3)
165 m1c3(2,1,ep) = m1c3(1,2,ep)
166 ds1(ep) = cs1(ep)-hs1(ep)
167 qs1(ep) = cs1(ep)+hs1(ep)
168 ENDDO
169C---------non constant part is added directly : KcH1=SISJ/3 KC1;
170 DO i=1,2
171 DO j=i,2
172 DO ep=jft,jlt
173C------M1C1: 11,12,22 ---SISJ=1---
174 m1c11(i,j,ep) = m1c1(i,j,ep)*qs1(ep)
175 m1c12(i,j,ep) = m1c11(i,j,ep)
176 m1c22(i,j,ep) = m1c11(i,j,ep)
177C------M1C3: 33,34,44 ----SISJ=1--
178 m1c33(i,j,ep) = m1c3(i,j,ep)*qs1(ep)
179 m1c34(i,j,ep) = m1c33(i,j,ep)
180 m1c44(i,j,ep) = m1c33(i,j,ep)
181 ENDDO
182 ENDDO
183 ENDDO
184 DO ep=jft,jlt
185 m1c12(2,1,ep)=m1c12(1,2,ep)
186 m1c34(2,1,ep)=m1c34(1,2,ep)
187 ENDDO
188 DO i=1,2
189 DO j=1,2
190 DO ep=jft,jlt
191C------M1C2: 13,14,23,24 --SISJ=-1----
192 m1c13(i,j,ep) = m1c2(i,j,ep)*ds1(ep)
193 m1c14(i,j,ep) = m1c13(i,j,ep)
194 m1c23(i,j,ep) = m1c13(i,j,ep)
195 m1c24(i,j,ep) = m1c13(i,j,ep)
196 ENDDO
197 ENDDO
198 ENDDO
199C---------KC2;KcH2=RIRJ/3 KC2
200 DO ep=jft,jlt
201C------M2C1: 11,14,44 ---3=2,4=1---
202 m2c1(1,1,ep) = shy(ep,1)*shy(ep,1)
203 m2c1(2,2,ep) = shx(ep,1)*shx(ep,1)
204 m2c1(1,2,ep) = -shy(ep,1)*shx(ep,1)
205 m2c1(2,1,ep) = m2c1(1,2,ep)
206C------M2C2: 12,13,24,34 ------
207 m2c2(1,1,ep) = shy(ep,1)*shy(ep,2)
208 m2c2(2,2,ep) = shx(ep,1)*shx(ep,2)
209C------exception (1,2)->24,34=(2,1)-(2,1)->24,34=(1,2)-
210 m2c2(1,2,ep) = -shy(ep,1)*shx(ep,2)
211 m2c2(2,1,ep) = -shy(ep,2)*shx(ep,1)
212C------M2C3: 22,23,33 ------
213 m2c3(1,1,ep) = shy(ep,2)*shy(ep,2)
214 m2c3(2,2,ep) = shx(ep,2)*shx(ep,2)
215 m2c3(1,2,ep) = -shy(ep,2)*shx(ep,2)
216 m2c3(2,1,ep) = m2c3(1,2,ep)
217 ds2(ep) = cs2(ep)-hs2(ep)
218 qs2(ep) = cs2(ep)+hs2(ep)
219 ENDDO
220 DO i=1,2
221 DO j=i,2
222 DO ep=jft,jlt
223C------M2C1: 11,14,44 ---RIRJ=1---
224 m2c11(i,j,ep) = m2c1(i,j,ep)*qs2(ep)
225 m2c14(i,j,ep) = m2c11(i,j,ep)
226 m2c44(i,j,ep) = m2c11(i,j,ep)
227C------M2C3: 22,23,33 ---RIRJ=1---
228 m2c22(i,j,ep) = m2c3(i,j,ep)*qs2(ep)
229 m2c23(i,j,ep) = m2c22(i,j,ep)
230 m2c33(i,j,ep) = m2c22(i,j,ep)
231 ENDDO
232 ENDDO
233 ENDDO
234 DO ep=jft,jlt
235 m2c14(2,1,ep)=m2c14(1,2,ep)
236 m2c23(2,1,ep)=m2c23(1,2,ep)
237 ENDDO
238 DO i=1,2
239 DO j=1,2
240 DO ep=jft,jlt
241C------M2C2: 12,13,24,34 -exception 24,34--(1,2)<->(2,1)--RIRJ=-1-
242 m2c12(i,j,ep) = m2c2(i,j,ep)*ds2(ep)
243 m2c13(i,j,ep) = m2c12(i,j,ep)
244 ENDDO
245 ENDDO
246 ENDDO
247 DO i=1,2
248 DO j=1,2
249 DO ep=jft,jlt
250C------M2C2: 12,13,24,34 -exception 24,34--(1,2)<->(2,1)---
251 m2c24(i,j,ep) = m2c12(j,i,ep)
252 m2c34(i,j,ep) = m2c12(j,i,ep)
253 ENDDO
254 ENDDO
255 ENDDO
256C------M3C ->M3C+M4C -cette partie peut etre optimise(decomp en const + antisym-----
257 DO ep=jft,jlt
258C-----------Attention Matrice sym Kii ne calcul que la moitie---------72
259 m3c11(1,1,ep) =(rhy(ep,1)*shy(ep,1)+rhy(ep,1)*shy(ep,1))*cs3(ep)
260 m3c12(1,1,ep) =(rhy(ep,1)*shy(ep,2)+rhy(ep,2)*shy(ep,1))*cs3(ep)
261 m3c13(1,1,ep) =(rhy(ep,1)*shy(ep,3)+rhy(ep,3)*shy(ep,1))*cs3(ep)
262 m3c14(1,1,ep) =(rhy(ep,1)*shy(ep,4)+rhy(ep,4)*shy(ep,1))*cs3(ep)
263 m3c22(1,1,ep) =(rhy(ep,2)*shy(ep,2)+rhy(ep,2)*shy(ep,2))*cs3(ep)
264 m3c23(1,1,ep) =(rhy(ep,2)*shy(ep,3)+rhy(ep,3)*shy(ep,2))*cs3(ep)
265 m3c24(1,1,ep) =(rhy(ep,2)*shy(ep,4)+rhy(ep,4)*shy(ep,2))*cs3(ep)
266 m3c33(1,1,ep) =(rhy(ep,3)*shy(ep,3)+rhy(ep,3)*shy(ep,3))*cs3(ep)
267 m3c34(1,1,ep) =(rhy(ep,3)*shy(ep,4)+rhy(ep,4)*shy(ep,3))*cs3(ep)
268 m3c44(1,1,ep) =(rhy(ep,4)*shy(ep,4)+rhy(ep,4)*shy(ep,4))*cs3(ep)
269 ENDDO
270 DO ep=jft,jlt
271 m3c11(2,2,ep) =(rhx(ep,1)*shx(ep,1)+rhx(ep,1)*shx(ep,1))*cs3(ep)
272 m3c12(2,2,ep) =(rhx(ep,1)*shx(ep,2)+rhx(ep,2)*shx(ep,1))*cs3(ep)
273 m3c13(2,2,ep) =(rhx(ep,1)*shx(ep,3)+rhx(ep,3)*shx(ep,1))*cs3(ep)
274 m3c14(2,2,ep) =(rhx(ep,1)*shx(ep,4)+rhx(ep,4)*shx(ep,1))*cs3(ep)
275 m3c22(2,2,ep) =(rhx(ep,2)*shx(ep,2)+rhx(ep,2)*shx(ep,2))*cs3(ep)
276 m3c23(2,2,ep) =(rhx(ep,2)*shx(ep,3)+rhx(ep,3)*shx(ep,2))*cs3(ep)
277 m3c24(2,2,ep) =(rhx(ep,2)*shx(ep,4)+rhx(ep,4)*shx(ep,2))*cs3(ep)
278 m3c33(2,2,ep) =(rhx(ep,3)*shx(ep,3)+rhx(ep,3)*shx(ep,3))*cs3(ep)
279 m3c34(2,2,ep) =(rhx(ep,3)*shx(ep,4)+rhx(ep,4)*shx(ep,3))*cs3(ep)
280 m3c44(2,2,ep) =(rhx(ep,4)*shx(ep,4)+rhx(ep,4)*shx(ep,4))*cs3(ep)
281 ENDDO
282 DO ep=jft,jlt
283 m3c11(1,2,ep)=(-rhy(ep,1)*shx(ep,1)-rhx(ep,1)*shy(ep,1))*cs3(ep)
284 m3c12(1,2,ep)=(-rhy(ep,1)*shx(ep,2)-rhx(ep,2)*shy(ep,1))*cs3(ep)
285 m3c13(1,2,ep)=(-rhy(ep,1)*shx(ep,3)-rhx(ep,3)*shy(ep,1))*cs3(ep)
286 m3c14(1,2,ep)=(-rhy(ep,1)*shx(ep,4)-rhx(ep,4)*shy(ep,1))*cs3(ep)
287 m3c22(1,2,ep)=(-rhy(ep,2)*shx(ep,2)-rhx(ep,2)*shy(ep,2))*cs3(ep)
288 m3c23(1,2,ep)=(-rhy(ep,2)*shx(ep,3)-rhx(ep,3)*shy(ep,2))*cs3(ep)
289 m3c24(1,2,ep)=(-rhy(ep,2)*shx(ep,4)-rhx(ep,4)*shy(ep,2))*cs3(ep)
290 m3c33(1,2,ep)=(-rhy(ep,3)*shx(ep,3)-rhx(ep,3)*shy(ep,3))*cs3(ep)
291 m3c34(1,2,ep)=(-rhy(ep,3)*shx(ep,4)-rhx(ep,4)*shy(ep,3))*cs3(ep)
292 m3c44(1,2,ep)=(-rhy(ep,4)*shx(ep,4)-rhx(ep,4)*shy(ep,4))*cs3(ep)
293 ENDDO
294 DO ep=jft,jlt
295 m3c11(2,1,ep) = m3c11(1,2,ep)
296 m3c12(2,1,ep)=(-rhx(ep,1)*shy(ep,2)-rhy(ep,2)*shx(ep,1))*cs3(ep)
297 m3c13(2,1,ep)=(-rhx(ep,1)*shy(ep,3)-rhy(ep,3)*shx(ep,1))*cs3(ep)
298 m3c14(2,1,ep)=(-rhx(ep,1)*shy(ep,4)-rhy(ep,4)*shx(ep,1))*cs3(ep)
299 m3c22(2,1,ep) = m3c22(1,2,ep)
300 m3c23(2,1,ep)=(-rhx(ep,2)*shy(ep,3)-rhy(ep,3)*shx(ep,2))*cs3(ep)
301 m3c24(2,1,ep)=(-rhx(ep,2)*shy(ep,4)-rhy(ep,4)*shx(ep,2))*cs3(ep)
302 m3c33(2,1,ep) = m3c33(1,2,ep)
303 m3c34(2,1,ep)=(-rhx(ep,3)*shy(ep,4)-rhy(ep,4)*shx(ep,3))*cs3(ep)
304 m3c44(2,1,ep) = m3c44(1,2,ep)
305 ENDDO
306C
307 DO i=1,2
308 DO j=i,2
309 DO ep=jft,jlt
310 m11(i,j,ep)=m11(i,j,ep)+
311 1 m1c11(i,j,ep)+m2c11(i,j,ep)+m3c11(i,j,ep)
312 m22(i,j,ep)=m22(i,j,ep)+
313 1 m1c22(i,j,ep)+m2c22(i,j,ep)+m3c22(i,j,ep)
314 m33(i,j,ep)=m33(i,j,ep)+
315 1 m1c33(i,j,ep)+m2c33(i,j,ep)+m3c33(i,j,ep)
316 m44(i,j,ep)=m44(i,j,ep)+
317 1 m1c44(i,j,ep)+m2c44(i,j,ep)+m3c44(i,j,ep)
318 ENDDO
319 ENDDO
320 ENDDO
321C
322 DO i=1,2
323 DO j=1,2
324 DO ep=jft,jlt
325 m12(i,j,ep)=m12(i,j,ep)+
326 1 m1c12(i,j,ep)+m2c12(i,j,ep)+m3c12(i,j,ep)
327 m13(i,j,ep)=m13(i,j,ep)+
328 1 m1c13(i,j,ep)+m2c13(i,j,ep)+m3c13(i,j,ep)
329 m14(i,j,ep)=m14(i,j,ep)+
330 1 m1c14(i,j,ep)+m2c14(i,j,ep)+m3c14(i,j,ep)
331 m23(i,j,ep)=m23(i,j,ep)+
332 1 m1c23(i,j,ep)+m2c23(i,j,ep)+m3c23(i,j,ep)
333 m24(i,j,ep)=m24(i,j,ep)+
334 1 m1c24(i,j,ep)+m2c24(i,j,ep)+m3c24(i,j,ep)
335 m34(i,j,ep)=m34(i,j,ep)+
336 1 m1c34(i,j,ep)+m2c34(i,j,ep)+m3c34(i,j,ep)
337 ENDDO
338 ENDDO
339 ENDDO
340C------R : -1 1 1 -1; S: -1 -1 1 1; H:1 -1 1 -1----------------
341C------CS1 : -R CS2: -S CS3: -R,H ---QSI=SISJ*CS1--QS2=RIRJ*CS2-----------
342 DO ep=jft,jlt
343 mf11(3,1,ep)= qs1(ep)*rhy(ep,1)+qs2(ep)*shy(ep,1)
344 1 +cs3(ep)*(shy(ep,1)+rhy(ep,1))
345 mf12(3,1,ep)= qs1(ep)*rhy(ep,2)+ds2(ep)*shy(ep,2)
346 1 +cs3(ep)*(shy(ep,2)+rhy(ep,2))
347 mf13(3,1,ep)= ds1(ep)*rhy(ep,3)+ds2(ep)*shy(ep,3)
348 1 +cs3(ep)*(shy(ep,3)+rhy(ep,3))
349 mf14(3,1,ep)= ds1(ep)*rhy(ep,4)+qs2(ep)*shy(ep,4)
350 1 +cs3(ep)*(shy(ep,4)+rhy(ep,4))
351 mf22(3,1,ep)=-qs1(ep)*rhy(ep,2)+qs2(ep)*shy(ep,2)
352 1 -cs3(ep)*(shy(ep,2)-rhy(ep,2))
353 mf23(3,1,ep)=-ds1(ep)*rhy(ep,3)+qs2(ep)*shy(ep,3)
354 1 -cs3(ep)*(shy(ep,3)-rhy(ep,3))
355 mf24(3,1,ep)=-ds1(ep)*rhy(ep,4)+ds2(ep)*shy(ep,4)
356 1 -cs3(ep)*(shy(ep,4)-rhy(ep,4))
357 mf33(3,1,ep)=-qs1(ep)*rhy(ep,3)-qs2(ep)*shy(ep,3)
358 1 -cs3(ep)*(shy(ep,3)+rhy(ep,3))
359 mf34(3,1,ep)=-qs1(ep)*rhy(ep,4)-ds2(ep)*shy(ep,4)
360 1 -cs3(ep)*(shy(ep,4)+rhy(ep,4))
361 mf44(3,1,ep)= qs1(ep)*rhy(ep,4)-qs2(ep)*shy(ep,4)
362 1 +cs3(ep)*(shy(ep,4)-rhy(ep,4))
363 ENDDO
364C------CS1 : R CS2: S CS3: R,H ----------------
365 DO ep=jft,jlt
366 mf11(3,2,ep)=-qs1(ep)*rhx(ep,1)-qs2(ep)*shx(ep,1)
367 1 -cs3(ep)*(shx(ep,1)+rhx(ep,1))
368 mf12(3,2,ep)=-qs1(ep)*rhx(ep,2)-ds2(ep)*shx(ep,2)
369 1 -cs3(ep)*(shx(ep,2)+rhx(ep,2))
370 mf13(3,2,ep)=-ds1(ep)*rhx(ep,3)-ds2(ep)*shx(ep,3)
371 1 -cs3(ep)*(shx(ep,3)+rhx(ep,3))
372 mf14(3,2,ep)=-ds1(ep)*rhx(ep,4)-qs2(ep)*shx(ep,4)
373 1 -cs3(ep)*(shx(ep,4)+rhx(ep,4))
374 mf22(3,2,ep)= qs1(ep)*rhx(ep,2)-qs2(ep)*shx(ep,2)
375 1 +cs3(ep)*(shx(ep,2)-rhx(ep,2))
376 mf23(3,2,ep)= ds1(ep)*rhx(ep,3)-qs2(ep)*shx(ep,3)
377 1 +cs3(ep)*(shx(ep,3)-rhx(ep,3))
378 mf24(3,2,ep)= ds1(ep)*rhx(ep,4)-ds2(ep)*shx(ep,4)
379 1 +cs3(ep)*(shx(ep,4)-rhx(ep,4))
380 mf33(3,2,ep)= qs1(ep)*rhx(ep,3)+qs2(ep)*shx(ep,3)
381 1 +cs3(ep)*(shx(ep,3)+rhx(ep,3))
382 mf34(3,2,ep)= qs1(ep)*rhx(ep,4)+ds2(ep)*shx(ep,4)
383 1 +cs3(ep)*(shx(ep,4)+rhx(ep,4))
384 mf44(3,2,ep)=-qs1(ep)*rhx(ep,4)+qs2(ep)*shx(ep,4)
385 1 -cs3(ep)*(shx(ep,4)-rhx(ep,4))
386 ENDDO
387C------R : -1 1 1 -1; S: -1 -1 1 1; H:1 -1 1 -1----------------
388C------CS1 : -R CS2: -S CS3: -S,H ----------------
389 DO ep=jft,jlt
390 fm12(1,3,ep)=-qs1(ep)*rhy(ep,1)+ds2(ep)*shy(ep,1)
391 1 +cs3(ep)*(rhy(ep,1)-shy(ep,1))
392 fm13(1,3,ep)=-ds1(ep)*rhy(ep,1)-ds2(ep)*shy(ep,1)
393 1 -cs3(ep)*(rhy(ep,1)+shy(ep,1))
394 fm23(1,3,ep)=-ds1(ep)*rhy(ep,2)-qs2(ep)*shy(ep,2)
395 1 -cs3(ep)*(rhy(ep,2)+shy(ep,2))
396 fm14(1,3,ep)= ds1(ep)*rhy(ep,1)-qs2(ep)*shy(ep,1)
397 1 -cs3(ep)*(rhy(ep,1)-shy(ep,1))
398 fm24(1,3,ep)= ds1(ep)*rhy(ep,2)-ds2(ep)*shy(ep,2)
399 1 -cs3(ep)*(rhy(ep,2)-shy(ep,2))
400 fm34(1,3,ep)= qs1(ep)*rhy(ep,3)-ds2(ep)*shy(ep,3)
401 1 -cs3(ep)*(rhy(ep,3)-shy(ep,3))
402C------CS1 : R CS2: S CS3: S,H ----------------
403 fm12(2,3,ep)= qs1(ep)*rhx(ep,1)-ds2(ep)*shx(ep,1)
404 1 -cs3(ep)*(rhx(ep,1)-shx(ep,1))
405 fm13(2,3,ep)= ds1(ep)*rhx(ep,1)+ds2(ep)*shx(ep,1)
406 1 +cs3(ep)*(rhx(ep,1)+shx(ep,1))
407 fm23(2,3,ep)= ds1(ep)*rhx(ep,2)+qs2(ep)*shx(ep,2)
408 1 +cs3(ep)*(rhx(ep,2)+shx(ep,2))
409 fm14(2,3,ep)=-ds1(ep)*rhx(ep,1)+qs2(ep)*shx(ep,1)
410 1 +cs3(ep)*(rhx(ep,1)-shx(ep,1))
411 fm24(2,3,ep)=-ds1(ep)*rhx(ep,2)+ds2(ep)*shx(ep,2)
412 1 +cs3(ep)*(rhx(ep,2)-shx(ep,2))
413 fm34(2,3,ep)=-qs1(ep)*rhx(ep,3)+ds2(ep)*shx(ep,3)
414 1 +cs3(ep)*(rhx(ep,3)-shx(ep,3))
415 ENDDO
416C
417 RETURN
my_real
#define my_real
Definition cppsort.cpp:32