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