OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_fvbag.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!|| c_fvbag ../starter/source/airbag/c_fvbag.F
25!||--- called by ------------------------------------------------------
26!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
27!||--- calls -----------------------------------------------------
28!|| nlocal ../starter/source/spmd/node/ddtools.F
29!||--- uses -----------------------------------------------------
30!|| fvbag_mod ../starter/share/modules1/fvbag_mod.F
31!||====================================================================
32 SUBROUTINE c_fvbag(
33 . MONVOL, NODLOCAL, IXS , PROC, NB_NODE, FVMAIN)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE fvbag_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER
52 . monvol(*), nodlocal(*), ixs(nixs,*), proc, nb_node,
53 . fvmain(*)
54C-----------------------------------------------
55C E x t e r n a l F u n c t i o n s
56C-----------------------------------------------
57 INTEGER NLOCAL
58 EXTERNAL nlocal
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER K1, K2, IFV, I, ITYP, NN, KI1, J, NMAX, PMAIN, P, NN_L,
63 . pp, jj, ntg, nba, nna, kia1, nna_l,
64 . k, kk, nnsa, nnsa_l, ki2,
65 . ntgm, nni, ntgi, nni_l
66 INTEGER, DIMENSION(:), ALLOCATABLE :: IBUF, IBUFA,ITAG,REDIR,IBUFSA
67C-----------------------------------------------
68! 1d array
69 ALLOCATE( itag(nb_node),redir(nb_node) )
70 ALLOCATE( ibufsa(nb_node) )
71
72! and deallocated in fvwrestp
73 ALLOCATE( fvspmd(nfvbag) )
74! ---------------------------------
75C
76 IF (proc==1)THEN
77 ntgm = 0
78 k1 = 1
79 DO i=1,nvolu
80 ityp=monvol(k1-1+2)
81 IF (ityp==6.OR.ityp==8) THEN
82 ntg=monvol(k1-1+33)
83 ELSE
84 ntg = 0
85 ENDIF
86 ntgm = max(ntgm,ntg)
87 k1=k1+nimv
88 ENDDO
89 ENDIF
90C
91 k1=1
92 k2=1+nimv*nvolu+licbag+libagjet+libaghol
93 ifv=0
94 DO i=1,nvolu
95 ityp=monvol(k1-1+2)
96 IF (ityp==6.OR.ityp==8) THEN
97 ifv=ifv+1
98 nn= monvol(k1-1+32)
99 ntg=monvol(k1-1+33)
100 nba=monvol(k1-1+62)
101 nna=monvol(k1-1+64)
102 nni=monvol(k1-1+68)
103 ntgi=monvol(k1-1+69)
104 ki1 =k2+monvol(k1-1+31)
105 kia1=k2+monvol(k1-1+20)-1
106C Noeuds de l'enveloppe
107 ALLOCATE(ibuf(nn+nni), ibufa(nna))
108 DO j=1,nn+nni
109 ibuf(j)=monvol(ki1-1+j)
110 ENDDO
111 DO j=1,nna
112 ibufa(j)=monvol(kia1-1+j)
113 ENDDO
114C Identification du PMAIN
115 nmax=0
116 pmain=1
117 DO p=1,nspmd
118 nn_l=0
119 DO j=1,nn
120 jj=ibuf(j)
121 IF(nlocal(jj,p)==1)THEN
122 DO pp = 1, p-1
123 IF(nlocal(jj,pp)==1)THEN
124 GOTO 100
125 ENDIF
126 ENDDO
127 nn_l=nn_l+1
128 100 CONTINUE
129 ENDIF
130 ENDDO
131 nni_l=0
132 DO j=nn+1,nn+nni
133 jj=ibuf(j)
134 IF(nlocal(jj,p)==1)THEN
135 DO pp = 1, p-1
136 IF(nlocal(jj,pp)==1)THEN
137 GOTO 200
138 ENDIF
139 ENDDO
140 nni_l=nni_l+1
141 200 CONTINUE
142 ENDIF
143 ENDDO
144 IF(nn_l+nni_l>nmax)THEN
145 pmain=p
146 nmax=nn_l+nni_l
147 ENDIF
148 ENDDO
149
150
151 IF ((ityp==6.OR.ityp==8) .AND. fvmain(ifv) >= 0) THEN
152 !FVMAIN(IFV) > 0 : The main processor was computed during domain decomposition
153 pmain = fvmain(ifv)
154 ENDIF
155 fvspmd(ifv)%PMAIN=pmain
156C Noeuds locaux
157 nn_l=0
158 DO j=1,nn
159 jj=ibuf(j)
160 IF (nodlocal(jj)/=0) nn_l=nn_l+1
161 ENDDO
162 nni_l=0
163 DO j=nn+1,nn+nni
164 jj=ibuf(j)
165 IF (nodlocal(jj)/=0) nni_l=nni_l+1
166 ENDDO
167 nna_l=0
168 DO j=1,nna
169 jj=ibufa(j)
170 IF (nodlocal(jj)/=0) nna_l=nna_l+1
171 ENDDO
172 fvspmd(ifv)%NN_L=nn_l
173 fvspmd(ifv)%NNI_L=nni_l
174 fvspmd(ifv)%NNA_L=nna_l
175
176 ALLOCATE(fvspmd(ifv)%IBUF_L(2,nn_l+nni_l),
177 . fvspmd(ifv)%IBUFA_L(2,nna_l))
178 nn_l=0
179 DO j=1,nn+nni
180 jj=ibuf(j)
181 IF (nodlocal(jj)/=0) THEN
182 nn_l=nn_l+1
183 fvspmd(ifv)%IBUF_L(1,nn_l)=j
184 fvspmd(ifv)%IBUF_L(2,nn_l)=nodlocal(jj)
185 ENDIF
186 ENDDO
187 nna_l=0
188 DO j=1,nna
189 jj=ibufa(j)
190 IF (nodlocal(jj)/=0) THEN
191 nna_l=nna_l+1
192 fvspmd(ifv)%IBUFA_L(1,nna_l)=j
193 fvspmd(ifv)%IBUFA_L(2,nna_l)=nodlocal(jj)
194 ENDIF
195 ENDDO
196 DEALLOCATE(ibuf, ibufa)
197C Solides additionnels
198 fvspmd(ifv)%NSA=nba
199 fvspmd(ifv)%NNSA=0
200 fvspmd(ifv)%NNSA_L=0
201 fvspmd(ifv)%NELSA=0
202 IF (nba>0) THEN
203 IF (proc==pmain) ALLOCATE(fvspmd(ifv)%IXSA(8,nba))
204 kia1=k2+monvol(k1-1+19)-1
205 DO j=1,nb_node
206 itag(j)=0
207 redir(j)=0
208 ENDDO
209 DO j=1,nba
210 jj=monvol(kia1-1+2*(j-1)+1)
211 DO k=1,8
212 kk=ixs(1+k,jj)
213 itag(kk)=1
214 ENDDO
215 ENDDO
216 nnsa=0
217 DO j=1,nb_node
218 IF (itag(j)==1) THEN
219 nnsa=nnsa+1
220 redir(j)=nnsa
221 ibufsa(nnsa)=j
222 ENDIF
223 ENDDO
224 fvspmd(ifv)%NNSA=nnsa
225 IF (proc==pmain) THEN
226 DO j=1,nba
227 jj=monvol(kia1-1+j)
228 DO k=1,8
229 kk=ixs(1+k,jj)
230 fvspmd(ifv)%IXSA(k,j)=redir(kk)
231 ENDDO
232 ENDDO
233C
234 fvspmd(ifv)%NELSA=ntg
235 ALLOCATE(fvspmd(ifv)%ELEMSA(3,ntg))
236 ki2=ki1+nn+nni
237 DO j=1,ntg
238 DO k=1,3
239 kk=monvol(ki2-1+3*(j-1)+k)
240 fvspmd(ifv)%ELEMSA(k,j)=redir(kk)
241 ENDDO
242 ENDDO
243 DO j=1,fvdata(ifv)%NNS
244 IF (fvdata(ifv)%IFVNOD(1,j)==2) THEN
245 jj=fvdata(ifv)%IFVNOD(2,j)
246 fvdata(ifv)%IFVNOD(2,j)=redir(jj)
247 ENDIF
248 ENDDO
249 ENDIF
250 nnsa_l=0
251 DO j=1,nnsa
252 jj=ibufsa(j)
253 IF (nodlocal(jj)/=0) nnsa_l=nnsa_l+1
254 ENDDO
255 fvspmd(ifv)%NNSA_L=nnsa_l
256 ALLOCATE(fvspmd(ifv)%IBUFSA_L(2,nnsa_l))
257 nnsa_l=0
258 DO j=1,nnsa
259 jj=ibufsa(j)
260 IF (nodlocal(jj)/=0) THEN
261 nnsa_l=nnsa_l+1
262 fvspmd(ifv)%IBUFSA_L(1,nnsa_l)=j
263 fvspmd(ifv)%IBUFSA_L(2,nnsa_l)=nodlocal(jj)
264 ENDIF
265 ENDDO
266 ENDIF
267 ENDIF
268 k1=k1+nimv
269 ENDDO
270C
271! 1d array
272 DEALLOCATE( itag,redir )
273 DEALLOCATE( ibufsa )
274! ---------------------------------
275 RETURN
276 END
c_fvbag
subroutine c_fvbag(monvol, nodlocal, ixs, proc, nb_node, fvmain)
Definition c_fvbag.F:34
max
#define max(a, b)
Definition macros.h:21
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvspmd
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
fvbag_mod::nfvbag
integer nfvbag
Definition fvbag_mod.F:127