OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fillcne_xfem.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/.
23!||====================================================================
24!|| fillcne_xfem ../starter/source/elements/xfem/fillcne_xfem.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE fillcne_xfem(LCNE_CRKXFEM,IPARG,
30 . IEL_CRKXFEM ,INOD_CRKXFEM ,IXC ,IXTG , CEP,
31 . ADDCNE_CRKXFEM,CNE_XFE,CEL_XFE,CEP_XFE,CRKNODIAD )
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com01_c.inc"
40#include "com04_c.inc"
41#include "com_xfem1.inc"
42#include "param_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER LCNE_CRKXFEM
47 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),ADDCNE_CRKXFEM(0:NCRKXFE+1),
48 . cne_xfe(lcne_crkxfem),iel_crkxfem(numelc+numeltg),inod_crkxfem(*),
49 . cep(*),cel_xfe(ecrkxfe),cep_xfe(ecrkxfe),crknodiad(lcne_crkxfem),
50 . iparg(nparg,ngroup)
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER I,J,K,N,NG,NP,NEL,NFT,ITY,ITYO,II,III,NIN,P,PROC,INDX,OFFC,OFFTG
55 INTEGER ADSKY(0:NCRKXFE+1)
56 INTEGER, ALLOCATABLE, DIMENSION(:) :: KNOD2ELC
57 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: TAGSKYC,TAGSKYTG
58 INTEGER, DIMENSION(70000) :: WORK
59 INTEGER, DIMENSION(NUMELC) :: ITRIC
60 INTEGER, DIMENSION(NUMELTG) :: ITRITG
61 INTEGER, DIMENSION(NUMELC*2) :: INDXC
62 INTEGER, DIMENSION(NUMELTG*2):: INDXTG
63C=======================================================================
64C CALCUL DE CNE ADDCNE_CRKXFEM CEL for XFEM part
65C-----------------------------------------------
66 ALLOCATE(knod2elc(numnod+1))
67 knod2elc = 0
68 ALLOCATE(tagskyc(4,numelc))
69 tagskyc = 0
70 ALLOCATE(tagskytg(3,numeltg))
71 tagskytg = 0
72C
73 DO i = 0, ncrkxfe + 1 ! NCRKXFE = Nb of nodes xfem
74 adsky(i) = addcne_crkxfem(i)
75 ENDDO
76C
77 offc = numels + numelq
78 offtg = offc + numelt + numelp + numelr + numelc
79c
80c---------------------------
81c Connectivities
82c---------------------------
83 DO i = 1, numelc
84 itric(i) = ixc(7,i) ! ID elements std dans l'ordre d'input
85 ENDDO
86 CALL my_orders(0,work,itric,indxc,numelc,1)
87c
88 DO i = 1, numeltg
89 itritg(i) = ixtg(6,i)
90 ENDDO
91 CALL my_orders(0,work,itritg,indxtg,numeltg,1)
92c---------------------------
93 DO j=1,numelc
94 i = indxc(j)
95 DO k=1,4
96 n = ixc(k+1,i)
97 knod2elc(n) = knod2elc(n) + 1
98 tagskyc(k,i) = knod2elc(n) ! Nb d'elements std connectes a un noeud
99 END DO
100 END DO
101c---
102 DO j=1,numeltg
103 i = indxtg(j)
104 DO k=1,3
105 n = ixtg(k+1,i)
106 knod2elc(n) = knod2elc(n) + 1
107 tagskytg(k,i) = knod2elc(n)
108 END DO
109 END DO
110c---------------------------
111c SHELL -4N- Connectivities
112c---------------------------
113 indx = 0
114 DO j=1,numelc
115 i = indxc(j)
116 IF (iel_crkxfem(i) > 0) THEN
117 indx = indx + 1
118 DO k=1,4
119 n = ixc(k+1,i) ! num noeud std
120 np = inod_crkxfem(n) ! Num noeud phantome
121 cne_xfe(adsky(np)) = i
122 crknodiad(adsky(np)) = tagskyc(k,i)
123 adsky(np) = adsky(np) + 1
124 ENDDO
125 ENDIF
126 ENDDO
127c---------------------------
128c SHELL -3N- Connectivities
129c---------------------------
130 DO j=1,numeltg
131 i = indxtg(j)
132 IF (iel_crkxfem(i+numelc) > 0) THEN
133 indx = indx + 1
134 DO k=1,3
135 n = ixtg(k+1,i)
136 np = inod_crkxfem(n)
137 cne_xfe(adsky(np)) = i + numelc
138 crknodiad(adsky(np)) = tagskytg(k,i)
139 adsky(np) = adsky(np) + 1
140 ENDDO
141 ENDIF
142 ENDDO
143C-----------------------------------------------
144c Remplissage de CEL_XFE, CEP_XFE : Element Xfem Global/Local
145C-----------------------------------------------
146c SHELL -4N-
147c
148 DO proc = 1, nspmd
149 nin = 0
150 DO ng = 1, ngroup
151 nel = iparg(2,ng)
152 nft = iparg(3,ng)
153 ity = iparg(5,ng)
154 p = iparg(32,ng)+1
155 IF (ity == 3) THEN
156 IF (p == proc) THEN
157 DO i = 1, nel
158 n = iel_crkxfem(i+nft)
159 IF (n > 0) THEN
160 nin = nin + 1
161 cel_xfe(n) = nin
162 cep_xfe(n) = p-1
163 ENDIF
164 ENDDO
165 ENDIF
166 ENDIF
167 ENDDO
168 ENDDO
169c
170c SHELL -3N-
171c
172 DO proc = 1, nspmd
173 nin = 0
174 DO ng = 1, ngroup
175 nel = iparg(2,ng)
176 nft = iparg(3,ng)
177 ity = iparg(5,ng)
178 p = iparg(32,ng)+1
179 IF (ity == 7) THEN
180 IF (p == proc) THEN
181 ii = numelc + nft
182 DO i = 1, nel
183 n = iel_crkxfem(ii + i)
184 IF (n > 0) THEN
185 nin = nin + 1
186 cel_xfe(n) = nin
187 cep_xfe(n) = p-1
188 ENDIF
189 ENDDO
190 ENDIF
191 ENDIF
192 ENDDO
193 ENDDO
194c-----------
195 DEALLOCATE(tagskyc,tagskytg,knod2elc)
196c-----------
197 RETURN
198 END
fillcne_xfem
subroutine fillcne_xfem(lcne_crkxfem, iparg, iel_crkxfem, inod_crkxfem, ixc, ixtg, cep, addcne_crkxfem, cne_xfe, cel_xfe, cep_xfe, crknodiad)
Definition fillcne_xfem.F:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82