37
38
39
40#include "implicit_f.inc"
41
42
43
44#include "mvsiz_p.inc"
45
46
47
48#include "param_c.inc"
49
50
51
52 INTEGER FXBELM(*), IPARG(NPARG,*), IXC(NIXC,*), NELC
54 . fxbsig(*), x(3,*), pm(npropm), fxbmod(*),
55 . geo(npropg,*), r(3,*)
56
57
58
59 INTEGER IG,OFFSET,FIRST,LAST,NFT,I,NG,IEL,
60 . N1,N2,N3,N4,ISM,ITHK,NPT,NFS
61 INTEGER MAT(MVSIZ), PROP(MVSIZ)
62 INTEGER II,J
64 . d11, d12, d13, d21, d22, d23, d31, d32, d33, d41, d42, d43,
65 . dr11, dr12, dr13, dr21, dr22, dr23, dr31, dr32, dr33,
66 . dr41, dr42, dr43
67 my_real vl(3,4,mvsiz), vrl(3,4,mvsiz),
68 . px1g(mvsiz), px2g(mvsiz), py1g(mvsiz), py2g(mvsiz),
69 . px1(mvsiz) , px2(mvsiz) , py1(mvsiz) , py2(mvsiz),
70 . x2s(mvsiz), y2s(mvsiz), x3s(mvsiz),
71 . y3s(mvsiz), x4s(mvsiz), y4s(mvsiz),
72 . x1(mvsiz) , x2(mvsiz) , x3(mvsiz) , x4(mvsiz) ,
73 . y1(mvsiz) , y2(mvsiz) , y3(mvsiz) , y4(mvsiz) ,
74 . z1(mvsiz) , z2(mvsiz) , z3(mvsiz) , z4(mvsiz),
75 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
76 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
77 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
78 . exx(mvsiz),eyy(mvsiz),exy(mvsiz),eyz(mvsiz),ezx(mvsiz),
79 . kxx(mvsiz),kyy(mvsiz),kxy(mvsiz),
80 . gstrbid(8,mvsiz),
for(5,mvsiz), mom(3,mvsiz),
81 . eint(2,mvsiz) , thk(mvsiz),
area(mvsiz),
82 . nu(mvsiz), g(mvsiz), a1(mvsiz), a2(mvsiz), gs(mvsiz)
83
84 first=1
85 DO ig=1,nelc,mvsiz
86 offset=ig-1
87 last=
min(mvsiz,nelc-offset)
88 nft=offset*10
89 nfs=offset*10
90 DO i=1,last
91 ng=fxbelm(nft+10*(i-1)+1)
92 iel=iparg(3,ng)+fxbelm(nft+10*(i-1)+2)
93 mat(i)=ixc(1,iel)
94 prop(i)=ixc(6,iel)
95 thk(i)=geo(1,prop(i))
96 x1(i)=0.
97 y1(i)=0.
98 z1(i)=0.
99 x2(i)=x(1,ixc(3,iel))-x(1,ixc(2,iel))
100 y2(i)=x(2,ixc(3,iel))-x(2,ixc(2,iel))
101 z2(i)=x(3,ixc(3,iel))-x(3,ixc(2,iel))
102 x3(i)=x(1,ixc(4,iel))-x(1,ixc(2,iel))
103 y3(i)=x(2,ixc(4,iel))-x(2,ixc(2,iel))
104 z3(i)=x(3,ixc(4,iel))-x(3,ixc(2,iel))
105 x4(i)=x(1,ixc(5,iel))-x(1,ixc(2,iel))
106 y4(i)=x(2,ixc(5,iel))-x(2,ixc(2,iel))
107 z4(i)=x(3,ixc(5,iel))-x(3,ixc(2,iel))
108 n1=fxbelm(nft+10*(i-1)+3)
109 n2=fxbelm(nft+10*(i-1)+4)
110 n3=fxbelm(nft+10*(i-1)+5)
111 n4=fxbelm(nft+10*(i-1)+6)
112 d11=fxbmod(6*(n1-1)+1)
113 d12=fxbmod(6*(n1-1)+2)
114 d13=fxbmod(6*(n1-1)+3)
115 d21=fxbmod(6*(n2-1)+1)
116 d22=fxbmod(6*(n2-1)+2)
117 d23=fxbmod(6*(n2-1)+3)
118 d31=fxbmod(6*(n3-1)+1)
119 d32=fxbmod(6*(n3-1)+2)
120 d33=fxbmod(6*(n3-1)+3)
121 d41=fxbmod(6*(n4-1)+1)
122 d42=fxbmod(6*(n4-1)+2)
123 d43=fxbmod(6*(n4-1)+3)
124 vl(1,1,i)=r(1,1)*d11+r(1,2)*d12+r(1,3)*d13
125 vl(2,1,i)=r(2,1)*d11+r(2,2)*d12+r(2,3)*d13
126 vl(3,1,i)=r(3,1)*d11+r(3,2)*d12+r(3,3)*d13
127 vl(1,2,i)=r(1,1)*d21+r(1,2)*d22+r(1,3)*d23
128 vl(2,2,i)=r(2,1)*d21+r(2,2)*d22+r(2,3)*d23
129 vl(3,2,i)=r(3,1)*d21+r(3,2)*d22+r(3,3)*d23
130 vl(1,3,i)=r(1,1)*d31+r(1,2)*d32+r(1,3)*d33
131 vl(2,3,i)=r(2,1)*d31+r(2,2)*d32+r(2,3)*d33
132 vl(3,3,i)=r(3,1)*d31+r(3,2)*d32+r(3,3)*d33
133 vl(1,4,i)=r(1,1)*d41+r(1,2)*d42+r(1,3)*d43
134 vl(2,4,i)=r(2,1)*d41+r(2,2)*d42+r(2,3)*d43
135 vl(3,4,i)=r(3,1)*d41+r(3,2)*d42+r(3,3)*d43
136 dr11=fxbmod(6*(n1-1)+4)
137 dr12=fxbmod(6*(n1-1)+5)
138 dr13=fxbmod(6*(n1-1)+6)
139 dr21=fxbmod(6*(n2-1)+4)
140 dr22=fxbmod(6*(n2-1)+5)
141 dr23=fxbmod(6*(n2-1)+6)
142 dr31=fxbmod(6*(n3-1)+4)
143 dr32=fxbmod(6*(n3-1)+5)
144 dr33=fxbmod(6*(n3-1)+6)
145 dr41=fxbmod(6*(n4-1)+4)
146 dr42=fxbmod(6*(n4-1)+5)
147 dr43=fxbmod(6*(n4-1)+6)
148 vrl(1,1,i)=r(1,1)*dr11+r(1,2)*dr12+r(1,3)*dr13
149 vrl(2,1,i)=r(2,1)*dr11+r(2,2)*dr12+r(2,3)*dr13
150 vrl(3,1,i)=r(3,1)*dr11+r(3,2)*dr12+r(3,3)*dr13
151 vrl(1,2,i)=r(1,1)*dr21+r(1,2)*dr22+r(1,3)*dr23
152 vrl(2,2,i)=r(2,1)*dr21+r(2,2)*dr22+r(2,3)*dr23
153 vrl(3,2,i)=r(3,1)*dr21+r(3,2)*dr22+r(3,3)*dr23
154 vrl(1,3,i)=r(1,1)*dr31+r(1,2)*dr32+r(1,3)*dr33
155 vrl(2,3,i)=r(2,1)*dr31+r(2,2)*dr32+r(2,3)*dr33
156 vrl(3,3,i)=r(3,1)*dr31+r(3,2)*dr32+r(3,3)*dr33
157 vrl(1,4,i)=r(1,1)*dr41+r(1,2)*dr42+r(1,3)*dr43
158 vrl(2,4,i)=r(2,1)*dr41+r(2,2)*dr42+r(2,3)*dr43
159 vrl(3,4,i)=r(3,1)*dr41+r(3,2)*dr42+r(3,3)*dr43
160 gstrbid(1,i)=zero
161 gstrbid(2,i)=zero
162 gstrbid(3,i)=zero
168 mom(1,i)=zero
169 mom(2,i)=zero
170 mom(3,i)=zero
171 px1g(i)=zero
172 px2g(i)=zero
173 py1g(i)=zero
174 py2g(i)=zero
175 ism=1
176 ithk=0
177 ENDDO
178
180 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
181 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
182 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
183 npt=1
184 CALL ccoefi(last, pm , geo, nu ,
185 . g , a1 , a2 , gs , thk,
186 . mat , prop, npt,
area)
187 CALL cpxpyi(first,last, ism,
188 . px1g ,px2g ,py1g ,py2g ,
area ,
189 . px1 ,px2 ,py1 ,py2 ,
190 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
191 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
192 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
193 . x2s ,y2s ,x3s ,y3s ,x4s ,y4s )
194 CALL cdefli(last ,vl ,gstrbid,
195 . px1 ,px2 ,py1 ,py2 ,
196 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
197 . exx ,eyy ,exy ,eyz ,ezx ,
area )
199 . px1 ,px2 ,py1 ,py2 ,
200 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
201 . eyz ,ezx ,kxx ,kyy ,kxy ,
area )
202 ithk=0
204 . thk ,eint ,nu ,g ,a1 ,
205 . a2 ,gs ,kxx ,kyy ,kxy ,
206 . exx ,eyy ,exy ,eyz ,ezx ,
208
209 DO i=1,last
210 fxbsig(nfs+10*(i-1)+1)=
for(1,i)
211 fxbsig(nfs+10*(i-1)+2)=
for(2,i)
212 fxbsig(nfs+10*(i-1)+3)=
for(3,i)
213 fxbsig(nfs+10*(i-1)+4)=
for(4,i)
214 fxbsig(nfs+10*(i-1)+5)=
for(5,i)
215 fxbsig(nfs+10*(i-1)+6)=mom(1,i)
216 fxbsig(nfs+10*(i-1)+7)=mom(2,i)
217 fxbsig(nfs+10*(i-1)+8)=mom(3,i)
218 fxbsig(nfs+10*(i-1)+9)=eint(1,i)
219 fxbsig(nfs+10*(i-1)+10)=eint(2,i)
220 ENDDO
221 ENDDO
222
223 RETURN
subroutine cpxpyi(jft, jlt, ismstr, area, px1g, px2g, py1g, py2g, px1, px2, py1, py2, x1g, x2g, x3g, x4g, y1g, y2g, y3g, y4g, z1g, z2g, z3g, z4g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x2l, y2l, x3l, y3l, x4l, y4l)
subroutine ceveci(jft, jlt, area, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine cm1inif(jft, jlt, for, mom, ithk, thk, eint, nu, g, a1, a2, gs, kxx, kyy, kxy, exx, eyy, exy, eyz, exz, area)
subroutine cdefli(nel, vl, gstr, px1, px2, py1, py2, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, exx, eyy, exy, eyz, ezx, area)
subroutine ccurvi(nel, vrl, px1, px2, py1, py2, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, eyz, ezx, kxx, kyy, kxy, area)
subroutine ccoefi(nel, pm, geo, nu, g, a1, a2, gs, thk, mat, prop, npt, area)
for(i8=*sizetab-1;i8 >=0;i8--)