OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbag2.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fvbag2 (ifv, ityp, nna, nvent, njet, ivolu, ibaghol, rbaghol, x, rvolu, xxxa, ncona, rbagjet, a, lgauge, gauge, nnt, fext, nskip, h3d_data, weight)

Function/Subroutine Documentation

◆ fvbag2()

subroutine fvbag2 ( integer ifv,
integer ityp,
integer nna,
integer nvent,
integer njet,
integer, dimension(*) ivolu,
integer, dimension(nibhol,*) ibaghol,
rbaghol,
x,
rvolu,
xxxa,
integer, dimension(16,*) ncona,
rbagjet,
a,
integer, dimension(3,*) lgauge,
gauge,
integer nnt,
fext,
integer nskip,
type(h3d_database) h3d_data,
integer, dimension(numnod), intent(in) weight )
Parameters
[in]weight0: current mpi process does not own the node, 1: current mpi process owns the node

Definition at line 37 of file fvbag2.F.

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 IF(nspmd > 1 .AND. 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
my_real
#define my_real
Definition cppsort.cpp:32
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