41
42
43
44 USE elbufdef_mod
47 USE my_alloc_mod
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "mvsiz_p.inc"
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "param_c.inc"
59#include "remesh_c.inc"
60#include "scr17_c.inc"
61#include "task_c.inc"
62
63
64
65 INTEGER IPARG(NPARG,*),EL2FA(*),NBF,IOFF(*),
66 . IADD(*),NBF_L,NBPART, IADG(NSPMD,*),NODGLOB(*),
67 . IPART(LIPART1,*), IPARTC(*), IPARTTG(*)
68 INTEGER IPLY,NEL_PLY,PLYS,NBF_PXFEMG,IXC(NIXC,*),IPM(NPROPMI,*),
69 . IGEO(NPROPGI,*)
70 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
71 TYPE (STACK_PLY) :: STACK
72
73
74
75 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, NPT,
76 . N, J, LLT, MLW, IP, NN, K1, K2,MT,JALE, IMID,
77 . N1,N2,N3,N4, NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
78 . N_FA, IHBE, , ISTRAIN, IEXPAN,ISHPLYXFEM,NELXFE,IE,
79 . PLYELEMS(NUMELC),IPT,ELC,MPT,NGL(MVSIZ),ISUBSTACK,IPMAT_IPLY,
80 . IPMAT, IPPID
81
82 INTEGER RBUF,NEL3,NEL5,NEL8,NPTM,NN12,NN13,NN14,
83 . NN15,NN16,NN16A,NPG,PID(MVSIZ),,NUVARR,NUVARD,NBM_S,
84 . IFAILURE,NPTR,NPTS,,IR,OFFIPLY
85 INTEGER,DIMENSION(:),ALLOCATABLE::IOFFBUF
86 REAL R4
87 TYPE(G_BUFEL_) ,POINTER :: GBUF
88 TYPE(BUF_LAY_) ,POINTER :: BUFLY
89 TYPE(L_BUFEL_) ,POINTER :: LBUF
90
91 CALL my_alloc(ioffbuf,nbf_l)
92 npg = 4
93 ioffbuf = -1
96
97
98
99
100 plyelems=0
104 plyelems(elc)=ipt
105 ENDDO
106
107
108
109
110
111
112
113 nelxfe = 0
114 ie = 0
115 DO ng=1,ngroup
116 mlw =iparg(1,ng)
117 nel =iparg(2,ng)
118 ity =iparg(5,ng)
119 nft =iparg(3,ng)
120 iad =iparg(4,ng)
121 mpt = iparg(6,ng)
122 ishplyxfem = iparg(50,ng)
123 isubstack = iparg(71,ng)
124 lft=1
125 llt=nel
126
127
128
129 IF(ishplyxfem > 0 ) THEN
130
131 nptr = elbuf_tab(ng)%NPTR
132 npts = elbuf_tab(ng)%NPTS
133
134 gbuf => elbuf_tab(ng)%GBUF
135 bufly => elbuf_tab(ng)%BUFLY(ipt)
136 IF (ity == 3) THEN
137 ihbe = iparg(23,ng)
138 npt =iparg(6,ng)
139 istrain=iparg(44,ng)
140 iexpan=iparg(49,ng)
141 ifailure = iparg(43,ng)
142 n_fa =nel_ply
143 nelxfe = nelxfe + nel
144
145 DO i=1,nel
146 pid(i) = ixc(6,nft + i)
147 ngl(i) = ixc(7,nft + i)
148 ENDDO
149
150 IF (ihbe >= 11.AND.ihbe <= 19)THEN
151 nel3 = nel*3
152 nel5 = nel*5
153 nel8 = nel*8
155 IF (mpt >= one) THEN
156 ENDIF
157 nbm_s = 6*nel*mpt+nel
158 nuvarr = zero
159 nuvard = zero
160
161 ippid = 2
162 ipmat = ippid + npt
163 ipmat_iply = ipmat + npt
164 DO j= 1,mpt-1
165 DO i=1,nel
166 matly = stack%IGEO(ipmat + j,isubstack)
167 nuvarr =
max(nuvarr,ipm(221,matly))
168 matly = stack%IGEO(ipmat_iply + j,isubstack)
169 nuvard =
max(nuvard, ipm(221,matly))
170 ENDDO
171 ENDDO
172 DO i=1,nel
173 matly = stack%IGEO(ipmat + j,isubstack)
174 nuvarr =
max(nuvarr,ipm(221,matly))
175 ENDDO
176 ENDIF
177 nbm_s = nbm_s + nel*mpt*nuvarr
178
179
180
181 ELSEIF(ity==7)THEN
182
183 ENDIF
184
185 IF(ity == 3)THEN
186 IF(mlw == 0 .OR. mlw == 13)THEN
187
188
189
190 DO i=lft,llt
191 n = i + nft
192 IF(plyelems(n) > 0) THEN
193 ie = ie + 1
194 ioff(el2fa(n_fa+ie)) = 1
195 ENDIF
196 ENDDO
197 ELSE
198
199
200
201 IF(nadmesh==0.OR.(ity/=3.AND.ity/=7))THEN
202 DO i=lft,llt
203 n = i + nft
204 ipt = plyelems(n)
205 IF(plyelems(n) > 0) THEN
206 ie = ie +1
207 ioff(el2fa(n_fa+ie)) = 1
208 DO is = 1,npts
209 DO ir = 1,nptr
210 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(ir,is,1)
211 offiply = nint(
min(gbuf%OFF(i),lbuf%OFF(i),one))
212 ioff(el2fa(n_fa+ie)) =
min(ioff(el2fa(n_fa+ie)),offiply)
213 ENDDO
214 ENDDO
215 ENDIF
216 ENDDO
217 ELSE
218 DO i=lft,llt
219 n = i + nft
220 ipt = plyelems(n)
221 IF(plyelems(n) > 0) THEN
222 ip=ipartc(nft+i)
223 ie = ie + 1
224 ioff(el2fa(n_fa+ie)) = 1
225 IF(ipart(10,ip)>0)THEN
226 DO is = 1,npts
227 DO ir = 1,nptr
228 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(ir,is,1)
229 offiply = nint(
min(gbuf%OFF(i),lbuf%OFF(i),one))
230 ioff(el2fa(n_fa+ie))=
min(ioff(el2fa(n_fa+ie)),offiply)
231 ENDDO
232 ENDDO
233 ELSE
234 DO is = 1,npts
235 DO ir = 1,nptr
236 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(ir,is,1)
237 offiply = nint(
min(gbuf%OFF(i),lbuf%OFF(i),one))
238 ioff(el2fa(n_fa+ie)) =
min(ioff(el2fa(n_fa+ie)),offiply)
239 ENDDO
240 ENDDO
241 END IF
242 ENDIF
243 ENDDO
244 ENDIF
245 ENDIF
246 ENDIF
247
248 ENDIF
249
250 ENDDO
251
252 iadd(iply) = nel_ply + ie
253 nel_ply = nel_ply +
plyshell(iply)%PLYNUMSHELL
254 ENDDO
255
256 IF (nspmd==1)THEN
258 ELSE
259
260 DO i = 1, nbf_l
261 ioffbuf(i) = ioff(i)
262 ENDDO
263
264 IF (ispmd==0) THEN
265 rbuf = nbf_pxfemg
267 ELSE
268 rbuf = 1
270 END IF
271 ENDIF
272 DEALLOCATE(ioffbuf)
273 RETURN
integer, dimension(:), allocatable indx_ply
type(plyshells), dimension(:), allocatable plyshell
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
void write_c_c(int *w, int *len)