44
45
46
47 USE elbufdef_mod
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "mvsiz_p.inc"
56
57
58
59#include "param_c.inc"
60
61
62
63 INTEGER JFT, JLT ,IREP,NPT,ISMSTR,NLAY,NEL
64 INTEGER IXTG(NIXTG,*),PID(*),MAT(*),NGL(*)
65
67 . x(3,*),offg(*),
area(*),
68 . geo(npropg,*),xl2(*),xl3(*),yl3(*),
69 . r11(*),r12(*),r13(*),
70 . r21(*),r22(*),r23(*),
71 . r31(*),r32(*),r33(*),
72 . k11(9,*),k12(9,*),k13(9,*),
73 . k22(9,*),k23(9,*),k33(9,*),
74 . m11(9,*),m12(9,*),m13(9,*),
75 . m22(9,*),m23(9,*),m33(9,*),
76 . mf11(9,*),mf12(9,*),mf13(9,*),
77 . mf22(9,*),mf23(9,*),mf33(9,*),
78 . fm12(9,*),fm13(9,*),fm23(9,*),off(*),smstr(*),
79 . dir_a(nel,*),dir_b(nel,*)
80 TYPE(ELBUF_STRUCT_) :: ELBUF_STR
81
82
83
84 INTEGER NC1, NC2, NC3,I,II(3),J,K, MAT_1
85
87 . x1(mvsiz), y1(mvsiz), z1(mvsiz),deta1(mvsiz),
88 . x2(mvsiz), y2(mvsiz), z2(mvsiz),
89 . x3(mvsiz), y3(mvsiz), z3(mvsiz),
90 . rx(mvsiz), ry(mvsiz), rz(mvsiz),
91 . sx(mvsiz), sy(mvsiz), sz(mvsiz)
92
93 DO i=1,3
94 ii(i) = nel*(i-1)
95 ENDDO
96
97 mat_1 = ixtg(1,jft)
98 DO i=jft,jlt
99 mat(i) = mat_1
100 nc1 = ixtg(2,i)
101 nc2 = ixtg(3,i)
102 nc3 = ixtg(4,i)
103 pid(i) = ixtg(5,i)
104 ngl(i) = ixtg(6,i)
105
106
107
108 x1(i)=x(1,nc1)
109 y1(i)=x(2,nc1)
110 z1(i)=x(3,nc1)
111 x2(i)=x(1,nc2)
112 y2(i)=x(2,nc2)
113 z2(i)=x(3,nc2)
114 x3(i)=x(1,nc3)
115 y3(i)=x(2,nc3)
116 z3(i)=x(3,nc3)
117 ENDDO
118
119 DO i=jft,jlt
120 rx(i)=x2(i)-x1(i)
121 sx(i)=x3(i)-x1(i)
122 ry(i)=y2(i)-y1(i)
123 sy(i)=y3(i)-y1(i)
124 rz(i)=z2(i)-z1(i)
125 sz(i)=z3(i)-z1(i)
126 ENDDO
127
128
129
130 k = 2
132 . rx, ry, rz,
133 . sx, sy, sz,
134 . r11,r12,r13,r21,r22,r23,r31,r32,r33,deta1,offg )
135
136
137
138 DO i=jft,jlt
139 area(i)=half*deta1(i)
140 xl2(i)=r11(i)*rx(i)+r21(i)*ry(i)+r31(i)*rz(i)
141 xl3(i)=r11(i)*sx(i)+r21(i)*sy(i)+r31(i)*sz(i)
142 yl3(i)=r12(i)*sx(i)+r22(i)*sy(i)+r32(i)*sz(i)
143 ENDDO
144
145
146
147 IF(ismstr==1.OR.ismstr==2)THEN
148 DO i=jft,jlt
149 IF(abs(offg(i))==2.)THEN
150 xl2(i)=smstr(ii(1)+i)
151 xl3(i)=smstr(ii(2)+i)
152 yl3(i)=smstr(ii(3)+i)
153 ELSE
154 smstr(ii(1)+i)=xl2(i)
155 smstr(ii(2)+i)=xl3(i)
156 smstr(ii(3)+i)=yl3(i)
157 ENDIF
158 ENDDO
159 ENDIF
160 IF(ismstr==1)THEN
161 DO i=jft,jlt
162 IF(offg(i) == one) offg(i)=two
163 ENDDO
164 ENDIF
165
166
167
168 IF (irep > 0) THEN
169 CALL cortdir3(elbuf_str,dir_a,dir_b ,jft ,jlt ,
170 . nlay ,irep ,rx ,ry ,rz ,
171 . sx ,sy ,sz ,r11 ,r21 ,
172 . r31 ,r12 ,r22 ,r32 ,nel )
173 ENDIF
174
175 DO j=1,9
176 DO i=jft,jlt
177 k11(j,i)=zero
178 k12(j,i)=zero
179 k13(j,i)=zero
180 k22(j,i)=zero
181 k23(j,i)=zero
182 k33(j,i)=zero
183 m11(j,i)=zero
184 m12(j,i)=zero
185 m13(j,i)=zero
186 m22(j,i)=zero
187 m23(j,i)=zero
188 m33(j,i)=zero
189 ENDDO
190 ENDDO
191 DO i=jft,jlt
192 off(i)=offg(i)
193 ENDDO
194
195 RETURN
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
subroutine cortdir3(elbuf_str, dir_a, dir_b, jft, jlt, nlay, irep, rx, ry, rz, sx, sy, sz, e1x, e1y, e1z, e2x, e2y, e2z, nel)
subroutine area(d1, x, x2, y, y2, eint, stif0)