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