OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_anim_crk.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine w_anim_crk (ixc, ixtg, numelc_l, numeltg_l, nodlocal, numnod_l, inod_l, cel, cep_xfe, proc, iedgecrk_l, ibordedge_l, numedges_l, index_crkxfem, inod_crkxfem, lcnecrkxfem_l, edgeglobal, cep, crklvset, ncrkpart, indx_crk, crkshell, crksky, crkavx, crkedge, xfem_phantom, numnodcrk_l)

Function/Subroutine Documentation

◆ w_anim_crk()

subroutine w_anim_crk ( integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer numelc_l,
integer numeltg_l,
integer, dimension(*) nodlocal,
integer numnod_l,
integer, dimension(*) inod_l,
integer, dimension(*) cel,
integer, dimension(*) cep_xfe,
integer proc,
integer, dimension(*) iedgecrk_l,
integer, dimension(*) ibordedge_l,
integer numedges_l,
integer, dimension(*) index_crkxfem,
integer, dimension(*) inod_crkxfem,
integer lcnecrkxfem_l,
integer, dimension(*) edgeglobal,
integer, dimension(*) cep,
type (xfem_lvset_), dimension(nlevmax) crklvset,
integer ncrkpart,
integer, dimension(*) indx_crk,
type (xfem_shell_), dimension(nlevmax) crkshell,
type (xfem_sky_), dimension(nlevmax) crksky,
type (xfem_avx_), dimension(nlevmax) crkavx,
type (xfem_edge_), dimension(nxlaymax) crkedge,
type (xfem_phantom_), dimension(nxlaymax) xfem_phantom,
integer numnodcrk_l )

Definition at line 31 of file w_anim_crk.F.

38C-----------------------------------------------
39 USE xfem2def_mod
40 use element_mod , only : nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com04_c.inc"
49#include "com_xfem1.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER IXC(NIXC,*),NUMELC_L, NODLOCAL(*),INDX_CRK(*),
54 . NUMNOD_L,CEL(*),CEP_XFE(*),PROC,NCRKPART,
55 . INOD_L(*),IXTG(NIXTG,*),NUMELTG_L,NUMNODCRK_L,
56 . IEDGECRK_L(*),IBORDEDGE_L(*),NUMEDGES_L,
57 . INDEX_CRKXFEM(*),INOD_CRKXFEM(*),LCNECRKXFEM_L,
58 . EDGEGLOBAL(*),CEP(*)
59 TYPE (XFEM_SHELL_) , DIMENSION(NLEVMAX) :: CRKSHELL
60 TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
61 TYPE (XFEM_SKY_) , DIMENSION(NLEVMAX) :: CRKSKY
62 TYPE (XFEM_AVX_) , DIMENSION(NLEVMAX) :: CRKAVX
63 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX) :: CRKEDGE
64 TYPE (XFEM_PHANTOM_), DIMENSION(NXLAYMAX) :: XFEM_PHANTOM
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,J,K,ELEM,ND,NDSZ_L,ELSZ_L,ELPL,NCOUNT,EMPL,ILAY,
69 . ELTYP,IX(4),OFFC,OFFTG,OFF,IDIM,NEXT,ELSZC_L,ELSZTG_L,
70 . SH4N,SH3N,SH4N_L,SH3N_L,CRKSHELLID_L,
71 . NELXFE_L,IED,IED_GL,NLAY,LEN,LENLAY,NCOUNTALL,ELEM_GL,ELEM_L,
72 . NENR,XFENUMNODS,IEL_L
73 my_real
74 . redge(numedges_l)
75c
76 INTEGER, DIMENSION(:), ALLOCATABLE :: NODTAG,ELEMTAG,CRKSIZN_L
77 INTEGER, DIMENSION(:), ALLOCATABLE :: ELEMXFEMID,
78 . ELCUT,ITRI,TAGXP
79 INTEGER, DIMENSION(:) , ALLOCATABLE :: IFI,ENRICH0,IEDGEX
80 INTEGER, DIMENSION(:,:), ALLOCATABLE :: KNOD2ELC,EDGEIFI,EDGEENR
81 INTEGER, DIMENSION(:) , ALLOCATABLE :: XFECRKNODID,ELTYPE,NOD2IAD
82 INTEGER, DIMENSION(:) , ALLOCATABLE :: ICUTEDGE,EDGEICRK,LAYCUT
83 INTEGER, DIMENSION(:,:), ALLOCATABLE :: EDGETIP
84 INTEGER, DIMENSION(:) , ALLOCATABLE :: NOD_XFENODES
85 INTEGER, DIMENSION(:,:), ALLOCATABLE :: SH_XFENODES
86 INTEGER, DIMENSION(:) , ALLOCATABLE :: ELEMLOC_C,ELEMLOC_TG
87 my_real, DIMENSION(:) , ALLOCATABLE :: ratioedge,avx,avxx,fsky,area
88C=======================================================================
89! 1d array
90 ALLOCATE( nodtag(numnod_l),elemtag(numelc_l+numeltg_l) )
91 ALLOCATE( crksizn_l(nlevmax) )
92! --------------------------------------
93 offc = numels + numelq
94 offtg = offc + numelc + numelt + numelp + numelr
95C
96 CALL write_i_c(ncrkpart,1)
97 CALL write_i_c(ncrkxfe, 1) ! total Number of Xfem elements
98 CALL write_i_c(indx_crk,ncrkpart)
99C
100 crkshellid_l = 0
101 ncountall = 0
102C
103 ALLOCATE(elemloc_c(numelc))
104 ALLOCATE(elemloc_tg(numeltg))
105 elemloc_c = 0
106 elemloc_tg = 0
107c
108 j = 0
109 DO i=1,numelc
110 IF(cep(i+offc) == proc)THEN
111 j = j + 1
112 elemloc_c(i) = j
113 ENDIF
114 ENDDO
115 j = 0
116 DO i=1,numeltg
117 IF(cep(i+offtg) == proc)THEN
118 j = j + 1
119 elemloc_tg(i) = j
120 ENDIF
121 ENDDO
122C=======================================================================
123c storage by ILEV
124C=======================================================================
125 ALLOCATE (elcut(numelc_l+numeltg_l))
126c
127 DO k=1,nlevmax
128 nodtag = 0
129 elemtag = 0
130 crksizn_l(k) = 0
131 sh4n_l = 0
132 sh3n_l = 0
133 nelxfe_l = 0
134c
135 DO i=1,crkshell(k)%CRKNUMSHELL
136 eltyp = crkshell(k)%ELTYPE(i)
137 elem = crkshell(k)%PHANTOML(i)
138 IF (cep_xfe(i) == proc) THEN
139 nelxfe_l = nelxfe_l + 1
140 elemtag(nelxfe_l)=i
141 crksizn_l(k)=crksizn_l(k)+eltyp ! Somme nodes phantomas by Ply by proc
142 IF (eltyp == 4) THEN
143 sh4n_l = sh4n_l + 1
144 DO j=1,eltyp
145 nd = ixc(j+1,elem)
146 nodtag(nodlocal(nd))=nd ! noeud global = f(node local)
147 ENDDO
148 ELSEIF (eltyp == 3) THEN
149 sh3n_l = sh3n_l + 1
150 DO j=1,eltyp
151 nd = ixtg(j+1,elem)
152 nodtag(nodlocal(nd))=nd ! noeud global = f(node local)
153 ENDDO
154 END IF
155 END IF
156 END DO ! I=1,CRKSHELL(K)%CRKNUMSHELL
157C------------------------------
158 elszc_l = sh4n_l ! number of elements per ply
159 elsztg_l = sh3n_l
160 elsz_l = elszc_l + elsztg_l
161C
162 ndsz_l=0
163 DO i=1,numnod_l
164 IF (nodtag(i) > 0) ndsz_l=ndsz_l+1 ! nb noeuds par ply (image std)
165 ENDDO
166C
167 idim = crksizn_l(k) ! number of phantom nodes per ply per processor
168C
169 ALLOCATE(elemxfemid(elsz_l))
170 ALLOCATE(eltype(elsz_l))
171 ALLOCATE(area(elsz_l))
172
173 elcut = 0
174 elemxfemid = 0
175 eltype = 0
176 area = 0
177 ALLOCATE(knod2elc(4,elsz_l),xfecrknodid(4*elsz_l),
178 . sh_xfenodes(4,elsz_l),enrich0(lcnecrkxfem_l),
179 . nod_xfenodes(4*elsz_l))
180 IF (k==1) THEN
181 ALLOCATE(laycut(elsz_l))
182 ALLOCATE(iedgex(idim))
183 iedgex = 0
184 ENDIF
185C
186 enrich0 = 0
187 knod2elc = 0
188 xfecrknodid = 0
189 nod_xfenodes = 0
190 sh_xfenodes = 0
191C---
192c Local element tables
193C---
194 ncount = 0
195 elpl = 0
196 next = 0
197 DO i=1,nelxfe_l ! local elements per ply per processor
198 IF (elemtag(i) > 0) THEN
199 elpl = elpl+1
200 nd = elemtag(i) ! N element global par ply
201 eltyp = crkshell(k)%ELTYPE(nd)
202 elem_gl = crkshell(k)%PHANTOML(nd)
203 IF (eltyp == 4) THEN
204 elem_l = elemloc_c(elem_gl)
205 eltype(elpl) = 0
206 ELSEIF (eltyp == 3) THEN
207 elem_l = elemloc_tg(elem_gl)
208 eltype(elpl) = 1
209 ENDIF
210C
211 elemxfemid(elpl) = crkshell(k)%PHANTOMG(nd) ! N global = f(N local)
212 ilay = (k-1)/nxel + 1
213 elcut(elpl) = xfem_phantom(ilay)%ELCUT(nd)
214C
215 IF (k==1) THEN
216 lenlay = elsz_l
217 laycut(elpl) = crkedge(k)%LAYCUT(nd)
218 ENDIF
219C
220 IF (k==1) THEN
221 DO j=1,eltyp
222 IF(eltyp==4)THEN
223 iedgex(next+j) = crklvset(k)%EDGE(j,nd)
224 ELSEIF(eltyp==3)THEN
225 iedgex(next+j) = crklvset(k)%EDGETG(j,nd-ecrkxfec)
226 ENDIF
227 ENDDO
228 next = next + eltyp
229 ENDIF
230C
231 DO j=1,4
232 knod2elc(j,elpl) = crkshell(k)%XNODEG(j,nd)
233C
234 ncount = ncount + 1
235 xfecrknodid(ncount) = crkshell(k)%XNODEG(j,nd)
236 ncountall = ncountall + 1
237 nod_xfenodes(ncount) = ncountall
238 sh_xfenodes(j,elpl) = ncountall
239 END DO
240 ENDIF
241 ENDDO ! 1,NELXFE_L
242C
243 xfenumnods = 4*elsz_l
244 ALLOCATE(avx(3*lcnecrkxfem_l))
245 ALLOCATE(avxx(3*xfenumnods))
246 ALLOCATE(fsky(8*lcnecrkxfem_l))
247 ALLOCATE(nod2iad(xfenumnods))
248 avx = zero
249 avxx = zero
250 fsky = zero
251 nod2iad = 0
252c
253c------ CRKSHELL
254 CALL write_i_c(elszc_l , 1)
255 CALL write_i_c(elsztg_l , 1)
256 CALL write_i_c(elsz_l , 1)
257 CALL write_i_c(elemxfemid , elsz_l) ! CRKSHELL(ILEV)%CRKSHELLID
258 CALL write_i_c(eltype , elsz_l) ! local xfemelement type = 0/1
259c------ CRKNOD
260 CALL write_i_c(xfecrknodid , xfenumnods)
261 CALL write_i_c(nod_xfenodes , xfenumnods)
262c------ CRKSHELL
263c CALL WRITE_I_C(KNOD2ELC , XFENUMNODS)
264 CALL write_i_c(sh_xfenodes , xfenumnods)
265c------ CRKLVSET
266 CALL write_i_c(enrich0 , lcnecrkxfem_l) ! CRKLVSET(ILEV)%ENR0(1,IADC1)
267 CALL write_i_c(enrich0 , lcnecrkxfem_l) ! CRKLVSET(ILEV)%ENR0(2,IADC1)
268 CALL write_db (area , elsz_l) ! CRKLVSET(ILEV)%AREA(ELCRK)
269c------ CRKAVX
270 CALL write_db(avx,3*lcnecrkxfem_l) ! CRKAVX(I)%A
271 CALL write_db(avx,3*lcnecrkxfem_l) ! CRKAVX(I)%AR
272 CALL write_db(avx,3*lcnecrkxfem_l) ! crkavx(i)%V
273 CALL write_db(avx,3*lcnecrkxfem_l) ! CRKAVX(I)%VR
274 CALL write_db(avx,3*lcnecrkxfem_l) ! CRKAVX(I)%X
275 CALL write_db(avx,3*lcnecrkxfem_l) ! CRKAVX(I)%U
276 CALL write_db(avxx,3*xfenumnods) ! CRKAVX(I)%XX
277c------ CRKSKY
278 CALL write_db(fsky,8*lcnecrkxfem_l) ! CRKSKY(I)%FSKY
279c------ CRKNOD
280 CALL write_i_c(nod2iad,xfenumnods) ! CRKNOD(I)%NOD2IAD
281 CALL write_i_c(xfenumnods,1) ! CRKNOD(I)%XFENUMNODS
282c-------
283 DEALLOCATE(elemxfemid)
284 DEALLOCATE(eltype)
285 DEALLOCATE(area)
286 DEALLOCATE(enrich0)
287 DEALLOCATE(knod2elc)
288 DEALLOCATE(xfecrknodid)
289 DEALLOCATE(nod_xfenodes)
290 DEALLOCATE(sh_xfenodes)
291 DEALLOCATE(avx,avxx,fsky)
292 DEALLOCATE(nod2iad)
293 ENDDO ! K=1,NLEVMAX
294c
295 DEALLOCATE(elemloc_c)
296 DEALLOCATE(elemloc_tg)
297C=======================================================================
298c storage by layer
299C=======================================================================
300 nlay = int(nlevmax/nxel)
301 nenr = int(ienrnod/nlevmax)
302c
303c--- write XFEM_PHANTOM ----------------------------
304 ALLOCATE(ifi(lcnecrkxfem_l) )
305 ALLOCATE(tagxp(numnodcrk_l*ienrnod*5)) ! IENRNOD -> NENR
306 ALLOCATE(itri(elsz_l*2))
307 tagxp = 0
308 ifi = 0
309 itri = 0
310c
311 DO ilay=1,nlay
312 CALL write_i_c(elcut ,elsz_l)
313 CALL write_i_c(ifi ,lcnecrkxfem_l)
314 CALL write_i_c(tagxp ,numnodcrk_l*ienrnod*5)
315 CALL write_i_c(itri ,elsz_l*2)
316 ENDDO
317c
318 DEALLOCATE(elcut)
319 DEALLOCATE(itri )
320 DEALLOCATE(tagxp )
321 DEALLOCATE(ifi )
322C
323c--- write CRKEDGE ----------------------------
324 idim = crksizn_l(1)
325c ALLOCATE(IEDGEX(IDIM))
326 ALLOCATE(edgeicrk(numedges_l))
327 ALLOCATE(edgeifi(2,numedges_l))
328 ALLOCATE(edgeenr(2,numedges_l))
329 ALLOCATE(edgetip(2,numedges_l))
330 ALLOCATE(icutedge(numedges_l))
331 ALLOCATE(ratioedge(numedges_l))
332 edgeicrk = 0
333 edgeifi = 0
334 edgeenr = 0
335 edgetip = 0
336c
337 DO ilay=1,nlay
338 k = (ilay-1)*nxel + 1
339 DO ied=1,numedges_l
340 ied_gl = edgeglobal(ied)
341 edgeicrk(ied) = crkedge(ilay)%EDGEICRK(ied_gl) ! crack id on an edge
342 edgeifi(1,ied) = crkedge(ilay)%EDGEIFI(1,ied_gl) ! lvset sign on an edge (+/- ICRK)
343 edgeifi(2,ied) = crkedge(ilay)%EDGEIFI(2,ied_gl)
344 edgeenr(1,ied) = crkedge(ilay)%EDGEENR(1,ied_gl) ! enrich lvset on an edge
345 edgeenr(2,ied) = crkedge(ilay)%EDGEENR(2,ied_gl)
346 edgetip(1,ied) = crkedge(ilay)%EDGETIP(1,ied_gl) ! flag d'edge interne/ext
347 edgetip(2,ied) = crkedge(ilay)%EDGETIP(2,ied_gl)
348 icutedge(ied) = crklvset(k)%ICUTEDGE(ied_gl)
349 ratioedge(ied) = crklvset(k)%RATIOEDGE(ied_gl)
350 ENDDO
351 CALL write_i_c(laycut ,lenlay)
352 CALL write_i_c(iedgex ,idim)
353 CALL write_i_c(edgeicrk ,numedges_l)
354 CALL write_i_c(edgeifi ,numedges_l*2)
355 CALL write_i_c(edgeenr ,numedges_l*2)
356 CALL write_i_c(edgetip ,numedges_l*2)
357 CALL write_i_c(ibordedge_l ,numedges_l) ! CRKEDGE(IL)%IBORDEDGE(NUMEDGES)
358 CALL write_i_c(icutedge ,numedges_l) ! CRKEDGE(IL)%ICUTEDGE(NUMEDGES)
359 CALL write_db (ratioedge ,numedges_l) ! CRKEDGE(IL)%RATIO(NUMEDGES)
360 END DO ! ILAY=1,NLAY
361c
362 DEALLOCATE(ratioedge)
363 DEALLOCATE(icutedge)
364 DEALLOCATE(edgetip)
365 DEALLOCATE(edgeenr)
366 DEALLOCATE(edgeifi)
367 DEALLOCATE(edgeicrk)
368 DEALLOCATE(iedgex)
369 IF (ALLOCATED(laycut)) DEALLOCATE(laycut)
370c----------------------------------
371c Stockage global
372c----------------------------------
373 len = 4*elszc_l + 3*elsztg_l
374 CALL write_i_c(iedgecrk_l ,len) ! XEDGE4N(4*ELSZC) + XEDGE3N(3*ELSZTG)
375C-----------
376! --------------------------------------
377! 1d array
378 DEALLOCATE(nodtag)
379 DEALLOCATE(elemtag)
380 DEALLOCATE(crksizn_l)
381! --------------------------------------
382 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
xfem2def_mod
Definition xfem2def_mod.F:40
write_db
subroutine write_db(a, n)
Definition write_db.F:142
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645