OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_anim_crk.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C
24!||====================================================================
25!|| w_anim_crk ../starter/source/restart/ddsplit/w_anim_crk.F
26!||--- called by ------------------------------------------------------
27!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE w_anim_crk(
32 . IXC ,IXTG ,NUMELC_L,NUMELTG_L,NODLOCAL,
33 . NUMNOD_L ,INOD_L ,CEL ,CEP_XFE,PROC,
34 . IEDGECRK_L,IBORDEDGE_L,NUMEDGES_L,INDEX_CRKXFEM,
35 . INOD_CRKXFEM,LCNECRKXFEM_L,EDGEGLOBAL,CEP,CRKLVSET,
36 . NCRKPART, INDX_CRK, CRKSHELL,CRKSKY ,CRKAVX ,
37 . CRKEDGE ,XFEM_PHANTOM,NUMNODCRK_L)
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
383 END
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
w_anim_crk
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)
Definition w_anim_crk.F:38
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