55
56
57
58 USE elbufdef_mod
61 use element_mod , only : nixtg
62
63
64
65#include "implicit_f.inc"
66
67
68
69#include "mvsiz_p.inc"
70
71
72
73#include "com04_c.inc"
74#include "param_c.inc"
75
76
77
78
79 INTEGER JFT ,JLT ,NFT ,NPT ,MTN ,ITHK ,
80 . NCYCLE,ISUBSTACK,
81 . ISTRAIN ,IPLA ,OFFSET,IHBE ,ISMSTR,IKGEO, IEXPAN
82 INTEGER , INTENT(IN) :: SEDRAPE,NUMEL_DRAPE
83 INTEGER, DIMENSION(SEDRAPE) :: INDX_DRAPE
84 INTEGER IXTG(NIXTG,*) ,IGEO(NPROPGI,*),IPM(*),IPARG(*)
85 INTEGER INDXOF(MVSIZ),
86 . ETAG(*),IDDL(*) ,NDOF(*) ,IADK(*) ,JDIK(*)
87
89 . pm(npropm,*),geo(npropg,*),bufmat(*), x(3,*),thke(*)
91 . ke11(36,mvsiz),ke22(36,mvsiz),ke33(36,mvsiz),
92 . ke12(36,mvsiz),ke13(36,mvsiz),ke23(36,mvsiz),off(mvsiz),
93 . k_diag(*) ,k_lt(*)
94 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
95 TYPE (STACK_PLY) ::
96 TYPE (DRAPE_) :: DRAPE_SH3N(NUMELTG_DRAPE)
97
98
99
100
101 INTEGER MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ)
102 INTEGER I,J,J1,J2,IREP,IUN,NEL,IORTH,IGTYP,L_DIRA,L_DIRB,NLAY,
103 . IDRIL,EP
105 .
area(mvsiz),px1(mvsiz), py1(mvsiz), py2(mvsiz),
106 . thk0(mvsiz),
107 . x2(mvsiz) ,y2(mvsiz), x3(mvsiz),y3(mvsiz)
109 . vol0(mvsiz),thk02(mvsiz),
110 . hm(mvsiz,4),hf(mvsiz,4),hc(mvsiz,2),hz(mvsiz),
111 . hmor(mvsiz,2),hfor(mvsiz,2),hmfor(mvsiz,6),gs(mvsiz)
113 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
114 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
115 . r31(mvsiz),r32(mvsiz),r33(mvsiz),
116 . k11(9,mvsiz),k12(9,mvsiz),k13(9,mvsiz),
117 . k22(9,mvsiz),k23(9,mvsiz),k33(9,mvsiz),
118 . m11(9,mvsiz),m12(9,mvsiz),m13(9,mvsiz),
119 . m22(9,mvsiz),m23(9,mvsiz),m33(9,mvsiz),
120 . mf11(9,mvsiz),mf12(9,mvsiz),mf13(9,mvsiz),
121 . mf22(9,mvsiz),mf23(9,mvsiz),mf33(9,mvsiz),
122 . fm12(9,mvsiz),fm13(9,mvsiz),fm23(9,mvsiz),
123 . bm0rz(mvsiz,3,2),b0rz(mvsiz,3),bkrz(mvsiz,2),berz(mvsiz,2)
124
126 . DIMENSION(:) ,POINTER :: dir_a, dir_b
128 . ALLOCATABLE, DIMENSION(:), TARGET :: dira,dirb
129 TYPE(G_BUFEL_) ,POINTER :: GBUF
130
131 iun = 1
132 nel=jlt-jft+iun
133 gbuf => elbuf_str%GBUF
134 idril = iparg(41)
135
136 igtyp = igeo(11,ixtg(5,1))
137 irep = igeo(6 ,ixtg(5,1))
138 nlay = elbuf_str%NLAY
139 l_dira = elbuf_str%BUFLY(1)%LY_DIRA
140 l_dirb = elbuf_str%BUFLY(1)%LY_DIRB
141 ALLOCATE(dira(nlay*nel*l_dira))
142 ALLOCATE(dirb(nlay*nel*l_dirb))
143 dira = zero
144 dirb = zero
145 dir_a => dira(1:nlay*nel*l_dira)
146 dir_b => dirb(1:nlay*nel*l_dirb)
147 IF (irep == 0) THEN
148 DO j=1,nlay
149 j1 = 1+(j-1)*l_dira*nel
150 j2 = j*l_dira*nel
151 dira(j1:j2) = elbuf_str%BUFLY(j)%DIRA(1:nel*l_dira)
152 ENDDO
153 ENDIF
154
155 CALL c3coork3(jft ,jlt ,x ,ixtg ,gbuf%OFF,
156 1 geo ,pid ,mat ,ngl ,
area ,
157 2 irep ,npt ,ismstr ,nlay ,
158 2 elbuf_str ,gbuf%SMSTR, dir_a,dir_b ,
159 3 x2 ,x3 ,y3 ,
160 4 r11,r12,r13,r21,r22,r23,r31,r32,r33,
161 5 k11,k12,k13,k22,k23,k33,
162 6 m11,m12,m13,m22,m23,m33,
163 7 mf11,mf12,mf13,mf22,mf23,mf33,
164 8 fm12,fm13,fm23,off ,nel)
165 IF (irep>0) THEN
166 CALL cmatc3(jft ,jlt ,pm ,mat ,geo ,
167 1 pid ,
area ,thk0 ,thk02 ,gbuf%THK ,
168 2 thke ,vol0 ,mtn ,npt ,ithk ,
169 3 hm ,hf ,hc ,hz ,igtyp ,
170 4 iorth ,hmor ,hfor ,dir_a ,igeo ,
171 5 idril ,ihbe ,hmfor ,gs ,isubstack,
172 6 stack ,elbuf_str ,nlay ,drape_sh3n , nft ,
173 . nel ,indx_drape,sedrape,numel_drape)
174 ELSE
175 CALL cmatc3(jft ,jlt ,pm ,mat ,geo ,
176 1 pid ,
area ,thk0 ,thk02 ,gbuf%THK ,
177 2 thke ,vol0 ,mtn ,npt ,ithk ,
178 3 hm ,hf ,hc ,hz ,igtyp ,
179 4 iorth ,hmor ,hfor ,dira ,igeo ,
180 5 idril ,ihbe ,hmfor ,gs ,isubstack,
181 6 stack ,elbuf_str ,nlay ,drape_sh3n ,nft ,
182 . nel ,indx_drape,sedrape,numel_drape)
183 ENDIF
184
185
186
187 CALL cmatip3(jft ,jlt ,pm ,mat ,pid ,
188 1 mtn ,npt ,hm ,hf ,iorth ,
189 2 hmor ,hfor ,hmfor ,iun )
190 IF (iorth >0 ) THEN
191 DO i=1,9
192 DO ep=jft,jlt
193 mf11(i,ep) =zero
194 mf22(i,ep) =zero
195 mf33(i,ep) =zero
196 mf12(i,ep) =zero
197 mf13(i,ep) =zero
198 mf23(i,ep) =zero
199 fm12(i,ep) =zero
200 fm13(i,ep) =zero
201 fm23(i,ep) =zero
202 ENDDO
203 ENDDO
204 ENDIF
205 CALL c3be3(jft,jlt,px1,py1,py2 ,x2 ,x3 , y3 ,
area)
206
207
208
209 CALL c3lke3(jft,jlt,
area,thk0,thk02,hm,hf,hc,hz,
210 1 px1,py1,py2,vol0,
211 2 k11,k12,k13,k22,k23,k33,
212 3 m11,m12,m13,m22,m23,m33,
213 4 mf11,mf12,mf13,mf22,mf23,mf33,
214 5 fm12,fm13,fm23,ikgeo,gbuf%FOR,gbuf%MOM,
215 6 iorth,hmor,hfor,hmfor,idril,
216 7 nel)
217 IF (idril>0) THEN
218 DO i=jft,jlt
219 y2(i)=zero
220 END DO
221
223 2 y2 ,y3 ,bm0rz,b0rz,bkrz,berz )
225 1 px1,py1,py2,vol0,
area,
226 2 k11,k12,k13,k22,k23,k33,
227 3 m11,m12,m13,m22,m23,m33,
228 4 mf11,mf12,mf13,mf22,mf23,mf33,
229 5 fm12,fm13,fm23,iorth,hmor,
230 6 bm0rz,b0rz,bkrz,berz,thk0,hmfor)
231 END IF
232
233
234
236 1 r11,r12,r13,r21,r22,r23,r31,r32,r33,
237 2 k11,k12,k13,k22,k23,k33,
238 3 m11,m12,m13,m22,m23,m33,
239 4 mf11,mf12,mf13,mf22,mf23,mf33,
240 5 fm12,fm13,fm23,
241 6 ke11,ke22,ke33,ke12,ke13,ke23,idril,
242 7 iorth)
243
244
246 1 jft, jlt, ixtg, etag, off)
248 1 ixtg ,nel ,iddl ,ndof ,k_diag ,
249 2 k_lt ,iadk ,jdik ,ke11 ,ke12 ,
250 3 ke13 ,ke22 ,ke23 ,ke33 ,off )
251
252 RETURN
subroutine assem_c3(ixtg, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, kc11, kc12, kc13, kc22, kc23, kc33, off)
subroutine c3be3(jft, jlt, px1, py1, py2, x2, x3, y3, area)
subroutine c3coork3(jft, jlt, x, ixtg, offg, geo, pid, mat, ngl, area, irep, npt, ismstr, nlay, elbuf_str, smstr, dir_a, dir_b, xl2, xl3, yl3, r11, r12, r13, r21, r22, r23, r31, r32, r33, k11, k12, k13, k22, k23, k33, m11, m12, m13, m22, m23, m33, mf11, mf12, mf13, mf22, mf23, mf33, fm12, fm13, fm23, off, nel)
subroutine c3derirz(jft, jlt, area, x2, x3, y2, y3, bmrz, b0rz, bkrz, berz)
subroutine c3eoff(jft, jlt, ixtg, etag, off)
subroutine c3lke3(jft, jlt, area, thk0, thk2, hm, hf, hc, hz, px1, py1, py2, vol, k11, k12, k13, k22, k23, k33, m11, m12, m13, m22, m23, m33, mf11, mf12, mf13, mf22, mf23, mf33, fm12, fm13, fm23, ikgeo, for, mom, iorth, hmor, hfor, hmfor, idril, nel)
subroutine c3lkerz3(jft, jlt, hm, hz, px1, py1, py2, vol, area, k11, k12, k13, k22, k23, k33, m11, m12, m13, m22, m23, m33, mf11, mf12, mf13, mf22, mf23, mf33, fm12, fm13, fm23, iorth, hmor, bm0rz, b0rz, bkrz, berz, thk0, hmfor)
subroutine c3sumg3(jft, jlt, r11, r12, r13, r21, r22, r23, r31, r32, r33, k11, k12, k13, k22, k23, k33, m11, m12, m13, m22, m23, m33, mf11, mf12, mf13, mf22, mf23, mf33, fm12, fm13, fm23, ke11, ke22, ke33, ke12, ke13, ke23, idril, iorth)
subroutine cmatip3(jft, jlt, pm, mat, pid, mtn, npt, hm, hf, iorth, hmor, hfor, hmfor, ipg)
subroutine cmatc3(jft, jlt, pm, mat, geo, pid, area, thk0, thk02, thk, thke, volg, mtn, npt, ithk, hm, hf, hc, hz, igtyp, iorth, hmor, hfor, dir, igeo, idril, ihbe, hmfor, gs, isubstack, stack, elbuf_str, nlay, drape, nft, nel, indx_drape, sedrape, numel_drape)
subroutine area(d1, x, x2, y, y2, eint, stif0)