OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_pon.F File Reference
#include "implicit_f.inc"
#include "tabsiz_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine w_pon (addcne, cne, lcne, numnod_l, nodglob, lcne_l, cep, cel, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, monvol, ib, geo, igeo, proc, numels_l, numels8_l, numels10_l, numels16_l, numels20_l, numelq_l, numelc_l, numelt_l, numelp_l, numelr_l, numeltg_l, nskyrw_l, nprw, lprw, nskyrbk_l, npby, lpby, dd_rby2, i2nsnt, i2nsn_l, ipari, nir, lcni2_l, niskyi2_l, cepi2, celi2, cni2, addcni2, nbddi2m, nconld_l, ixtg6, numeltg6_l, nnmv_l, nnmvc_l, nskyll_l, nnlink, lllink, nskyrbm_l, dd_rbm2, ibvel, lbvel, nbi18_l, nskyi18_l, len_ia, nconv_l, ibcv, nskyrbe3_l, irbe3, lrbe3, nskyrbmk_l, irbym, lcrbym, front_rm, dd_rbym2, ibcr, nradia_l, addcne_pxfem, cne_pxfem, cel_pxfem, lcnepxfem_l, inod_pxfem, iel_pxfem, numelcpxfem_l, numnodpxfem_l, lloadp, iloadp, llloadp_l, addcne_crkxfem, cne_crkxfem, cel_crkxfem, lcnecrkxfem_l, inod_crkxfem, iel_crkxfem, numelccrkxfe_l, numnodcrkxfe_l, numeltgcrkxfe_l, cep_crkxfem, inod_crk_l, crknodiad, intbuf_tab, numelig3d_l, kxig3d, ixig3d, ibfflux, nfxflux_l, cepcnd, celcnd, addcncnd, cncnd, ns10e_l, icnds10, lcncnd_l, itagnd, igrsurf, igrsurf_proc, local_nebcs, ebcs_tab_loc_2, number_load_cyl, loads, loads_per_proc, glob_therm)

Function/Subroutine Documentation

◆ w_pon()

subroutine w_pon ( integer, dimension(0:numnod+1) addcne,
integer, dimension(*) cne,
integer lcne,
integer numnod_l,
integer, dimension(*) nodglob,
integer lcne_l,
integer, dimension(*) cep,
integer, dimension(*) cel,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) monvol,
integer, dimension(nibcld,*) ib,
geo,
integer, dimension(npropgi,*) igeo,
integer proc,
integer numels_l,
integer numels8_l,
integer numels10_l,
integer numels16_l,
integer numels20_l,
integer numelq_l,
integer numelc_l,
integer numelt_l,
integer numelp_l,
integer numelr_l,
integer numeltg_l,
integer nskyrw_l,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer nskyrbk_l,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(3,nrbykin) dd_rby2,
integer i2nsnt,
integer i2nsn_l,
integer, dimension(npari,*) ipari,
integer nir,
integer lcni2_l,
integer niskyi2_l,
integer, dimension(*) cepi2,
integer, dimension(*) celi2,
integer, dimension(*) cni2,
integer, dimension(0:numnod+1) addcni2,
integer nbddi2m,
integer nconld_l,
integer, dimension(4,*) ixtg6,
integer numeltg6_l,
integer nnmv_l,
integer nnmvc_l,
integer nskyll_l,
integer, dimension(10,*) nnlink,
integer, dimension(*) lllink,
integer nskyrbm_l,
integer, dimension(3,nibvel) dd_rbm2,
integer, dimension(nbvelp,*) ibvel,
integer, dimension(*) lbvel,
integer nbi18_l,
integer nskyi18_l,
integer len_ia,
integer nconv_l,
integer, dimension(glob_therm%niconv,*) ibcv,
integer nskyrbe3_l,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
integer nskyrbmk_l,
integer, dimension(nirbym,*) irbym,
integer, dimension(*) lcrbym,
integer, dimension(nrbym,*) front_rm,
integer, dimension(3,nrbym) dd_rbym2,
integer, dimension(glob_therm%niradia,*) ibcr,
integer nradia_l,
integer, dimension(0:nplyxfe + 1) addcne_pxfem,
integer, dimension(*) cne_pxfem,
integer, dimension(*) cel_pxfem,
integer lcnepxfem_l,
integer, dimension(*) inod_pxfem,
integer, dimension(*) iel_pxfem,
integer numelcpxfem_l,
integer numnodpxfem_l,
integer, dimension(*) lloadp,
integer, dimension(sizloadp,*) iloadp,
integer llloadp_l,
integer, dimension(0:ncrkxfe+1) addcne_crkxfem,
integer, dimension(*) cne_crkxfem,
integer, dimension(*) cel_crkxfem,
integer lcnecrkxfem_l,
integer, dimension(*) inod_crkxfem,
integer, dimension(*) iel_crkxfem,
integer numelccrkxfe_l,
integer numnodcrkxfe_l,
integer numeltgcrkxfe_l,
integer, dimension(*) cep_crkxfem,
integer, dimension(*) inod_crk_l,
integer, dimension(*) crknodiad,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer numelig3d_l,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(*) ixig3d,
integer, dimension(glob_therm%nitflux,*) ibfflux,
integer nfxflux_l,
integer, dimension(*) cepcnd,
integer, dimension(*) celcnd,
integer, dimension(0:*) addcncnd,
integer, dimension(*) cncnd,
integer ns10e_l,
integer, dimension(3,*) icnds10,
integer lcncnd_l,
integer, dimension(*) itagnd,
type (surf_), dimension(nsurf) igrsurf,
type(surf_), dimension(nsurf,nspmd), intent(in) igrsurf_proc,
integer, intent(in) local_nebcs,
type(t_ebcs_tab), intent(inout) ebcs_tab_loc_2,
integer, intent(in) number_load_cyl,
type(loads_), intent(in) loads,
type(loads_), intent(inout) loads_per_proc,
type (glob_therm_), intent(in) glob_therm )

Definition at line 32 of file w_pon.F.

60C-----------------------------------------------
61C M o d u l e s
62C-----------------------------------------------
63 USE intbufdef_mod
64 USE groupdef_mod
65 USE ebcs_mod
66 USE loads_mod
67 use glob_therm_mod
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72#include "tabsiz_c.inc"
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76#include "com01_c.inc"
77#include "com04_c.inc"
78#include "param_c.inc"
79#include "com_xfem1.inc"
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83 type (glob_therm_) ,intent(in) :: glob_therm
84 INTEGER LCNE, NUMNOD_L, LCNE_L, PROC, I2NSNT, I2NSN_L, NIR,
85 . LCNI2_L, NISKYI2_L, NBDDI2M, NSKYLL_L, NBI18_L,NSKYI18_L,
86 . NUMELS_L ,NUMELS8_L ,NUMELS10_L,NUMELS16_L,NUMELS20_L,
87 . NUMELC_L ,NUMELT_L ,NUMELP_L ,NUMELR_L ,NUMELTG_L,
88 . NUMELQ_L , NSKYRW_L, NSKYRBK_L, NCONLD_L,
89 . NUMELTG6_L, NNMV_L, NNMVC_L, NSKYRBM_L,
90 . ADDCNE(0:NUMNOD+1), CNE(*), NODGLOB(*), CEP(*), CEL(*),
91 . IXS(NIXS,*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
92 . IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),
93 . IXR(NIXR,*),IXTG(NIXTG,*),IXTG6(4,*),
94 . IB(NIBCLD,*),MONVOL(*), NPRW(*),
95 . LPRW(*), NPBY(NNPBY,*), LPBY(*),
96 . DD_RBY2(3,NRBYKIN), IPARI(NPARI,*),
97 . CEPI2(*), CELI2(*), CNI2(*), ADDCNI2(0:NUMNOD+1),
98 . NNLINK(10,*), LLLINK(*),
99 . DD_RBM2(3,NIBVEL), IBVEL(NBVELP,*), LBVEL(*),LEN_IA,
100 . NCONV_L ,IBCV(GLOB_THERM%NICONV,*),NSKYRBE3_L,
101 . IRBE3(NRBE3L,*),LRBE3(*),NSKYRBMK_L,
102 . IRBYM(NIRBYM,*) , LCRBYM(*) ,FRONT_RM(NRBYM,*),
103 . DD_RBYM2(3,NRBYM), IBCR(GLOB_THERM%NIRADIA,*), NRADIA_L,
104 . CNE_PXFEM(*),ADDCNE_PXFEM(0:NPLYXFE + 1),CEL_PXFEM(*),
105 . NUMELCPXFEM_L,NUMNODPXFEM_L,INOD_PXFEM(*),IEL_PXFEM(*),
106 . LCNEPXFEM_L,LLOADP(*),ILOADP(SIZLOADP,*),LLLOADP_L,
107 . CNE_CRKXFEM(*),ADDCNE_CRKXFEM(0:NCRKXFE+1),
108 . CEL_CRKXFEM(*),NUMELCCRKXFE_L,NUMNODCRKXFE_L,
109 . INOD_CRKXFEM(*),IEL_CRKXFEM(*),LCNECRKXFEM_L,
110 . NUMELTGCRKXFE_L,CEP_CRKXFEM(*),INOD_CRK_L(*),
111 . CRKNODIAD(*),NUMELIG3D_L,KXIG3D(NIXIG3D,*),IXIG3D(*),
112 . CEPCND(*),CELCND(*),ADDCNCND(0:*),CNCND(*),NS10E_L,ICNDS10(3,*),
113 . LCNCND_L,ITAGND(*),IGEO(NPROPGI,*)
114 INTEGER NFXFLUX_L,IBFFLUX(GLOB_THERM%NITFLUX,*)
115 my_real
116 . geo(npropg,*)
117 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
118 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
119! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
120 TYPE(SURF_), DIMENSION(NSURF,NSPMD), INTENT(IN) :: IGRSURF_PROC
121! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
122! IGRSURF_PROC : SURF_ ; dimension=NSURF*NSPMD
123! local surface property array (=IGRSURF for each proc)
124! %ELTYP --> type of element (shell, triangle...)
125! %ELEM --> element id
126! %NSEG --> total element number
127! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
128 INTEGER, INTENT(IN) :: LOCAL_NEBCS ! number of parallelized ebcs
129 TYPE(T_EBCS_TAB), INTENT(INOUT) :: EBCS_TAB_LOC_2 ! ebcs structure
130 ! load option
131 INTEGER, INTENT(IN) :: NUMBER_LOAD_CYL ! sum of load segment number
132 TYPE(LOADS_),INTENT(IN) :: LOADS ! initial structure of load cyl
133 TYPE(LOADS_), INTENT(INOUT) :: LOADS_PER_PROC ! structure of load cyl for for the current proc P
134C-----------------------------------------------
135C E x t e r n a l F u n c t i o n s
136C-----------------------------------------------
137 INTEGER NLOCAL
138 EXTERNAL nlocal
139C-----------------------------------------------
140C L o c a l V a r i a b l e s
141C-----------------------------------------------
142 INTEGER N, I, PROC_L, CC, CC_L, N1, N2, N3, N4,
143 . K, K0, K1, K6, NV, KN, JJ, INACTI,NG,NUMG0,
144 . IS,NN,IAD,J,ITY,CLOAD,NUML,NUMG, II, MAIN,J_L,IPVENT,
145 . NSL, NSL_L, KK, P,K_ L, MSR, PMAIN, NTY, NRTS,NL_L,N0,
146 . NRTM, NSN, NMN, K10, K11, K12, K13, K14, L, NSN_L, OFFTG,
147 . OFFC,ITYP,NVENT,IV,IADHOL,KIBHOL,KIBJET,K2,NNC,KAD,NAV,J0,
148 . NRTM_FE, NRTS_FE, N_L
149 INTEGER :: IDEBRBK(NSPMD)
150 INTEGER :: PROCNE_PXFEM(LCNEPXFEM_L)
151 INTEGER :: IADC_PXFEM(4,NUMELCPXFEM_L)
152 INTEGER :: ADDCNEPXFEM_L(NUMNODPXFEM_L+1)
153 INTEGER :: PROCNE_CRKXFEM(LCNECRKXFEM_L)
154 INTEGER :: ADDCNECRKXFEM_L(NUMNODCRKXFE_L+1)
155 INTEGER :: IADC_CRKXFEM(4,NUMELCCRKXFE_L)
156 INTEGER :: CNE_CRKXFEM_L(LCNECRKXFEM_L)
157 INTEGER :: IADTG_CRKXFEM(3,NUMELTGCRKXFE_L)
158 INTEGER :: CEL_CRKXFEM_L(LCNECRKXFEM_L)
159 INTEGER :: CRKNODIAD_L(LCNECRKXFEM_L)
160
161 INTEGER, ALLOCATABLE :: PROCNE(:)
162 INTEGER, ALLOCATABLE :: ITAGIB(:)
163 INTEGER, ALLOCATABLE :: IADMV(:,:)
164 INTEGER, ALLOCATABLE :: IADMV2(:)
165 INTEGER, ALLOCATABLE :: IADMV3(:)
166 INTEGER, ALLOCATABLE :: IADWAL(:)
167 INTEGER, ALLOCATABLE :: IADRBK(:)
168 INTEGER, ALLOCATABLE :: IADI2(:,:)
169 INTEGER, ALLOCATABLE :: I2TMP(:,:)
170 INTEGER, ALLOCATABLE :: IADLL(:)
171 INTEGER, ALLOCATABLE :: PROCNI2(:)
172 INTEGER, ALLOCATABLE :: IADRBM(:)
173 INTEGER, ALLOCATABLE :: IADI18(:)
174 INTEGER, ALLOCATABLE :: IADIBCV(:,:)
175 INTEGER, ALLOCATABLE :: IADIBFX(:,:)
176 INTEGER, ALLOCATABLE :: IADRBMK(:)
177 INTEGER, ALLOCATABLE :: IADIBCR(:,:)
178 INTEGER, ALLOCATABLE :: ITAGLOADP(:)
179 INTEGER, ALLOCATABLE :: IADLOAD(:,:)
180 INTEGER, ALLOCATABLE :: ICNDTMP(:,:)
181 INTEGER, ALLOCATABLE :: PROCNCND(:)
182 INTEGER, ALLOCATABLE :: IADCND(:,:)
183
184
185 INTEGER IUN,EMPL,COORD,SHFT,TESTVAL,KD(50),KFI
186 INTEGER, DIMENSION(:), ALLOCATABLE :: SOLTAG,SOL10TAG,
187 . SOL20TAG,SOL16TAG,QUADTAG,SHTAG,TTAG,PTAG,RTAG,TGTAG,TG6TAG,
188 . IBTAG,IBCVTAG,IBCRTAG,IBFXTAG,ILTAG,TAGIG3D
189 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGC, ITAGTG,ADDCNE_L,ADDCNI2_L,
190 . ADDCNCND_L
191 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IADS,IADS10,
192 . IADS16,IADS20,IADQ,IADC,IADT,
193 . IADP,IADR,IADTG,IADIB,
194 . IADTG1,IADIG3D
195 TYPE(ebcs_parith_on), DIMENSION(:), ALLOCATABLE :: EBCS_PARITHON_L ! adress for the fsky array for parith/on
196 LOGICAL, DIMENSION(:), ALLOCATABLE :: EBCS_TAG ! boolean : true if the element belongs to an ebcs
197 INTEGER :: LOCAL_NODE_ID,ELEM_ID,NUMG_SAVE
198
199 ! loads option
200 INTEGER :: GLOBAL_SEGMENT_ID ! global segment id
201 INTEGER :: LOCAL_PROC_ID ! processor id where the segment is defined
202 INTEGER :: LOCAL_SEGMENT_ID ! local segment id (local to the proc LOCAL_PROC_ID)
203 INTEGER :: GLOBAL_LOAD_ID,LOCAL_LOAD_ID ! load id (global and local to proc LOCAL_PROC_ID)
204C-----------------------------------------------
205
206 ALLOCATE(procne(lcne_l))
207 ALLOCATE(itagib(nconld))
208 ALLOCATE(iadmv(4, nnmv_l))
209 ALLOCATE(iadmv2(nnmv_l))
210 ALLOCATE(iadmv3(nnmvc_l))
211 ALLOCATE(iadwal(nskyrw_l))
212 ALLOCATE(iadrbk(nskyrbk_l))
213 ALLOCATE(iadi2(nir, i2nsn_l))
214 ALLOCATE(i2tmp(nir, i2nsn_l))
215 ALLOCATE(iadll(nskyll_l))
216 ALLOCATE(procni2(lcni2_l))
217 ALLOCATE(iadrbm(nskyrbm_l))
218 ALLOCATE(iadi18(nskyi18_l))
219 ALLOCATE(iadibcv(4, nconv_l))
220 ALLOCATE(iadibfx(4, nfxflux_l))
221 ALLOCATE(iadrbmk(nskyrbmk_l))
222 ALLOCATE(iadibcr(4, nradia_l))
223 ALLOCATE(itagloadp(slloadp))
224 ALLOCATE(iadload(4, llloadp_l))
225 ALLOCATE(icndtmp(3, ns10e_l))
226 ALLOCATE(procncnd(lcncnd_l))
227 ALLOCATE(iadcnd(2, ns10e_l))
228
229 iun = 1
230 ALLOCATE(soltag(numels))
231 soltag(1:numels)=0
232
233 ALLOCATE(sol10tag(numels10))
234 sol10tag(1:numels10)=0
235
236 ALLOCATE(sol20tag(numels20))
237 sol20tag(1:numels20)=0
238
239 ALLOCATE(sol16tag(numels16))
240 sol16tag(1:numels16)=0
241
242 ALLOCATE(quadtag(numelq))
243 quadtag(1:numelq)=0
244
245 ALLOCATE(shtag(numelc))
246 shtag(1:numelc)=0
247
248 ALLOCATE(ttag(numelt))
249 ttag(1:numelt)=0
250
251 ALLOCATE(ptag(numelp))
252 ptag(1:numelp)=0
253
254 ALLOCATE(rtag(numelr))
255 rtag(1:numelr)=0
256
257 ALLOCATE(tgtag(numeltg))
258 tgtag(1:numeltg)=0
259
260 ALLOCATE(tg6tag(numeltg6))
261 tg6tag(1:numeltg6)=0
262
263 ALLOCATE(ibtag(nconld))
264 ibtag(1:nconld)=0
265
266 ALLOCATE(ibcvtag(glob_therm%NUMCONV))
267 ibcvtag(1:glob_therm%NUMCONV)=0
268
269 ALLOCATE(ibcrtag(glob_therm%NUMRADIA))
270 ibcrtag(1:glob_therm%NUMRADIA)=0
271
272 ALLOCATE(ibfxtag(glob_therm%NFXFLUX))
273 ibfxtag(1:glob_therm%NFXFLUX)=0
274
275 ALLOCATE(iltag(slloadp/4))
276 iltag(1:slloadp/4)=0
277
278 ALLOCATE(tagig3d(numelig3d))
279 tagig3d(1:numelig3d)=0
280! ------------------------------
281! allocate 1d arrays
282 ALLOCATE( itagc(numelc),itagtg(numeltg) )
283 ALLOCATE( addcne_l(numnod_l+1),addcni2_l(numnod_l+1))
284 addcne_l(1:numnod_l + 1) = 0
285 ALLOCATE( addcncnd_l(numnod_l+1))
286! IAD 2D arrays
287 ALLOCATE( iads(8,numels_l),iads10(6,numels10_l) )
288 ALLOCATE( iads16(8,numels16_l),iads20(12,numels20_l) )
289 ALLOCATE( iadq(4,numelq_l),iadc(4,numelc_l) )
290 ALLOCATE( iadt(2,numelt_l),iadp(2,numelp_l) )
291 ALLOCATE( iadr(3,numelr_l),iadtg(3,numeltg_l) )
292 iadr(1:3,1:numelr_l) = 0
293 iadtg(1:3,1:numeltg_l) = 0
294 ALLOCATE(iadib(4,nconld_l) )
295 if(nconld_l >0) iadib(1:4,1:nconld_l) = -huge(i)
296 ALLOCATE( iadtg1(3,numeltg6_l),iadig3d(100,numelig3d_l) )
297! ------------------------------
298
299C-----------------------------------------------
300C
301C Pre-traitement ploads
302C
303 cload = 0
304 DO i = 1, nconld
305 IF(ib(4,i)==-1)THEN
306 itagib(i) = 1
307 cload = 1
308 ELSE
309 itagib(i) = 0
310 ENDIF
311 ENDDO
312C Pre-traitement loads
313C
314 k=0
315 DO i = 1, nloadp
316 DO j=1,iloadp(1,i)/4
317 k = k+1
318 itagloadp(k) = 0
319 ENDDO
320 ENDDO
321C
322C Pre-traitement mv
323C
324 IF (nvolu>0) THEN
325 DO i = 1, numelc
326 itagc(i) = 0
327 ENDDO
328 DO i = 1, numeltg
329 itagtg(i) = 0
330 ENDDO
331C
332 k0 = 0
333 k1 = 1
334 k2 = 1 + nimv*nvolu
335 kibjet = k2 + licbag
336 kibhol = kibjet + libagjet
337 k6 = 0
338 offc = numels+numelq
339 offtg =numels+numelq+ numelc+numelt+numelp+numelr
340 j_l = 0
341 DO n = 1, nvolu
342 ityp = monvol(k1+1)
343 is = monvol(k1+3)
344 nav = monvol(k1+2)
345 nvent = monvol(k1+10)
346 nn = igrsurf(is)%NSEG
347 iadhol= kibhol+monvol(k1+11)
348 j0 = j_l
349 DO j = 1, nn
350 ity = igrsurf(is)%ELTYP(j)
351 i = igrsurf(is)%ELEM(j)
352 IF (ity==3) THEN
353 itagc(i) = 1
354 IF(cep(i+offc)==proc-1) THEN
355 j_l = j_l + 1
356 iadmv2(j_l) = j
357C sauvegarde du no local J correspondant a I
358 itagc(i) = j_l - j0
359 END IF
360 ELSEIF (ity==7) THEN
361 itagtg(i) = 1
362 IF(cep(i+offtg)==proc-1) THEN
363 j_l = j_l + 1
364 iadmv2(j_l) = j
365C sauvegarde du no local J correspondant a I
366 itagtg(i) = j_l - j0
367 END IF
368 ELSE
369 ENDIF
370 ENDDO
371C
372C Traitement vent hole et volume communicant
373C
374 IF(ityp==3.OR.ityp==4.OR.ityp==5.OR.ityp==7.OR.ityp==9) THEN
375 DO iv = 1, nvent
376 ipvent = monvol(iadhol+nibhol*(iv-1)+2-1)
377 IF(ipvent/=0) THEN
378 nnc=igrsurf(ipvent)%NSEG
379 DO j = 1, nnc
380 ity = igrsurf(ipvent)%ELTYP(j)
381 i = igrsurf(ipvent)%ELEM(j)
382 IF (ity==3) THEN
383 IF(cep(i+offc)==proc-1) THEN
384 k0 = k0 + 1
385C restitution du no local J (surface) correspondant a I
386 iadmv3(k0) = itagc(i)
387 END IF
388 ELSEIF (ity==7) THEN
389 IF(cep(i+offtg)==proc-1) THEN
390 k0 = k0 + 1
391C restitution du no local J (surface) correspondant a I
392 iadmv3(k0) = itagtg(i)
393 END IF
394 END IF
395 END DO
396 END IF
397 END DO
398 END IF
399 IF(ityp==4.OR.ityp==5.OR.ityp==7.OR.ityp==9)THEN
400 DO iv = 1, nav
401 ipvent = monvol(k2+nicbag*(iv-1)+2-1)
402 IF(ipvent/=0) THEN
403 nnc=igrsurf(ipvent)%NSEG
404 DO j = 1, nnc
405 ity = igrsurf(ipvent)%ELTYP(j)
406 i = igrsurf(ipvent)%ELEM(j)
407 IF (ity==3) THEN
408 IF(cep(i+offc)==proc-1) THEN
409 k0 = k0 + 1
410C restitution du no local J (surface) correspondant a I
411 iadmv3(k0) = itagc(i)
412 END IF
413 ELSEIF (ity==7) THEN
414 IF(cep(i+offtg)==proc-1) THEN
415 k0 = k0 + 1
416C restitution du no local J (surface) correspondant a I
417 iadmv3(k0) = itagtg(i)
418 END IF
419 END IF
420 END DO
421 END IF
422 END DO
423 END IF
424 k1 = k1 + nimv
425 k2 = k2 + nicbag * nav
426 k6 = k6 + nn
427 ENDDO
428 ENDIF
429C
430 DO k = 1, 4
431 DO i = 1, nnmv_l
432 iadmv(k,i) = 0
433 END DO
434 END DO
435C
436C Elts penta
437C
438 IF(numeltg6_l>0)THEN
439 DO i = 1, numeltg6_l
440 DO k = 1,3
441 iadtg1(k,i)=0
442 ENDDO
443 ENDDO
444 ENDIF
445
446 ! --------------------------
447 ! tag the element belonging to an ebcs
448 ALLOCATE( ebcs_tag(numels+numelq+numeltg) )
449 ebcs_tag(1:numels+numelq+numeltg) = .false.
450 ALLOCATE(ebcs_parithon_l(local_nebcs))
451 IF(local_nebcs>0) THEN
452 ! ---------------------
453 ! loop over the /EBCS
454 DO i=1,local_nebcs
455 ! allocation of adress array
456 ALLOCATE( ebcs_parithon_l(i)%ELEM_ADRESS(4,ebcs_tab_loc_2%tab(i)%poly%nb_elem) )
457 ebcs_parithon_l(i)%ELEM_ADRESS(1:4,1:ebcs_tab_loc_2%tab(i)%poly%nb_elem) = 0
458 ! check if a surface is associated to the ebcs
459 IF(ebcs_tab_loc_2%tab(i)%poly%surf_id>0) THEN
460 ! ---------------------
461 ! loop over the element of the surface to tag the element
462 DO j=1,ebcs_tab_loc_2%tab(i)%poly%nb_elem
463 elem_id = ebcs_tab_loc_2%tab(i)%poly%global_ielem(j)
464 IF(n2d/=0) THEN
465 IF(elem_id>numels+numelq) THEN
466 elem_id = elem_id - (numelc+numelt+numelp+numelr)
467 ENDIF
468 ENDIF
469 ebcs_tag(elem_id) = .true.
470 ENDDO
471 ! ---------------------
472 ENDIF
473 ENDDO
474 ! ---------------------
475 ENDIF
476 ! --------------------------
477C-----------------------------------------------
478C ADDCNE_L et IADS
479C-----------------------------------------------
480C
481C-----------------------------------------------
482C The algorithm has been modified to avoid using the element
483C arrays as markers.
484C INTEGER arrays for every elements types has been introduced
485C Each entry is used as 31 bit array.
486C The access is done with fortran intrinsics ISHIFT
487C Verification with fortran Intrinsics IAND.
488C-----------------------------------------------
489C
490 addcne_l(1) = 1
491 cc_l = 0
492 DO i = 1, numnod_l
493
494 n = nodglob(i)
495 n1 = addcne(n)
496 n2 = addcne(n+1)
497 addcne_l(i+1) = addcne_l(i) + n2-n1
498 DO cc = n1, n2-1
499 numg = cne(cc)
500 numg_save = cne(cc)
501
502 numl = cel(numg)
503 proc_l = cep(numg)+1
504 cc_l = cc_l + 1
505 procne(cc_l) = proc_l
506C
507C Remplissage IADX si elt interne
508C
509 IF (proc==proc_l) THEN
510C proc loc
511 IF (numg<=numels) THEN
512 DO k = 1,8
513 shft = ishft(iun,k-1)
514 testval = iand(soltag(numg),shft)
515 IF (ixs(k+1,numg)==n.AND.testval==0) THEN
516 iads(k,numl) = cc_l
517 soltag(numg)=soltag(numg)+shft
518 GOTO 100
519 ENDIF
520 ENDDO
521C
522 IF(numels10>0.AND.numg>numels8.AND.
523 + numg<=numels8+numels10) THEN
524 numg=numg-numels8
525 DO k=1,6
526 shft = ishft(iun,k-1)
527 testval = iand(sol10tag(numg),shft)
528 IF (ixs10(k,numg)==n.AND.testval==0) THEN
529 iads10(k,numl-numels8_l) = cc_l
530 sol10tag(numg)=sol10tag(numg)+shft
531 GOTO 100
532 ENDIF
533 ENDDO
534 ELSEIF(numels20>0.AND.numg>numels8+numels10.AND.
535 + numg<=numels8+numels10+numels20)THEN
536 numg=numg-numels8-numels10
537 DO k=1,12
538 shft = ishft(iun,k-1)
539 testval = iand(sol20tag(numg),shft)
540 IF (ixs20(k,numg)==n.AND.testval==0 ) THEN
541 iads20(k,numl-numels8_l-numels10_l) = cc_l
542 sol20tag(numg)=sol20tag(numg)+shft
543 GOTO 100
544 ENDIF
545 ENDDO
546 ELSEIF(numels16>0.AND.
547 + numg>numels8+numels10+numels20)THEN
548 numg=numg-numels8-numels10-numels20
549 DO k=1,8
550 shft = ishft(iun,k-1)
551 testval =iand(sol16tag(numg),shft)
552 IF (ixs16(k,numg)==n.AND.testval==0 ) THEN
553 iads16(k,numl-numels8_l-numels10_l-numels20_l) = cc_l
554 sol16tag(numg)=sol16tag(numg)+shft
555 GOTO 100
556 ENDIF
557 ENDDO
558 ENDIF
559
560 ! --------------------
561 ! element belongs to an ebcs
562 IF(ebcs_tag(numg_save)) THEN
563 DO ii=1,local_nebcs
564 ! check if a surface is associated to the ebcs
565 IF(ebcs_tab_loc_2%tab(ii)%poly%surf_id>0) THEN
566 ! -------------
567 ! loop over the element of the surface
568 DO j=1,ebcs_tab_loc_2%tab(ii)%poly%nb_elem
569 elem_id = ebcs_tab_loc_2%tab(ii)%poly%global_ielem(j) ! global element id
570 ! -------------
571 ! find the location of the node :
572 ! 4 nodes for a solid
573 ! 1 2
574 ! o-----o
575 ! | |
576 ! o-----o
577 ! 4 3
578 IF(elem_id==numg_save) THEN
579 DO k=1,4
580 local_node_id = ebcs_tab_loc_2%tab(ii)%poly%elem_list(k,j)
581 local_node_id = ebcs_tab_loc_2%tab(ii)%poly%node_list(local_node_id)
582 IF(n==nodglob(local_node_id)) THEN
583 IF(ebcs_parithon_l(ii)%ELEM_ADRESS(k,j)==0) THEN
584 ebcs_parithon_l(ii)%ELEM_ADRESS(k,j) = cc_l
585 GOTO 100
586 ENDIF
587 ENDIF
588 ENDDO
589 ENDIF
590 ! -------------
591 ENDDO
592 ! -------------
593 ENDIF
594 ENDDO
595 ENDIF
596
597 ! --------------------
598C
599 ELSEIF(numg<=numels+numelq) THEN
600 DO k=1,4
601 shft = ishft(iun,k-1)
602 testval =iand(quadtag(numg),shft)
603 IF (ixq(k+1,numg)==n.AND.testval==0) THEN
604 iadq(k,numl) = cc_l
605 quadtag(numg)=quadtag(numg)+shft
606 GOTO 100
607 ENDIF
608 ENDDO
609 ! --------------------
610 ! element belongs to an ebcs
611 IF(ebcs_tag(numg_save)) THEN
612 DO ii=1,local_nebcs
613 ! check if a surface is associated to the ebcs
614 IF(ebcs_tab_loc_2%tab(ii)%poly%surf_id>0) THEN
615 ! -------------
616 ! loop over the element of the surface
617 DO j=1,ebcs_tab_loc_2%tab(ii)%poly%nb_elem
618 elem_id = ebcs_tab_loc_2%tab(ii)%poly%global_ielem(j) ! global element id
619 ! -------------
620 ! find the location of the node for a quad :
621 ! only 2 nodes for the surface (2D case)
622 ! 1 2
623 ! o-----o
624 ! | |
625 ! o-----o
626 ! 4 3
627 IF(elem_id==numg_save) THEN
628 DO k=1,2
629 local_node_id = ebcs_tab_loc_2%tab(ii)%poly%elem_list(k,j)
630 local_node_id = ebcs_tab_loc_2%tab(ii)%poly%node_list(local_node_id)
631 IF(n==nodglob(local_node_id)) THEN
632 IF(ebcs_parithon_l(ii)%ELEM_ADRESS(k,j)==0) THEN
633 ebcs_parithon_l(ii)%ELEM_ADRESS(k,j) = cc_l
634 GOTO 100
635 ENDIF
636 ENDIF
637 ENDDO
638 ENDIF
639 ! -------------
640 ENDDO
641 ! -------------
642 ENDIF
643 ENDDO
644 ENDIF
645 ! --------------------
646
647 ELSEIF(numg<=numels+numelq+numelc) THEN
648 numg = numg - (numels+numelq)
649 DO k=1,4
650 shft = ishft(iun,k-1)
651 testval =iand(shtag(numg),shft)
652 IF (ixc(k+1,numg)==n.AND.testval==0) THEN
653 iadc(k,numl) = cc_l
654 shtag(numg) = shtag(numg)+shft
655 GOTO 100
656 ENDIF
657 ENDDO
658C mv coque
659 IF (nvolu>0) THEN
660 IF(itagc(numg)>0) THEN
661 k1 = 1
662 k6 = 0
663 DO nv = 1, nvolu
664 is = monvol(k1+3)
665 nn = igrsurf_proc(is,proc)%NSEG
666 jj = 0
667 DO j = 1, nn
668 ity = igrsurf_proc(is,proc)%ELTYP(j)
669 ii = igrsurf_proc(is,proc)%ELEM(j)
670 IF(ity==3) THEN
671 IF(cep(offc+ii)==proc-1) THEN
672 jj = jj+1
673 IF (ii==numg) THEN
674 DO k = 2,5
675 IF(ixc(k,ii)==n.AND.
676 . iadmv(k-1,k6+jj)==0) THEN
677 iadmv(k-1,k6+jj) = cc_l
678 GOTO 100
679 END IF
680 END DO
681 END IF
682 END IF
683 ELSEIF(ity==7)THEN
684 IF(cep(offtg+ii)==proc-1) THEN
685 jj = jj+1
686 END IF
687 END IF
688 END DO
689 k1 = k1 + nimv
690 k6 = k6 + jj
691 ENDDO
692 ENDIF
693 ENDIF
694C
695 ELSEIF(numg<=numels+numelq+numelc+numelt) THEN
696 numg = numg - (numels+numelq+numelc)
697 DO k=1,2
698 shft = ishft(iun,k-1)
699 testval =iand(ttag(numg),shft)
700 IF (ixt(k+1,numg)==n.AND.testval==0) THEN
701 iadt(k,numl) = cc_l
702 ttag(numg)=ttag(numg)+shft
703 GOTO 100
704 ENDIF
705 ENDDO
706 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp) THEN
707 numg = numg - (numels+numelq+numelc+numelt)
708 DO k=1,2
709 shft = ishft(iun,k-1)
710 testval =iand(ptag(numg),shft)
711 IF (ixp(k+1,numg)==n.AND.testval==0) THEN
712 iadp(k,numl) = cc_l
713 ptag(numg)=ptag(numg)+shft
714 GOTO 100
715 ENDIF
716 ENDDO
717 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
718 . numelr) THEN
719 numg = numg - (numels+numelq+numelc+numelt+numelp)
720 DO k=1,2
721 shft = ishft(iun,k-1)
722 testval =iand(rtag(numg),shft)
723 IF (ixr(k+1,numg)==n.AND.testval==0) THEN
724 iadr(k,numl) = cc_l
725 rtag(numg)=rtag(numg)+shft
726 GOTO 100
727 ENDIF
728 ENDDO
729 IF(igeo(11,ixr(1,numg))==12) THEN
730 shft = ishft(iun,3)
731 testval =iand(rtag(numg),shft)
732 IF (ixr(4,numg)==n.AND.testval==0) THEN
733 iadr(3,numl) = cc_l
734 rtag(numg)=rtag(numg)+shft
735 GOTO 100
736 ENDIF
737 ENDIF
738 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
739 . numelr+numeltg) THEN
740 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr)
741 DO k=1,3
742 shft = ishft(iun,k-1)
743 testval =iand(tgtag(numg),shft)
744 IF (ixtg(k+1,numg)==n.AND.testval==0) THEN
745 iadtg(k,numl) = cc_l
746 tgtag(numg)=tgtag(numg)+shft
747 GOTO 100
748 ENDIF
749 ENDDO
750C
751 IF(numeltg6>0.AND.
752 . numg>numels+numelq+numelc+numelt+numelp+
753 . numelr+numeltg-numeltg6.AND.
754 . numg<=numels+numelq+numelc+numelt+numelp+
755 . numelr+numeltg)THEN
756 numg=numg-numeltg+numeltg6
757 DO k=1,3
758 shft = ishft(iun,k-1)
759 testval =iand(tg6tag(numg),shft)
760 IF (ixtg6(k,numg)==n.AND.testval==0) THEN
761 iadtg1(k,numl-numeltg_l+numeltg6_l) = cc_l
762 tg6tag(numg)=tg6tag(numg)+shft
763 GOTO 100
764 ENDIF
765 ENDDO
766 ENDIF
767C
768C mv coque triangle
769 IF (nvolu>0) THEN
770 IF(itagtg(numg)>0) THEN
771 k1 = 1
772 k6 = 0
773 DO nv = 1, nvolu
774 is = monvol(k1+3)
775 nn = igrsurf_proc(is,proc)%NSEG
776 jj = 0
777 DO j = 1, nn
778 ity = igrsurf_proc(is,proc)%ELTYP(j)
779 ii = igrsurf_proc(is,proc)%ELEM(j)
780 IF(ity==7) THEN
781 IF(cep(offtg+ii)==proc-1) THEN
782 jj = jj+1
783 IF (ii==numg) THEN
784 DO k = 2,4
785 IF(ixtg(k,ii)==n.AND.
786 . iadmv(k-1,k6+jj)==0) THEN
787 iadmv(k-1,k6+jj) = cc_l
788 GOTO 100
789 END IF
790 END DO
791 END IF
792 END IF
793 ELSEIF(ity==3) THEN
794 IF(cep(offc+ii)==proc-1) THEN
795 jj = jj+1
796 END IF
797 END IF
798 END DO
799 k1 = k1 + nimv
800 k6 = k6 + jj
801 ENDDO
802 ENDIF
803 ENDIF
804
805 ! --------------------
806 ! element belongs to an ebcs
807 IF(ebcs_tag(numg_save-(numelc+numelt+numelp+numelr))) THEN
808 DO ii=1,local_nebcs
809 ! check if a surface is associated to the ebcs
810 IF(ebcs_tab_loc_2%tab(ii)%poly%surf_id>0) THEN
811 ! -------------
812 ! loop over the element of the surface
813 DO j=1,ebcs_tab_loc_2%tab(ii)%poly%nb_elem
814 elem_id = ebcs_tab_loc_2%tab(ii)%poly%global_ielem(j) ! global element id
815 ! -------------
816 ! find the location of the node for a triangle :
817 ! only 2 nodes for the surface (2D case)
818 ! 1
819 ! o
820 ! / \
821 ! / \
822 ! o-----o
823 ! 3 2
824 IF(elem_id==numg_save) THEN
825 DO k=1,2
826 local_node_id = ebcs_tab_loc_2%tab(ii)%poly%elem_list(k,j)
827 IF(local_node_id>0) THEN
828 IF(n==nodglob(local_node_id)) THEN
829 IF(ebcs_parithon_l(ii)%ELEM_ADRESS(k,j)==0) THEN
830 ebcs_parithon_l(ii)%ELEM_ADRESS(k,j) = cc_l
831 GOTO 100
832 ENDIF
833 ENDIF
834 ENDIF
835 ENDDO
836 ENDIF
837 ! -------------
838 ENDDO
839 ! -------------
840 ENDIF
841 ENDDO
842 ENDIF
843 ! --------------------
844C
845 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
846 . numelr+numeltg+numelx+nconld)THEN
847 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr+
848 + numeltg+numelx)
849 IF(itagib(numg)==0.AND.n2d==0)THEN
850 kn = 4
851 ELSEIF(itagib(numg)==0.AND.n2d/=0)THEN
852 kn = 2
853 ELSE
854 kn = 1
855 ENDIF
856 DO k=1,kn
857 shft = ishft(iun,k-1)
858 testval =iand(ibtag(numg),shft)
859 IF (ib(k,numg)==n.AND.testval==0) THEN
860 iadib(k,numl) = cc_l
861 ibtag(numg)=ibtag(numg)+shft
862 GOTO 100
863 ELSE
864 ENDIF
865 ENDDO
866C
867 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
868 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV)THEN
869 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr+
870 + numeltg+numelx+nconld)
871 IF(n2d==0)THEN
872 kn = 4
873 ELSEIF(n2d/=0)THEN
874 kn = 2
875 ELSE
876 kn = 1
877 ENDIF
878 DO k=1,kn
879 shft = ishft(iun,k-1)
880 testval =iand(ibcvtag(numg),shft)
881 IF (ibcv(k,numg)==n.AND.testval==0) THEN
882 iadibcv(k,numl) = cc_l
883 ibcvtag(numg)=ibcvtag(numg)+shft
884 GOTO 100
885 ELSE
886 ENDIF
887 ENDDO
888C
889 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
890 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV +
891 . glob_therm%NUMRADIA)THEN
892 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr+
893 + numeltg+numelx+nconld+glob_therm%NUMCONV)
894 IF(n2d==0)THEN
895 kn = 4
896 ELSEIF(n2d/=0)THEN
897 kn = 2
898 ELSE
899 kn = 1
900 ENDIF
901 DO k=1,kn
902 shft = ishft(iun,k-1)
903 testval =iand(ibcrtag(numg),shft)
904 IF (ibcr(k,numg)==n.AND.testval==0) THEN
905 iadibcr(k,numl) = cc_l
906 ibcrtag(numg)= ibcrtag(numg)+shft
907 GOTO 100
908 ELSE
909 ENDIF
910 ENDDO
911C
912 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
913 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV +
914 . glob_therm%NUMRADIA+glob_therm%NFXFLUX)THEN
915 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr+
916 + numeltg+numelx+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA)
917 IF(n2d==0)THEN
918 kn = 4
919 ELSEIF(n2d/=0)THEN
920 kn = 2
921 ELSE
922 kn = 1
923 ENDIF
924 DO k=1,kn
925 shft = ishft(iun,k-1)
926 testval =iand(ibfxtag(numg),shft)
927 IF (ibfflux(k,numg)==n.AND.testval==0) THEN
928 iadibfx(k,numl) = cc_l
929 ibfxtag(numg)= ibfxtag(numg)+shft
930 GOTO 100
931 ELSE
932 ENDIF
933 ENDDO
934C
935 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
936 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV +
937 . glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp/4)THEN
938 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr+
939 . numeltg+numelx+nconld+glob_therm%NUMCONV+
940 . glob_therm%NUMRADIA+glob_therm%NFXFLUX)
941 IF(itagloadp(numg)==0.AND.n2d==0)THEN
942 kn = 4
943 ELSEIF(itagloadp(numg)==0.AND.n2d/=0)THEN
944 kn = 2
945 ELSE
946 kn = 1
947 ENDIF
948 DO k=1,kn
949 shft = ishft(iun,k-1)
950 testval =iand(iltag(numg),shft)
951 IF (lloadp(4*(numg-1)+k)==n.AND.testval==0) THEN
952 iadload(k,numl) = cc_l
953 iltag(numg)=iltag(numg)+shft
954 GOTO 100
955 ELSE
956 ENDIF
957 ENDDO
958C
959 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
960 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV +
961 . glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp/4+numelig3d)THEN
962 numg = numg - (numels+numelq+numelc+numelt+numelp+numelr+
963 . numeltg+numelx+nconld+glob_therm%NUMCONV+
964 . glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp/4)
965 DO k = 1,20
966 shft = ishft(iun,k-1)
967 testval = iand(tagig3d(numg),shft)
968 IF (ixig3d(kxig3d(4,numg)+k-1)==n.AND.testval==0) THEN
969 iadig3d(k,numl) = cc_l
970 tagig3d(numg)=tagig3d(numg)+shft
971 GOTO 100
972 ENDIF
973 ENDDO
974C
975C
976 ELSEIF(numg<=numels+numelq+numelc+numelt+numelp+
977 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV +
978 . glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp/4+numelig3d+number_load_cyl)THEN
979 ! --------------------
980 ! /LOAD/PCYL option
981 ! get the global load segment id
982 global_segment_id = numg - (numels+numelq+numelc+numelt+numelp+
983 . numelr+numeltg+numelx+ nconld + glob_therm%NUMCONV +
984 . glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp/4+numelig3d)
985 local_proc_id = loads%GLOBAL_SEGMENT_ID(global_segment_id,1) ! get the proc id where the segment is defined
986 local_segment_id = loads%GLOBAL_SEGMENT_ID(global_segment_id,2) ! get the local segment id (local to the proc P)
987 global_load_id = loads%GLOBAL_SEGMENT_ID(global_segment_id,3) ! get the global load id
988 local_load_id = loads_per_proc%INDEX_LOAD(global_load_id,2) ! get the local load id
989 ! --------
990 ! loop over the 4 nodes of the surfaces to save the adress
991 DO j=1,4
992 IF(n==loads_per_proc%LOAD_CYL(local_load_id)%SEGNOD(local_segment_id,j)) THEN
993 loads_per_proc%LOAD_CYL(local_load_id)%SEGMENT_ADRESS(j,local_segment_id) = cc_l
994 GO TO 100
995 ENDIF
996 ENDDO
997 ! --------
998 ! --------------------
999 ELSE
1000 print *,'**error assadd2 unknown elem type'
1001 ENDIF
1002 100 CONTINUE
1003 ELSE
1004C proc dist
1005 ENDIF
1006 ENDDO
1007 ENDDO
1008C
1009Cply xfem
1010C
1011C
1012C ADDCNEPXFEM_L et IADC_PXFE
1013C
1014 IF(iplyxfem > 0) THEN
1015 addcnepxfem_l(1) = 1
1016 cc_l = 0
1017 nl_l = 0
1018 DO i = 1, numnod_l
1019
1020 ng =nodglob(i)
1021 n = inod_pxfem(ng)
1022 IF(n > 0 ) THEN
1023 nl_l = nl_l + 1
1024 n1 = addcne_pxfem(n)
1025 n2 = addcne_pxfem(n+1)
1026 addcnepxfem_l(nl_l + 1) = addcnepxfem_l(nl_l) + n2 - n1
1027 DO cc = n1, n2-1
1028 numg0 = cne_pxfem(cc) ! ----> 1:numelc
1029 n0 = iel_pxfem(numg0) !---> 1:el_pxfem
1030 numl = cel_pxfem(n0) ! ----> proc local
1031 numg = numg0 + numels + numelq
1032 proc_l = cep(numg)+1
1033
1034 cc_l = cc_l + 1
1035 procne_pxfem(cc_l) = proc_l
1036C
1037C Remplissage IADX si elt interne
1038C
1039 IF (proc==proc_l) THEN
1040C procloc
1041 IF(numg<=numels+numelq+numelc) THEN
1042 numg = numg - (numels+numelq)
1043 DO k=1,4
1044 shft = ishft(iun,k-1)
1045 testval =iand(shtag(numg),shft)
1046 IF (ixc(k+1,numg)==ng.AND.testval/=0) THEN
1047 iadc_pxfem(k,numl) = cc_l
1048 shtag(numg)=shtag(numg)-shft
1049cc GOTO 100
1050 ENDIF
1051 ENDDO
1052 ENDIF
1053cc 100 CONTINUE
1054C
1055 ENDIF
1056 ENDDO
1057 ENDIF
1058 ENDDO
1059 ENDIF
1060C------------------------------
1061C crack xfem for layered shell
1062C ADDCNECRKXFEM_L et IADC_CRKXFE
1063C------------------------------
1064 IF (icrack3d > 0) THEN
1065 iadc_crkxfem = 0
1066 crknodiad_l = 0
1067 addcnecrkxfem_l(1) = 1
1068 cc_l = 0
1069 nl_l = 0
1070 DO i = 1,numnod_l
1071 ng = nodglob(i)
1072cc N = INOD_CRKXFEM(NG)
1073cc IF(N > 0)THEN
1074 IF (inod_crk_l(i) > 0) THEN
1075 n = inod_crkxfem(ng) ! Num noeud systeme xfem global
1076 n1 = addcne_crkxfem(n) ! adresse global
1077 n2 = addcne_crkxfem(n+1)
1078 ! N2 - N1 = nb d'elements std connectes au noeud N
1079 nl_l = nl_l + 1
1080 addcnecrkxfem_l(nl_l+1) = addcnecrkxfem_l(nl_l) + n2 - n1
1081c
1082 DO cc = n1,n2-1 ! global sky adr
1083 numg0 = cne_crkxfem(cc) ! -> 1:numelc+numeltg (elements systeme std)
1084 n0 = iel_crkxfem(numg0) ! -> 1:el_crkxfem (elements systeme xfem glob)
1085 numl = cel_crkxfem(n0) ! -> proc local (N element xfem local/proc)
1086cc NUMG = NUMG0 + NUMELS + NUMELQ
1087cc PROC_L = CEP(NUMG)+1
1088 proc_l = cep_crkxfem(n0) + 1 ! proc de l'element sys_xfem
1089C
1090 cc_l = cc_l + 1
1091 procne_crkxfem(cc_l) = proc_l
1092C
1093C Remplissage IADX si elt interne
1094C
1095 IF (proc == proc_l) THEN
1096 IF (n0 <= ecrkxfec) THEN
1097 numg = numg0
1098 DO k=1,4
1099 shft = ishft(iun,k-1)
1100 testval = iand(shtag(numg),shft)
1101 IF (ixc(k+1,numg) == ng .AND. testval /= 0) THEN
1102 iadc_crkxfem(k,numl) = cc_l
1103c CNE_CRKXFEM_L(CC_L) = CNE_CRKXFEM(CC) ! contient NUMG0
1104 cne_crkxfem_l(cc_l) = numl ! Num sys xfem local par proc (ELCRK)
1105 crknodiad_l(cc_l) = crknodiad(cc)
1106 shtag(numg) = shtag(numg)-shft
1107 ENDIF
1108 ENDDO
1109 ELSEIF (n0 > ecrkxfec .AND. n0 <= ecrkxfec+ecrkxfetg) THEN
1110 numg = numg0 -numelc
1111 DO k=1,3
1112 shft = ishft(iun,k-1)
1113 testval = iand(tgtag(numg),shft)
1114 IF (ixtg(k+1,numg) == ng .AND. testval /= 0) THEN
1115 iadtg_crkxfem(k,numl) = cc_l
1116c CNE_CRKXFEM_L(CC_L) = CNE_CRKXFEM(CC)
1117 cne_crkxfem_l(cc_l) = numl + numelccrkxfe_l
1118 crknodiad_l(cc_l) = crknodiad(cc)
1119 tgtag(numg)=tgtag(numg)-shft
1120 ENDIF
1121 ENDDO
1122 ENDIF
1123 ENDIF ! PROC==PROC_L
1124 ENDDO ! CC = N1,N2-1
1125 ENDIF ! INOD_CRK_L(I) > 0
1126 ENDDO ! I = 1,NUMNOD_L
1127 ENDIF
1128C
1129C RWALL specifique type sliding
1130C
1131 k = 0
1132 k_l = 0
1133 DO n = 1, nrwall
1134 n3 = 2*nrwall+n
1135 nsl=nprw(n)
1136 msr = nprw(n3)
1137 IF(msr/=0) THEN
1138 IF(nlocal(msr,proc)==1) THEN
1139 nsl_l = 0
1140 DO kk = 1, nsl
1141 nn = lprw(k+kk)
1142 IF(nlocal(nn,proc)==1) THEN
1143 nsl_l = nsl_l + 1
1144 main = 0
1145 DO p = 1, proc-1
1146 IF(nlocal(nn,p)==1) THEN
1147 GOTO 200
1148 ENDIF
1149 ENDDO
1150 main = 1
1151 200 IF(main==1) THEN
1152 iadwal(k_l+nsl_l) = kk
1153 ELSE
1154 iadwal(k_l+nsl_l) = 0
1155 ENDIF
1156 ENDIF
1157 ENDDO
1158 k_l = k_l + nsl_l
1159 ENDIF
1160 ENDIF
1161 k = k + nsl
1162 ENDDO
1163C
1164C RBY specifique
1165C
1166 IF(nskyrbk_l>0)THEN
1167 DO p = 1, nspmd
1168 idebrbk(p) = 0
1169 ENDDO
1170 k = 0
1171 nsl_l = 0
1172 DO n = 1, nrbykin
1173 msr=npby(1,n)
1174 nsl=npby(2,n)
1175 pmain = abs(dd_rby2(3,n))
1176 IF(nlocal(msr,proc)==1) THEN
1177 DO kk = 1, nsl
1178 nn = lpby(k+kk)
1179 IF(nlocal(nn,proc)==1)THEN
1180 nsl_l = nsl_l + 1
1181 main = 0
1182 DO p = 1, proc-1
1183 IF(nlocal(nn,p)==1)THEN
1184 GOTO 300
1185 ENDIF
1186 ENDDO
1187 main = 1
1188 300 IF(main==1) THEN
1189C numerotation fonction du pmain des rby precedents
1190 iadrbk(nsl_l) = kk+idebrbk(pmain)
1191 ELSE
1192 iadrbk(nsl_l) = 0
1193 ENDIF
1194 ENDIF
1195 ENDDO
1196 ENDIF
1197 k = k + nsl
1198 idebrbk(pmain) = idebrbk(pmain) + nsl
1199 ENDDO
1200 ENDIF
1201CC
1202C
1203C Rigid material specifique
1204C
1205 IF(nskyrbmk_l>0)THEN
1206 DO p = 1, nspmd
1207 idebrbk(p) = 0
1208 ENDDO
1209 k = 0
1210 nsl_l = 0
1211 DO n = 1, nrbym
1212 msr=irbym(1,n)
1213 nsl=irbym(2,n)
1214 pmain = abs(dd_rbym2(3,n))
1215 IF(mod(front_rm(msr,proc),10)==1) THEN
1216 DO kk = 1, nsl
1217 nn = lcrbym(k+kk)
1218 IF(nlocal(nn,proc)==1)THEN
1219 nsl_l = nsl_l + 1
1220 main = 0
1221 DO p = 1, proc-1
1222 IF(nlocal(nn,p)==1)THEN
1223 GOTO 333
1224 ENDIF
1225 ENDDO
1226 main = 1
1227 333 IF(main==1) THEN
1228C numerotation fonction du pmain des rigid material precedents
1229 iadrbmk(nsl_l) = kk+idebrbk(pmain)
1230 ELSE
1231 iadrbmk(nsl_l) = 0
1232 ENDIF
1233 ENDIF
1234 ENDDO
1235 ENDIF
1236 k = k + nsl
1237 idebrbk(pmain) = idebrbk(pmain) + nsl
1238 ENDDO
1239 ENDIF
1240
1241CC
1242C
1243C Int 2 specifique
1244C
1245Cpseudo elt type 2
1246 IF(i2nsnt>0) THEN
1247 nsn_l = 0
1248 DO n = 1, ninter
1249 nty = ipari(7,n)
1250 IF (nty==2) THEN
1251 nrts = ipari(3,n)
1252 nrtm = ipari(4,n)
1253 nsn = ipari(5,n)
1254 nmn = ipari(6,n)
1255 DO i=1,nsn
1256 l = intbuf_tab(n)%IRTLM(i)
1257 k = intbuf_tab(n)%NSV(i)
1258 IF(nlocal(k,proc)==1) THEN
1259 DO p = 1, proc-1
1260 IF(nlocal(k,p)==1) GO TO 202
1261 ENDDO
1262 nsn_l = nsn_l + 1
1263 DO j=1,nir
1264 kk = intbuf_tab(n)%IRECTM((l-1)*4+j)
1265C I2TMP(J,I+OFF) = KK
1266 i2tmp(j,nsn_l) = kk
1267 END DO
1268 202 CONTINUE
1269 END IF
1270 END DO
1271 END IF
1272 END DO
1273 if(nsn_l/=i2nsn_l)print *,'error decomp i2 p/on'
1274C
1275 addcni2_l(1) = 1
1276 cc_l = 0
1277 DO i = 1, numnod_l
1278 n = nodglob(i)
1279 n1 = addcni2(n)
1280 n2 = addcni2(n+1)
1281 addcni2_l(i+1) = addcni2_l(i) + n2-n1
1282 DO cc = n1, n2-1
1283 numg = cni2(cc)
1284 numl = celi2(numg)
1285 proc_l = cepi2(numg)+1
1286 cc_l = cc_l + 1
1287 procni2(cc_l) = proc_l
1288C
1289C Remplissage IADI2 si elt interne
1290C
1291 IF (proc==proc_l) THEN
1292 DO k = 1, nir
1293 IF(i2tmp(k,numl)==n) THEN
1294 iadi2(k,numl) = cc_l
1295 i2tmp(k,numl) = -n
1296 GO TO 222
1297 ENDIF
1298 END DO
1299 222 CONTINUE
1300 END IF
1301 END DO
1302 END DO
1303 ENDIF
1304C
1305C RLink specifique
1306C
1307 k = 0
1308 k_l = 0
1309 DO i = 1, nlink
1310 nsl = nnlink(1,i)
1311 nsl_l = 0
1312 DO j = 1, nsl
1313 n = lllink(k+j)
1314 IF (nlocal(n,proc)==1)THEN
1315 nsl_l = nsl_l + 1
1316 iadll(k_l+nsl_l) = j
1317 ENDIF
1318 ENDDO
1319 k = k + nsl
1320 k_l = k_l + nsl_l
1321 ENDDO
1322C
1323C RBM specifique
1324C
1325 IF(nskyrbm_l>0)THEN
1326 DO p = 1, nspmd
1327 idebrbk(p) = 0
1328 ENDDO
1329 k = 0
1330 nsl_l = 0
1331 DO n = 1, nibvel
1332 nsl=ibvel(3,n)
1333 msr=ibvel(4,n)
1334 pmain = abs(dd_rbm2(3,n))
1335 IF(nlocal(msr,proc)==1) THEN
1336 DO kk = 1, nsl
1337 nn = lbvel(k+kk)
1338 IF(nlocal(nn,proc)==1)THEN
1339 nsl_l = nsl_l + 1
1340 main = 0
1341 DO p = 1, proc-1
1342 IF(nlocal(nn,p)==1)THEN
1343 GOTO 3000
1344 ENDIF
1345 ENDDO
1346 main = 1
1347 3000 IF(main==1) THEN
1348C numerotation fonction du pmain des rby precedents
1349 iadrbm(nsl_l) = kk+idebrbk(pmain)
1350 ELSE
1351 iadrbm(nsl_l) = 0
1352 ENDIF
1353 ENDIF
1354 ENDDO
1355 ENDIF
1356 k = k + nsl
1357 idebrbk(pmain) = idebrbk(pmain) + nsl
1358 ENDDO
1359 ENDIF
1360C
1361C RBE3 specifique----plus tard---
1362C
1363 IF(nskyrbe3_l>0)THEN
1364 ENDIF
1365CC
1366C
1367C Itet=2 of S10 specifique
1368C
1369C-----------------------------------------------
1370 IF(ns10e>0) THEN
1371C: N_L :NS10E_L, NSN_L compacted w/o sharering
1372 n_l = 0
1373 nsn_l = 0
1374 DO n = 1, ns10e
1375 k = icnds10(1,n)
1376 n1= icnds10(2,n)
1377 n2= icnds10(3,n)
1378 IF(nlocal(k,proc)==1.AND.itagnd(k)<=ns10e) THEN
1379 n_l = n_l +1
1380 DO p = 1, proc-1
1381 IF(nlocal(k,p)==1) GO TO 332
1382 ENDDO
1383c IF (CEPCND(N)==PROC-1) THEN
1384 nsn_l = nsn_l + 1
1385 icndtmp(1,nsn_l) = n1
1386 icndtmp(2,nsn_l) = n2
1387 icndtmp(3,nsn_l) = n_l
1388c END IF
1389 332 CONTINUE
1390 END IF
1391 END DO
1392 if(n_l/=ns10e_l)print *,'error decomp Itet2of S10 p/on',n_l,ns10e_l
1393c print *,'NSN_L,NS10E_L,LCNCND_L,NS10E=',NSN_L,NS10E_L,LCNCND_L,NS10E
1394C
1395 iadcnd(1:2,1:ns10e_l) = 0
1396 addcncnd_l(1) = 1
1397 cc_l = 0
1398 DO i = 1, numnod_l
1399 n = nodglob(i)
1400 n1 = addcncnd(n)
1401 n2 = addcncnd(n+1)
1402 addcncnd_l(i+1) = addcncnd_l(i) + n2-n1
1403 DO cc = n1, n2-1
1404 numg = cncnd(cc)
1405 IF (numg==0) cycle
1406 numl = celcnd(numg)
1407 proc_l = cepcnd(numg)+1
1408 cc_l = cc_l + 1
1409 procncnd(cc_l) = proc_l
1410
1411C Remplissage IADCND si elt interne
1412
1413 IF (proc==proc_l) THEN
1414 DO k = 1, 2
1415 IF(icndtmp(k,numl)==n) THEN
1416 n_l = icndtmp(3,numl)
1417 iadcnd(k,n_l) = cc_l
1418 icndtmp(k,numl) = -n
1419 GO TO 223
1420 ENDIF
1421 END DO
1422 223 CONTINUE
1423 END IF
1424 END DO
1425 END DO
1426 ENDIF
1427C
1428C Interface 18
1429C
1430 IF(nbi18_l>0)THEN
1431 nn = 0
1432 DO n=1,ninter
1433 ity = ipari(7,n)
1434 inacti = ipari(22,n)
1435 IF((ity==7.OR.ity==22).AND.inacti==7)THEN ! interface 18 ! ON PASSE PAR PAR LA (INTER 18 ou 22)
1436 nrts = ipari(3,n)
1437 nrtm = ipari(4,n)
1438 DO k=1,nrtm
1439C TAGE flag servant pour inacti
1440 n1 = intbuf_tab(n)%IRECTM(4*(k-1)+1)
1441 n2 = intbuf_tab(n)%IRECTM(4*(k-1)+2)
1442 n3 = intbuf_tab(n)%IRECTM(4*(k-1)+3)
1443 n4 = intbuf_tab(n)%IRECTM(4*(k-1)+4)
1444 IF(nlocal(n1,proc)==1.AND.
1445 . nlocal(n2,proc)==1.AND.
1446 . nlocal(n3,proc)==1.AND.
1447 . nlocal(n4,proc)==1) THEN
1448 DO p = 1, proc-1
1449 IF(nlocal(n1,p)==1.AND.
1450 . nlocal(n2,p)==1.AND.
1451 . nlocal(n3,p)==1.AND.
1452 . nlocal(n4,p)==1) THEN
1453 GOTO 1300
1454 END IF
1455 END DO
1456 nn = nn + 1
1457 iadi18(nn) = k
1458 1300 CONTINUE
1459 END IF
1460 END DO
1461 END IF
1462 END DO
1463 END IF
1464C-----------------------------------------------
1465C Ecriture tableaux P/ON propre au SPMD
1466C-----------------------------------------------
1467C
1468C elements
1469 CALL write_i_c(addcne_l,numnod_l+1) ! ADSKY ?
1470 len_ia = len_ia + numnod_l+1
1471 CALL write_i_c(procne,lcne_l)
1472 len_ia = len_ia + lcne_l
1473C int 2
1474 IF(i2nsnt>0) THEN
1475 CALL write_i_c(addcni2_l,numnod_l+1)
1476 len_ia = len_ia + numnod_l+1
1477 ENDIF
1478 CALL write_i_c(procni2,lcni2_l)
1479 len_ia = len_ia + lcni2_l
1480C itet=2 of s10
1481 IF(ns10e_l>0) THEN
1482 CALL write_i_c(addcncnd_l,numnod_l+1)
1483 len_ia = len_ia + numnod_l+1
1484 ENDIF
1485 CALL write_i_c(procncnd,lcncnd_l)
1486 len_ia = len_ia + lcncnd_l
1487C adresses elements
1488 CALL write_i_c(iads,8*numels_l)
1489 len_ia = len_ia + 8*numels_l
1490 CALL write_i_c(iads10,6*numels10_l)
1491 len_ia = len_ia + 6*numels10_l
1492 CALL write_i_c(iads20,12*numels20_l)
1493 len_ia = len_ia +12*numels20_l
1494 CALL write_i_c(iads16,8*numels16_l)
1495 len_ia = len_ia + 8*numels16_l
1496 CALL write_i_c(iadq,4*numelq_l)
1497 len_ia = len_ia + 4*numelq_l
1498 CALL write_i_c(iadc,4*numelc_l)
1499 len_ia = len_ia + 4*numelc_l
1500 CALL write_i_c(iadt,2*numelt_l)
1501 len_ia = len_ia + 2*numelt_l
1502 CALL write_i_c(iadp,2*numelp_l)
1503 len_ia = len_ia + 2*numelp_l
1504 CALL write_i_c(iadr,3*numelr_l)
1505 len_ia = len_ia + 3*numelr_l
1506 CALL write_i_c(iadtg,3*numeltg_l)
1507 len_ia = len_ia + 3*numeltg_l
1508 CALL write_i_c(iadtg1,3*numeltg6_l)
1509 len_ia = len_ia + 3*numeltg6_l
1510 CALL write_i_c(iadmv,4*nnmv_l)
1511 len_ia = len_ia + 4*nnmv_l
1512 CALL write_i_c(iadib,4*nconld_l)
1513 len_ia = len_ia + 4*nconld_l
1514 CALL write_i_c(iadibcv,4*nconv_l)
1515 len_ia = len_ia + 4*nconv_l
1516 CALL write_i_c(iadibcr,4*nradia_l)
1517 len_ia = len_ia + 4*nradia_l
1518 CALL write_i_c(iadibfx,4*nfxflux_l)
1519 len_ia = len_ia + 4*nfxflux_l
1520 CALL write_i_c(iadload,llloadp_l)
1521 len_ia = len_ia + llloadp_l
1522C adresses RW
1523 CALL write_i_c(iadwal,nskyrw_l)
1524 len_ia = len_ia + nskyrw_l
1525C adresses RB Kin
1526 CALL write_i_c(iadrbk,nskyrbk_l)
1527 len_ia = len_ia + nskyrbk_l
1528C adresses int 2
1529 CALL write_i_c(iadi2,niskyi2_l)
1530 len_ia = len_ia + niskyi2_l
1531C adresses itet2 S10
1532 CALL write_i_c(iadcnd,2*ns10e_l)
1533 len_ia = len_ia + 2*ns10e_l
1534C adresses MV partie force normale
1535 CALL write_i_c(iadmv2,nnmv_l)
1536 len_ia = len_ia + nnmv_l
1537C adresses MV partie fuite et mv communicant
1538 CALL write_i_c(iadmv3,nnmvc_l)
1539 len_ia = len_ia + nnmvc_l
1540C adresses RL starter
1541 CALL write_i_c(iadll,nskyll_l)
1542 len_ia = len_ia + nskyll_l
1543C adresses RBM starter
1544 CALL write_i_c(iadrbm,nskyrbm_l)
1545 len_ia = len_ia + nskyrbm_l
1546C adresses RBE3 starter
1547c CALL WRITE_I_C(IADRBE3,NSKYRBE3_L)
1548c LEN_IA = LEN_IA + NSKYRBE3_L
1549 CALL write_i_c(iadi18,nskyi18_l)
1550 len_ia = len_ia + nskyi18_l
1551C adresses rigid material Kin
1552 CALL write_i_c(iadrbmk,nskyrbmk_l)
1553 len_ia = len_ia + nskyrbmk_l
1554C
1555C elements
1556 IF(iplyxfem > 0 ) THEN
1557 CALL write_i_c(addcnepxfem_l,numnodpxfem_l+1)
1558 len_ia = len_ia + numnodpxfem_l+1
1559 CALL write_i_c(procne_pxfem,lcnepxfem_l)
1560 len_ia = len_ia + lcnepxfem_l
1561 CALL write_i_c(iadc_pxfem,4*numelcpxfem_l)
1562 len_ia = len_ia + 4*numelcpxfem_l
1563 ENDIF
1564C
1565C crack xfem for layered shell
1566C
1567 IF (icrack3d > 0) THEN
1568 CALL write_i_c(addcnecrkxfem_l,numnodcrkxfe_l+1)
1569 len_ia = len_ia + numnodcrkxfe_l+1
1570 CALL write_i_c(cne_crkxfem_l,lcnecrkxfem_l)
1571 len_ia = len_ia + lcnecrkxfem_l
1572 CALL write_i_c(procne_crkxfem,lcnecrkxfem_l)
1573 len_ia = len_ia + lcnecrkxfem_l
1574 CALL write_i_c(iadc_crkxfem,4*numelccrkxfe_l)
1575 len_ia = len_ia + 4*numelccrkxfe_l
1576 CALL write_i_c(iadtg_crkxfem,3*numeltgcrkxfe_l)
1577 len_ia = len_ia + 3*numeltgcrkxfe_l
1578 CALL write_i_c(crknodiad_l,lcnecrkxfem_l)
1579 len_ia = len_ia + lcnecrkxfem_l
1580 ENDIF
1581
1582 ! -----------------------
1583 ! EBCS option : adress for parith/on
1584 IF(local_nebcs>0) THEN
1585 DO i=1,local_nebcs
1586 CALL write_i_c(ebcs_parithon_l(i)%ELEM_ADRESS,4*ebcs_tab_loc_2%tab(i)%poly%nb_elem)
1587 len_ia = len_ia + 4*ebcs_tab_loc_2%tab(i)%poly%nb_elem
1588 ENDDO
1589 ENDIF
1590 ! -----------------------
1591c
1592 DEALLOCATE (soltag)
1593 DEALLOCATE (sol10tag)
1594 DEALLOCATE (sol20tag)
1595 DEALLOCATE (sol16tag)
1596 DEALLOCATE (quadtag)
1597 DEALLOCATE (shtag)
1598 DEALLOCATE (ttag)
1599 DEALLOCATE (ptag)
1600 DEALLOCATE (rtag)
1601 DEALLOCATE (tgtag)
1602 DEALLOCATE (tg6tag)
1603 DEALLOCATE (ibtag)
1604 DEALLOCATE (ibcvtag)
1605 DEALLOCATE (ibcrtag)
1606 DEALLOCATE (ibfxtag)
1607 DEALLOCATE (iltag)
1608 DEALLOCATE (tagig3d)
1609! -----------------------------
1610! deallocate 1d arrays
1611 DEALLOCATE( itagc,itagtg )
1612 DEALLOCATE( addcne_l,addcni2_l,addcncnd_l )
1613! deallocate IAD arrays
1614 DEALLOCATE( iads,iads10 )
1615 DEALLOCATE( iads16,iads20 )
1616 DEALLOCATE( iadq,iadc )
1617 DEALLOCATE( iadt,iadp )
1618 DEALLOCATE( iadr,iadtg )
1619 DEALLOCATE( iadib )
1620 DEALLOCATE( iadtg1,iadig3d )
1621! -----------------------------
1622 ! EBCS option : deallocation
1623 DEALLOCATE( ebcs_tag )
1624 IF(local_nebcs>0) THEN
1625 DO i=1,local_nebcs
1626 DEALLOCATE( ebcs_parithon_l(i)%ELEM_ADRESS )
1627 ENDDO
1628 ENDIF
1629 DEALLOCATE(ebcs_parithon_l)
1630 DEALLOCATE(procne)
1631 DEALLOCATE(itagib)
1632 DEALLOCATE(iadmv)
1633 DEALLOCATE(iadmv2)
1634 DEALLOCATE(iadmv3)
1635 DEALLOCATE(iadwal)
1636 DEALLOCATE(iadrbk)
1637 DEALLOCATE(iadi2)
1638 DEALLOCATE(i2tmp)
1639 DEALLOCATE(iadll)
1640 DEALLOCATE(procni2)
1641 DEALLOCATE(iadrbm)
1642 DEALLOCATE(iadi18)
1643 DEALLOCATE(iadibcv)
1644 DEALLOCATE(iadibfx)
1645 DEALLOCATE(iadrbmk)
1646 DEALLOCATE(iadibcr)
1647 DEALLOCATE(itagloadp)
1648 DEALLOCATE(iadload)
1649 DEALLOCATE(icndtmp)
1650 DEALLOCATE(procncnd)
1651 DEALLOCATE(iadcnd)
1652
1653 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
groupdef_mod
Definition groupdef_mod.F:662
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645