45
46
47
48 USE mat_elem_mod
49 use element_mod , only : nixtg
50
51
52
53#include "implicit_f.inc"
54
55
56
57#include "mvsiz_p.inc"
58
59
60
61#include "param_c.inc"
62#include "scr03_c.inc"
63
64
65
66 INTEGER JFT,JLT,ISMSTR,MTN,ITHK,NEL,NLAY
67INTEGER IXTG(NIXTG,*),(NPROPMI,*),NPF(*)
69 . pm(npropm,*),geo(npropg,*),x(3,*),xreftg(3,3,*),
70 .
for(nel,5) ,thk(*) ,eint(nel,2),gstr(nel,8),
71 . px1g(*) ,py1g(*) ,py2g(*),x2s(*) ,x3s(*) ,y3s(*),
72 . uvar(*),dir_a(nel,*),dir_b(nel,*),sigi(nel,3),tf(*),
73 . px1(mvsiz), py1(mvsiz), py2(mvsiz)
74 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
75 TYPE (MATPARAM_STRUCT_) ,INTENT(IN) :: MAT_PARAM
76
77
78
79 INTEGER I, NT, I1, I2, I3,IDRAPE,IGTYP
81 my_real ecos(mvsiz),esin(mvsiz),
82 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
83 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
84 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
85 . exx(mvsiz),eyy(mvsiz),exy(mvsiz),eyz(mvsiz),ezx(mvsiz),
86 . x1(mvsiz) , x2(mvsiz) , x3(mvsiz) ,x4(mvsiz) ,
87 . y1(mvsiz) , y2(mvsiz) , y3(mvsiz) ,y4(mvsiz) ,
88 . z1(mvsiz) , z2(mvsiz) , z3(mvsiz) ,z4(mvsiz) ,
89 . x31(mvsiz) , y31(mvsiz) , z31(mvsiz),
90 . vl(3,3,mvsiz), xl(3,3,mvsiz),
area(mvsiz),
91 . x2h(mvsiz), x3h(mvsiz), y3h(mvsiz),
92 . x2l(mvsiz), x3l(mvsiz), y3l(mvsiz)
93 my_real,
DIMENSION(:) ,
POINTER :: dir1, dir2
94
95 idrape = elbuf_str%IDRAPE
96 igtyp = elbuf_str%IGTYP
97 DO i=jft,jlt
98 i1 = ixtg(2,i)
99 i2 = ixtg(3,i)
100 i3 = ixtg(4,i)
101 x1(i) = zero
102 y1(i) = zero
103 z1(i) = zero
104 x2(i) = x(1,i2) - x(1,i1)
105 y2(i) = x(2,i2) - x(2,i1)
106 z2(i) = x(3,i2) - x(3,i1)
107 x3(i) = x(1,i3) - x(1,i1)
108 y3(i) = x(2,i3) - x(2,i1)
109 z3(i) = x(3,i3) - x(3,i1)
110 ENDDO
111
113 . x1 ,x2 ,x3
114 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
115 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
116 . x31, y31, z31 ,x2l ,x3l ,y3l )
117
118 DO i=jft,jlt
119 xl(1,2,i) = e1x(i)*x2(i) + e1y(i)*y2(i) + e1z(i)*z2(i)
120 xl(2,2,i) = e2x(i)*x2(i) + e2y(i)*y2(i) + e2z(i)*z2(i)
121 xl(1,3,i) = e1x(i)*x3(i) + e1y(i)*y3(i) + e1z(i)*z3(i)
122 xl(2,3,i) = e2x(i)*x3(i) + e2y(i)*y3(i) + e2z(i)*z3(i)
123 ENDDO
124 DO i=jft,jlt
125 x2(i) = xreftg(2,1,i) - xreftg(1,1,i)
126 y2(i) = xreftg(2,2,i) - xreftg(1,2,i)
127 z2(i) = xreftg(2,3,i) - xreftg(1,3,i)
128 x3(i) = xreftg(3,1,i) - xreftg(1,1,i)
129 y3(i) = xreftg(3,2,i) - xreftg(1,2,i)
130 z3(i) = xreftg(3,3,i) - xreftg(1,3,i)
131 ENDDO
132
134 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
135 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
136 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
137 . x31, y31, z31 ,x2l ,x3l ,y3l )
138
139
140
141 IF (ish3nfr ==0 )
CALL c3newve3(jft ,jlt ,ecos,esin,
area,
142 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
143 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
144 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
145
146 fac = one/float(nitrs)
147 DO i=jft,jlt
148 vl(1,1,i) = zero
149 vl(2,1,i) = zero
150 vl(3,1,i) = zero
151 vl(1,2,i) = e1x(i)*xl(1,2,i) + e2x(i)*xl(2,2,i)
152 vl(2,2,i) = e1y(i)*xl(1,2,i) + e2y(i)*xl(2,2,i)
153 vl(3,2,i) = e1z(i)*xl(1,2,i) + e2z(i)*xl(2,2,i)
154 vl(1,3,i) = e1x(i)*xl(1,3,i) + e2x(i)*xl(2,3,i)
155 vl(2,3,i) = e1y(i)*xl(1,3,i) + e2y(i)*xl(2,3,i)
156 vl(3,3,i) = e1z(i)*xl(1,3,i) + e2z(i)*xl(2,3,i)
157
158 vl(1,2,i) = (vl(1,2,i) - x2(i))*fac
159 vl(2,2,i) = (vl(2,2,i) - y2(i))*fac
160 vl(3,2,i) = (vl(3,2,i) - z2(i))*fac
161 vl(1,3,i) = (vl(1,3,i) - x3(i))*fac
162 vl(2,3,i) = (vl(2,3,i) - y3(i))*fac
163 vl(3,3,i) = (vl(3,3,i) - z3(i))*fac
164 ENDDO
165
166 IF (ismstr/=1 .AND. ismstr/=11) THEN
167
168 DO nt=1,nitrs
169
170 fac = float(nt) - one
171 DO i=jft,jlt
172 x1(i) = xreftg(1,1,i) + fac*vl(1,1,i)
173 y1(i) = xreftg(1,2,i) + fac*vl(2,1,i)
174 z1(i) = xreftg(1,3,i) + fac*vl(3,1,i)
175 x2(i) = xreftg(2,1,i) + fac*vl(1,2,i)
176 y2(i) = xreftg(2,2,i) + fac*vl(2,2,i)
177 z2(i) = xreftg(2,3,i) + fac*vl(3,2,i)
178 x3(i) = xreftg(3,1,i) + fac*vl(1,3,i)
179 y3(i) = xreftg(3,2,i) + fac*vl(2,3,i)
180 z3(i) = xreftg(3,3,i) + fac*vl(3,3,i)
181 ENDDO
182
184 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
185 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
186 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
187 . x31, y31, z31 ,x2l ,x3l ,y3l )
188
190 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
191 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
192 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
193
194 CALL corth3(elbuf_str,dir_a,dir_b,jft,jlt,
195 . nlay ,irep ,nel ,
196 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
197 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
198 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z ,
199 . idrape , igtyp )
200
202 . px1g ,py1g ,py2g ,
203 . px1 ,py1 ,py2 ,
204 . x2h ,x3h ,y3h ,
205 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
206 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
207 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
208 CALL c3defoi(jft ,jlt ,nel ,vl ,gstr,
209 . px1 ,py1 ,py2 ,
area,
210 . exx ,eyy ,exy ,eyz ,ezx ,
211 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
212
213 IF (ish3nfr ==0 )
CALL shtroto3(jft,jlt,ecos,esin,gstr,nel)
214
216 . jft ,jlt ,mtn ,ithk ,pm ,
217 .
for ,thk ,eint ,gstr ,dir_a ,
218 . dir_b ,uvar ,ipm ,
219 . nel ,sigi ,npf ,tf ,
220 .
area ,exx ,eyy ,exy ,imat )
221
222 ENDDO
223 ELSE
224
225
226
228 . px1g ,py1g ,py2g ,
229 . px1 ,py1 ,py2 ,
230 . x2s ,x3s ,y3s ,
231 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
232 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
233 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
234 dir1 => elbuf_str%BUFLY(1)%DIRA
235 dir2 => elbuf_str%BUFLY(1)%DIRB
236
237 DO nt=1,nitrs
238 CALL c3defoi(jft ,jlt ,nel ,vl ,gstr,
239 . px1 ,py1 ,py2 ,
area,
240 . exx ,eyy ,exy ,eyz ,ezx ,
241 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
242
243 IF (ish3nfr == 0)
CALL shtroto3(jft,jlt,ecos,esin,gstr,nel)
244
246 . jft ,jlt ,mtn ,ithk ,pm ,
247 .
for ,thk ,eint ,gstr ,dir1 ,
248 . dir2 ,uvar ,ipm ,
249 . nel ,sigi ,npf ,tf ,
250 .
area ,exx ,eyy ,exy ,imat )
251 ENDDO
252
253 ENDIF
254
255 RETURN
subroutine c3newve3(jft, jlt, ecos, esin, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine shtroto3(jft, jlt, ecos, esin, gstr, nel)
subroutine c3defoi(jft, jlt, nel, vl, gstr, px1, py1, py2, area, exx, eyy, exy, eyz, ezx, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine c3pxpyi(jft, jlt, ismstr, px1g, py1g, py2g, px1, py1, py2, x2l, x3l, y3l, x1g, x2g, x3g, y1g, y2g, y3g, z1g, z2g, z3g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine cmlawi(mat_param, jft, jlt, ilaw, ithk, pm, for, thk, eint, gstr, dir1, dir2, uvar, ipm, nel, sigi, npf, tf, area, exx, eyy, exy, imat)
subroutine corth3(elbuf_str, dir_a, dir_b, jft, jlt, nlay, irep, nel, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, idrape, igtyp)
for(i8=*sizetab-1;i8 >=0;i8--)
subroutine c3evec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x31, y31, z31, x2l, x3l, y3l)
1.15.0