58
59
60
61 USE elbufdef_mod
64 use element_mod , only : nixc
65
66
67
68#include "implicit_f.inc"
69
70
71
72#include "mvsiz_p.inc"
73
74
75
76#include "com04_c.inc"
77#include "param_c.inc"
78
79
80
81 INTEGER JFT ,JLT ,NFT ,NPT ,MTN ,ITHK ,
82 . NCYCLE,ISTRAIN ,IPLA ,OFFSET,IHBE ,ISMSTR,IKGEO,IEXPAN
83 INTEGER , INTENT(IN) :: SEDRAPE,NUMEL_DRAPE
84 INTEGER IXC(NIXC,*) ,IGEO(NPROPGI,*),IPM(*),IPARG(*)
85 INTEGER INDXOF(MVSIZ),ISUBSTACK,
86 . ETAG(*),IDDL(*) ,NDOF(*) ,IADK(*) ,JDIK(*)
87 INTEGER, DIMENSION(SEDRAPE) :: INDX_DRAPE
88
90 . pm(npropm,*),geo(npropg,*),bufmat(*), x(3,*),thke(*)
92 . ke11(36,mvsiz),ke22(36,mvsiz),ke33(36,mvsiz),ke44(36,mvsiz),
93 . ke12(36,mvsiz),ke13(36,mvsiz),ke14(36,mvsiz),ke23(36,mvsiz),
94 . ke24(36,mvsiz),ke34(36,mvsiz),off(mvsiz),k_diag(*) ,k_lt(*)
95 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
96 TYPE (STACK_PLY) :: STACK
97 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE)
98
99
100
101 INTEGER
102 . NPLAT,NLAY,IPLAT(MVSIZ)
103 INTEGER
104 . , J,J1,J2, IR, IS, NEL, IUN,L_DIRA ,L_DIRB ,
105 . NG,NPG,NNOD,IREP,LENF,LENM,NPTR,NPTS,
106 . PTF,PTM
107 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
108 INTEGER MPT,IORTH,IDRIL
109 parameter(npg = 4)
110 parameter(nnod = 4)
112 . vcore(mvsiz,3*nnod),
113 . vqn(mvsiz,9*nnod),vqg(mvsiz,9*nnod),vnrm(mvsiz,3*nnod),
114 . bm(mvsiz,9*nnod),bmf(mvsiz,9*nnod),bf(mvsiz,6*nnod),
115 . bc(mvsiz,10*nnod),vq(mvsiz,9),vjfi(mvsiz,6,4),
116 . tc(mvsiz,4),jac(mvsiz,npg),hx(mvsiz,npg),hy(mvsiz,npg),
117 . veta(4,npg),vksi(4,npg),bzz(mvsiz,2*nnod)
119 . vastn(mvsiz,4*nnod),
area(mvsiz),
120 . cdet(mvsiz),thk2(mvsiz)
121 INTEGER
122 . NEL8,NEL5,NEL3,NPTM,IGTYP
124 . vol0(mvsiz),thk0(mvsiz),
125 . x13(mvsiz) ,y13(mvsiz), x24(mvsiz) ,hz(mvsiz),
126 . volg(mvsiz),y24(mvsiz),hm(mvsiz,4),hf(mvsiz,4),hc(mvsiz,2),
127 . hmor(mvsiz,2),hfor(mvsiz,2),hmfor(mvsiz,6),gs(mvsiz)
129 . k11(9,mvsiz),k12(9,mvsiz),k13(9,mvsiz),k14(9,mvsiz),
130 . k22(9,mvsiz),k23(9,mvsiz),k24(9,mvsiz),k33(9,mvsiz
131 . m11(9,mvsiz),m12(9,mvsiz),m13(9,mvsiz),m14(9,mvsiz),
132 . m22(9,mvsiz),m23(9,mvsiz),m24(9,mvsiz),m33(9,mvsiz),
133 . mf11(9,mvsiz),mf12(9,mvsiz),mf13(9,mvsiz),mf14(9,mvsiz),
134 . mf22(9,mvsiz),mf23(9,mvsiz),mf24(9,mvsiz),mf33(9,mvsiz),
135 . fm12(9,mvsiz),fm13(9,mvsiz),fm14(9,mvsiz),
136 . fm23(9,mvsiz),fm24(9,mvsiz),fm34(9,mvsiz),
137 . k34(9,mvsiz),k44(9,mvsiz),m34(9,mvsiz),m44(9,mvsiz),
138 . mf34(9,mvsiz),mf44(9,mvsiz),
139 . bm0rz(mvsiz,4,4),bmkrz(mvsiz,4,4),bmerz(mvsiz,4,4),
140 . bmrz(mvsiz,3,4),brz(mvsiz,4,4)
141
143 . DIMENSION(:) ,POINTER :: dir_a, dir_b
145 . ALLOCATABLE, DIMENSION(:), TARGET :: dira,dirb
146 TYPE(G_BUFEL_) ,POINTER :: GBUF
147
148
149
150 gbuf => elbuf_str%GBUF
151 iun = 1
152 nel=jlt-jft+iun
153 IF (mtn==1) npt=0
154 mpt=iabs(npt)
155 idril = iparg(41)
156
157 nel3 = nel*3
158 nel5 = nel*5
159 nel8 = nel*8
161 nlay = elbuf_str%NLAY
162
163 igtyp = igeo(11,ixc(6,1))
164 irep = igeo(6 ,ixc(6,1))
165 l_dira = elbuf_str%BUFLY(1)%LY_DIRA
166 l_dirb = elbuf_str%BUFLY(1)%LY_DIRB
167 ALLOCATE(dira(nlay*nel*l_dira))
168 ALLOCATE(dirb(nlay*nel*l_dirb))
169 dira = zero
170 dirb = zero
171 dir_a => dira(1:nlay*nel
172 dir_b => dirb(1:nlay*nel*l_dirb)
173 IF (irep == 0) THEN
174 DO j=1,nlay
175 j1 = 1+(j-1)*l_dira*nel
176 j2 = j*l_dira*nel
177 dira(j1:j2) = elbuf_str%BUFLY(j)%DIRA(1:nel*l_dira)
178 ENDDO
179 ENDIF
180
181 CALL cbacoork(jft,jlt,x,ixc,pm,gbuf%OFF,
182 1 geo,
area,vcore,jac,hx,hy,
183 2 vqn,vqg,vq,vjfi,vnrm,vastn,nplat,iplat,
184 3 x13 ,x24 ,y13,y24,
185 4 elbuf_str,nlay, gbuf%SMSTR,
186 5 irep,npt,ismstr,dir_a,dir_b ,
187 6 pid ,mat,ngl,off,idril,nel)
188 CALL cbaini3(jft,jlt,vksi,veta,
189 1 k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
190 2 m11,m12,m13,m14,m22,m23,m24,m33,m34,m44,
191 3 mf11,mf12,mf13,mf14,mf22,mf23,mf24,mf33,
192 4 mf34,mf44,fm12,fm13,fm14,fm23,fm24,fm34)
193
194 IF (irep>0) THEN
195 CALL cmatc3(jft ,jlt ,pm ,mat ,geo ,
196 1 pid ,
area ,thk0 ,thk2 ,gbuf%THK,
197 2 thke ,volg ,mtn ,npt ,ithk ,
198 3 hm ,hf ,hc ,hz ,igtyp ,
199 4 iorth ,hmor ,hfor ,dir_a ,igeo ,
200 5 idril ,ihbe ,hmfor ,gs ,isubstack,
201 6 stack ,elbuf_str,nlay ,drape_sh4n ,nft ,
202 7 nel ,indx_drape,sedrape,numel_drape)
203 ELSE
204 CALL cmatc3(jft ,jlt ,pm ,mat ,geo ,
205 1 pid ,
area ,thk0 ,thk2 ,gbuf%THK,
206 2 thke ,volg ,mtn ,npt ,ithk ,
207 3 hm ,hf ,hc ,hz ,igtyp ,
208 4 iorth ,hmor ,hfor ,dira ,igeo ,
209 5 idril ,ihbe ,hmfor ,gs ,isubstack,
210 6 stack ,elbuf_str,nlay ,drape_sh4n , nft ,
211 7 nel ,indx_drape,sedrape,numel_drape)
212 ENDIF
213 IF (idril>0) THEN
215 2 y13 ,y24 ,bm0rz,bmkrz,bmerz,
216 3 vcore,nplat,iplat,ismstr)
217 ELSE
218 CALL cbabec3(jft ,jlt ,x13 ,x24 ,y13 ,y24 ,bm, nplat, iplat)
219 END IF
220
221
222
223 lenf = nel*gbuf%G_FORPG/npg
224 lenm = nel*gbuf%G_MOMPG/npg
225 nptr = elbuf_str%NPTR
226 npts = elbuf_str%NPTS
227 DO is = 1,npts
228 DO ir = 1,nptr
229 ng = nptr*(is-1) + ir
230 ptf = (ng-1)*lenf+1
231 ptm = (ng-1)*lenm+1
232 DO i=jft,jlt
233 cdet(i) = jac(i,ng)
234 vol0(i) = thk0(i)*cdet(i)
235 ENDDO
236
237
238
239 CALL cbabe3(jft,jlt,ng,vcore,
area,cdet,vqn,vqg,vjfi,
240 1 vnrm,vastn,hx,hy,veta,vksi,
241 2 bm,bmf,bf,bc,tc,bzz,nplat,iplat,
242 3 idril,brz )
243
244
245
246 CALL cmatip3(jft ,jlt ,pm ,mat ,pid ,
247 1 mtn ,npt ,hm ,hf ,iorth ,
248 2 hmor ,hfor ,hmfor ,ng )
249
250
251
252 CALL cbalke3(jft,jlt,cdet,thk0,thk2,hm,hf,hc,hz,
253 1 bm,bmf,bf,bc,tc,bzz,nplat,iplat,vol0,
254 2 ikgeo,gbuf%FORPG(ptf),gbuf%MOMPG(ptm),
255 3 k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
256 4 m11,m12,m13,m14,m22,m23,m24,m33,m34,m44,
257 5 mf11,mf12,mf13,mf14,mf22,mf23,mf24,mf33,
258 6 mf34,mf44,fm12,fm13,fm14,fm23,fm24,fm34,
259 7 iorth,hmor,hfor,idril,hmfor,
260 8 x13 ,x24 ,y13 ,y24,nel)
261 IF (idril>0) THEN
262 CALL cbaber3(jft ,jlt ,bm0rz,bmkrz,bmerz ,
263 2 bmrz ,brz ,bm ,nplat ,iplat,
264 3 ng )
265 CALL cbalkerz(jft ,jlt ,vol0 ,thk0 ,
266 2 hm ,hz ,bm ,
267 6 k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
268 7 m11,m12,m13,m14,m22,m23,m24,m33,m34,m44,
269 8 mf11,mf12,mf13,mf14,mf22,mf23,mf24,mf33,
270 9 mf34,mf44,fm12,fm13,fm14,fm23,fm24,fm34,
271 a iorth,hmor,hfor ,iplat,nplat,
272 b bmrz,brz ,gbuf%HOURG,ikgeo,ng ,hmfor,bf ,
273 c bmf ,nel)
274 END IF
275 ENDDO
276 ENDDO
277
278
279 IF (idril==0) THEN
280 CALL cbalkec3(jft,jlt,volg ,x13 ,x24 ,y13 ,y24, hm,
281 1 k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
282 2 nplat,iplat,ikgeo,gbuf%FOR,m11,m22,m33,m44,
283 3 iorth,nel)
284 END IF
285
286
287
289 1 jft ,jlt ,vqn ,vq ,nplat ,iplat ,
290 2 k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
291 3 m11,m12,m13,m14,m22,m23,m24,m33,m34,m44,
292 4 mf11,mf12,mf13,mf14,mf22,mf23,mf24,mf33,
293 5 mf34,mf44,fm12,fm13,fm14,fm23,fm24,fm34,
294 6 ke11,ke22,ke33,ke44,ke12,ke13,ke14,ke23,
295 7 ke24,ke34,vcore,idril,iorth)
296
298 1 jft, jlt, ixc, etag, off)
299
301 1 ixc ,nel ,iddl ,ndof ,k_diag ,
302 2 k_lt ,iadk ,jdik ,ke11 ,ke12 ,
303 3 ke13 ,ke14 ,ke22 ,ke23
304 5 ke33 ,ke34 ,ke44 ,off )
305
306 RETURN
subroutine assem_c4(ixc, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, kc11, kc12, kc13, kc14, kc22, kc23, kc24, kc33, kc34, kc44, off)
subroutine c4eoff(jft, jlt, ixc, etag, off)
subroutine cbabec3(jft, jlt, x13, x24, y13, y24, bm, nplat, iplat)
subroutine cbaber3(jft, jlt, bm0rz, bmkrz, bmerz, bmrz, brz, bm, nplat, iplat, ng)
subroutine cbabe3(jft, jlt, ng, vcore, area, cdet, vqn, vq, vjfi, vnrm, vastn, hx, hy, veta, vksi, bm, bmf, bf, bc, tc, bzz, nplat, iplat, isrot, brz)
subroutine cbacoork(jft, jlt, x, ixc, pm, offg, geo, area, vcore, jac, hx, hy, vqn, vqg, vq, vjfi, vnrm, vastn, nplat, iplat, x13_t, x24_t, y13_t, y24_t, elbuf_str, nlay, smstr, irep, npt, ismstr, dir_a, dir_b, pid, mat, ngl, off, isrot, nel)
subroutine cbaderirz(jft, jlt, area, x13, x24, y13, y24, bm0rz, bmkrz, bmerz, vcore, nplat, iplat, ismstr)
subroutine cbaini3(jft, jlt, vksi, veta, 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)
subroutine cbalkec3(jft, jlt, vol, x13, x24, y13, y24, hm, k11, k12, k13, k14, k22, k23, k24, k33, k34, k44, nplat, iplat, ikgeo, for, m11, m22, m33, m44, iorth, nel)
subroutine cbalke3(jft, jlt, cdet, thk0, thk2, hm, hf, hc, hz, bm, bmf, bf, bc, tc, bzz, nplat, iplat, vol, ikgeo, for, mom, 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, iorth, hmor, hfor, idril, hmfor, x13, x24, y13, y24, nel)
subroutine cbalkerz(jft, jlt, vol, thk0, hm, hz, bm, 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, iorth, hmor, hfor, iplat, nplat, pmrz, brz, frz, ikgeo, ng, hmfor, bf, bmf, nel)
subroutine cbasumg3(jft, jlt, vqn, vq, 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, ke11, ke22, ke33, ke44, ke12, ke13, ke14, ke23, ke24, ke34, vcore, 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)