OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbag2.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!|| fvbag2 ../engine/source/airbag/fvbag2.F
25!||--- called by ------------------------------------------------------
26!|| fvbag0 ../engine/source/airbag/fvbag0.F
27!||--- calls -----------------------------------------------------
28!|| spmd_ibcast_subcomm ../engine/source/mpi/generic/spmd_ibcast_subcomm.F
29!|| spmd_rbcast_subcomm ../engine/source/mpi/generic/spmd_rbcast_subcomm.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
33!|| fvmbag_meshcontrol_mod ../common_source/modules/airbag/fvmbag_meshcontrol_mod.F
34!|| h3d_mod ../engine/share/modules/h3d_mod.F
35!|| message_mod ../engine/share/message_module/message_mod.F
36!||====================================================================
37 SUBROUTINE fvbag2(IFV, ITYP, NNA, NVENT, NJET, IVOLU, IBAGHOL, RBAGHOL,
38 . X, RVOLU, XXXA, NCONA, RBAGJET ,
39 . A, LGAUGE , GAUGE , NNT ,FEXT , NSKIP,
40 . H3D_DATA, WEIGHT)
41C
42C Broadcast data from PMAIN to other processors
43C Arrays sent:
44C - GGG, GGA
45C - AAA
46C - XXXA
47C - IVOLU(49) (number of volumes, needed to switch to UP
48C - RVOLU, RBAGJET, IBAGHOL(1,:) broadcasted if switch to UP
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE fvbag_mod
53 USE message_mod
54 USE elbufdef_mod
55 USE fvmbag_meshcontrol_mod
56 USE h3d_mod
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "com08_c.inc"
67#include "param_c.inc"
68#include "units_c.inc"
69#include "task_c.inc"
70#include "scr14_c.inc"
71#include "scr16_c.inc"
72#include "parit_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER IFV, ITYP, NNA, NVENT, NJET, IVOLU(*), NCONA(16,*), IBAGHOL(NIBHOL,*)
77 my_real RVOLU(*), X(3,*), XXXA(3,*), RBAGJET(NRBJET,*), RBAGHOL(NRBHOL,*)
78 INTEGER NNT,LGAUGE(3,*)
79 INTEGER NSKIP
80 INTEGER, INTENT(IN) :: WEIGHT(NUMNOD) !< 0: current mpi process does not own the node, 1: current mpi process owns the node
81 my_real
82 . a(3,*),
83 . fext(3,*),
84 . gauge(llgauge,*)
85 TYPE(h3d_database) :: H3D_DATA
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER II,J,N21,N22,N1
90 INTEGER I, I1, I2, IFVENT, NPOLH
91 INTEGER IDEF(NVENT)
92 my_real ttf
93 LOGICAL :: UP_SWITCH, AUTO_SWITCH
94
95
96 IF(nskip >= 1 ) GOTO 90
97C Communications only if FVBAG1 has not been skipped
98 IF(nbgauge > 0)THEN
99 IF(nspmd > 1 .AND. fvspmd(ifv)%RANK > -1)THEN
100 CALL spmd_rbcast_subcomm(
101 . fvspmd(ifv)%GGG,3*nnt,0,fvspmd(ifv)%MPI_COMM)
102 CALL spmd_rbcast_subcomm(
103 . fvspmd(ifv)%GGA,3*nna,0,fvspmd(ifv)%MPI_COMM)
104 ENDIF
105C
106 ii=0
107 DO i=1,nbgauge
108 IF(lgauge(1,i) <=0 .AND. lgauge(1,i) >= -numels) ii=1
109 ENDDO
110 IF(ii == 0) GO TO 1200
111
112 DO i=1,nbgauge
113 IF(lgauge(1,i) > 0 .OR. lgauge(1,i) < -numels) cycle
114 IF(lgauge(1,i) == 0 . and. lgauge(3,i) > 0) THEN
115C Node input
116 n1=lgauge(3,i)
117 DO j=1,fvspmd(ifv)%NN_L+fvspmd(ifv)%NNI_L
118 n21=fvspmd(ifv)%IBUF_L(1,j)
119 n22=fvspmd(ifv)%IBUF_L(2,j)
120 IF(n22/=n1) cycle
121 gauge(30,i)=fvspmd(ifv)%GGG(1,n21)
122 gauge(31,i)=fvspmd(ifv)%GGG(2,n21)
123 gauge(32,i)=fvspmd(ifv)%GGG(3,n21)
124 GO TO 800
125 ENDDO
126 DO j=1,fvspmd(ifv)%NNA_L
127 n21=fvspmd(ifv)%IBUFA_L(1,j)
128 n22=fvspmd(ifv)%IBUFA_L(2,j)
129 IF(n22/=n1) cycle
130 gauge(30,i)=fvspmd(ifv)%GGA(1,n21)
131 gauge(31,i)=fvspmd(ifv)%GGA(2,n21)
132 gauge(32,i)=fvspmd(ifv)%GGA(3,n21)
133 GO TO 800
134 ENDDO
135 gauge(30,i)=zero
136 gauge(31,i)=zero
137 gauge(32,i)=zero
138 ELSEIF( lgauge(3,i) < 0 )THEN
139C Shell input -not available
140 ELSEIF(lgauge(1,i) == 0 . and. lgauge(3,i) == 0)THEN
141C Point input (by coordinates) -not available
142 ENDIF
143 800 CONTINUE
144 ENDDO
145
146 1200 CONTINUE
147 ENDIF
148 IF(nspmd > 1 .AND. fvspmd(ifv)%RANK > -1)THEN
149 CALL spmd_rbcast_subcomm(fvspmd(ifv)%AAA,3*nnt ,0,
150 . fvspmd(ifv)%MPI_COMM)
151 CALL spmd_ibcast_subcomm(ivolu(49),1,0,fvspmd(ifv)%MPI_COMM)
152 CALL spmd_rbcast_subcomm(fvdata(ifv)%PDISP_OLD,1,0,fvspmd(ifv)%MPI_COMM)
153 CALL spmd_rbcast_subcomm(fvdata(ifv)%PDISP,1,0,fvspmd(ifv)%MPI_COMM)
154 ENDIF
155 DO i=1,fvspmd(ifv)%NN_L+fvspmd(ifv)%NNI_L
156 i1=fvspmd(ifv)%IBUF_L(1,i)
157 i2=fvspmd(ifv)%IBUF_L(2,i)
158 IF(weight(i2) > 0 .OR. iparit .NE. 0) THEN
159 a(1,i2)=a(1,i2)+fvspmd(ifv)%AAA(1,i1)
160 a(2,i2)=a(2,i2)+fvspmd(ifv)%AAA(2,i1)
161 a(3,i2)=a(3,i2)+fvspmd(ifv)%AAA(3,i1)
162 ENDIF
163 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT
164 . +anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT >0) THEN
165 fext(1,i2) = fext(1,i2)+fvspmd(ifv)%AAA(1,i1)
166 fext(2,i2) = fext(2,i2)+fvspmd(ifv)%AAA(2,i1)
167 fext(3,i2) = fext(3,i2)+fvspmd(ifv)%AAA(3,i1)
168 ENDIF
169 ENDDO
170
17190 CONTINUE
172C
173
174C----------------------------
175C POSITION FOR VISUALISATION
176C----------------------------
177 IF( fvspmd(ifv)%NNA_L_GLOB > 0) THEN
178 ! The BCAST is necessary if at least one proc. has NNA_L > 0
179 IF(nspmd > 1 .AND. fvspmd(ifv)%RANK > -1 )THEN
180
181 CALL spmd_rbcast_subcomm(xxxa,3*nna,0,
182 . fvspmd(ifv)%MPI_COMM)
183
184 ENDIF
185 IF (kmesh(ifv) < 2) THEN
186 DO i=1,fvspmd(ifv)%NNA_L
187 i1=fvspmd(ifv)%IBUFA_L(1,i)
188 IF(ncona(2,i1) /= 0) cycle
189 i2=fvspmd(ifv)%IBUFA_L(2,i)
190 x(1,i2)=xxxa(1,i1)
191 x(2,i2)=xxxa(2,i1)
192 x(3,i2)=xxxa(3,i1)
193 ENDDO
194 ENDIF
195 ENDIF
196
197 IF(nbgauge > 0) THEN
198 DEALLOCATE(fvspmd(ifv)%GGG)
199 DEALLOCATE(fvspmd(ifv)%GGA)
200 ENDIF
201 DEALLOCATE(fvspmd(ifv)%AAA)
202
203 IF(ityp /= 8 ) RETURN
204C -------------------
205C SWITCH TO UP
206C -------------------
207 ttf =rvolu(49)
208 npolh=ivolu(49)
209 IF (ivolu(74) <= 0) THEN
210 up_switch = tt-ttf >= rvolu(70) .OR. npolh <= ivolu(37)
211 auto_switch = .false.
212 ENDIF
213 IF (ivolu(74) > 0) THEN
214C Automatic switch to uniform pressure when dispersion of pressure is low
215 auto_switch = (fvdata(ifv)%PDISP < fvdata(ifv)%PDISP_OLD) .AND.
216 . (fvdata(ifv)%PDISP < rvolu(73))
217 up_switch = tt-ttf >= rvolu(70)
218 up_switch = up_switch .OR. auto_switch
219 fvdata(ifv)%PDISP_OLD = fvdata(ifv)%PDISP
220 ENDIF
221
222 IF (up_switch .AND. ivolu(74)==2)THEN
223 !Iswitch=2 : full merging request on Tswitch/Pswitch criteria
224 ivolu(74) = 0 ! Iswitch reset to 0
225 ivolu(60) = -1 ! Igmerg/Ivmin => VOLUMIN=EP20 in fvupd.F => merge everything
226 rvolu(70) = ep20 ! TSWITCH=infinity to prevent from any switch to Uniform Pressure
227 rvolu(73) = zero ! PSWITCH RATIO=0 to prevent from any switch to Uniform Pressure
228 up_switch = .false.
229 IF(ispmd+1 == fvspmd(ifv)%PMAIN) THEN
230 WRITE(iout,'(A,I10,A,E12.4/)')
231 . ' ** MONITORED VOLUME ID: ',ivolu(1),
232 . ' ALL POLYHEDRA ARE GOING TO BE MERGED ',tt
233 ENDIF
234 ENDIF
235
236 IF (up_switch) THEN
237 IF (ivolu(74) == 0 .OR. ivolu(74) == 1) THEN
238 DO i=1,nvent
239 IF(ibaghol(1,i) == 2) ibaghol(1,i) = 0
240 idef(i) = ibaghol(1,i)
241 ENDDO
242 IF(nspmd > 1 .AND. fvspmd(ifv)%RANK > -1 )THEN
243 CALL spmd_rbcast_subcomm(rvolu,nrvolu,0,fvspmd(ifv)%MPI_COMM)
244 CALL spmd_rbcast_subcomm(rbagjet,nrbjet*njet,0,fvspmd(ifv)%MPI_COMM)
245 CALL spmd_ibcast_subcomm(idef,nvent,0,fvspmd(ifv)%MPI_COMM)
246 ENDIF
247 ivolu(2) = 7
248 ivolu(15)=-1
249 IF(ispmd+1 == fvspmd(ifv)%PMAIN) THEN
250 WRITE(iout,'(a,i10,a,e12.4/)')
251 . ' ** monitored volume id: ',IVOLU(1),
252 . ' is switched to uniform pressure at time',TT
253 IF (AUTO_SWITCH) THEN
254 WRITE(IOUT, '(a,e12.4)')
255 . '->auto switch due to low standard deviation of pressure around its average:',
256 . FVDATA(IFV)%PDISP
257 ENDIF
258 ENDIF
259 DO I=1,NVENT
260 IFVENT=IBAGHOL(10,I)
261 IBAGHOL(1,I) = IDEF(I)
262 IF(IFVENT == 2) IBAGHOL(10,I)=1
263 IF(IFVENT == 3) IBAGHOL(10,I)=2
264 ENDDO
265 ELSE IF (IVOLU(74) == 2) THEN
266! Cmerg
267 RVOLU(31) = EP30
268! Tswitch
269 RVOLU(70) = EP30
270! Iswitch
271 IVOLU(74) = -2
272.AND. IF(NSPMD > 1 FVSPMD(IFV)%RANK > -1 )THEN
273 CALL SPMD_RBCAST_SUBCOMM(RVOLU,NRVOLU,0,FVSPMD(IFV)%MPI_COMM)
274 CALL SPMD_RBCAST_SUBCOMM(RBAGJET,NRBJET*NJET,0,FVSPMD(IFV)%MPI_COMM)
275 CALL SPMD_IBCAST_SUBCOMM(IDEF,NVENT,0,FVSPMD(IFV)%MPI_COMM)
276 ENDIF
277
278 IF(ISPMD+1 == FVSPMD(IFV)%PMAIN) THEN
279 WRITE(IOUT,'(a,i10,a,e12.4/)')
280 . ' ** monitored volume id: ',IVOLU(1),
281 . ' is switched to 1 finite volume at time',TT
282 IF (AUTO_SWITCH) THEN
283 WRITE(IOUT, '(a,e12.4)')
284 . '->auto switch due to low standard deviation of pressure around its average:',
285 . FVDATA(IFV)%PDISP
286 ENDIF
287 ENDIF
288 ENDIF
289 ENDIF
290 RETURN
291 END
292
fvbag2
subroutine fvbag2(ifv, ityp, nna, nvent, njet, ivolu, ibaghol, rbaghol, x, rvolu, xxxa, ncona, rbagjet, a, lgauge, gauge, nnt, fext, nskip, h3d_data, weight)
Definition fvbag2.F:41
id
initmumps id
Definition multiplerhs_example.m:4
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
fvmbag_meshcontrol_mod
Definition fvmbag_meshcontrol_mod.F:46
fvmbag_meshcontrol_mod::kmesh
integer, dimension(:), allocatable kmesh
Definition fvmbag_meshcontrol_mod.F:48
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
spmd_ibcast_subcomm
subroutine spmd_ibcast_subcomm(buffer, n, from, comm)
Definition spmd_ibcast_subcomm.F:30
spmd_rbcast_subcomm
subroutine spmd_rbcast_subcomm(buffer, n, from, comm)
Definition spmd_rbcast_subcomm.F:32
h3d_mod::h3d_database
Definition h3d_mod.F:435