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