OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvupd.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!|| fvupd0 ../engine/source/airbag/fvupd.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| fvupd1 ../engine/source/airbag/fvupd.F
29!|| spmd_fvb_gath_begin ../engine/source/mpi/airbags/spmd_fvb.F
30!||--- uses -----------------------------------------------------
31!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
32!||====================================================================
33 SUBROUTINE fvupd0(MONVOL, X, V, VOLMON, SMONVOL, SVOLMON)
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 "com08_c.inc"
48#include "param_c.inc"
49C DTMIN
50#include "scr18_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER,INTENT(IN) :: SMONVOL, SVOLMON
55 INTEGER MONVOL(SMONVOL)
56 my_real x(3,numnod), v(3,numnod), volmon(svolmon)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER IADPOLH, K1, K2, KIBJET, KIBHOL, KIBALE, N, ITYP, NNS,
61 . NTG, NBRIC, KI1, KI2, NNFV, NTRFV, NPOLH, KK1, NPOLY, ID,
62 . IFV, IMESH, IVMIN, NBA, NTGA, KIA1, KIA2, KIA3, KIA4,
63 . KIA5, KIA6, KIA7, KIA8, NNA, ILVOUT, NNI, NTGI, NNT ,
64 . KK2, KRBJET, KRBHOL, KRBALE, KR1, KRA5, KRA6
65 INTEGER NFVMERGE(4), NSKIP, IEQUI, IVINI
66 INTEGER NSKIP_TAB(NVOLU)
67 my_real :: fvbag_dtmin
68C-----------------------------------------------
69C S o u r c e L i n e s
70C-----------------------------------------------
71 iadpolh=1
72 k1=1
73 k2=1+nimv*nvolu
74 kibjet=k2+licbag
75 kibhol=kibjet+libagjet
76 kibale=kibhol+libaghol
77 kk1=1
78 kk2=1+nrvolu*nvolu
79 krbjet=kk2+lrcbag
80 krbhol=krbjet+lrbagjet
81 krbale=krbhol+lrbaghol
82 ifv=0
83C
84 DO n=1,nvolu
85 ityp=monvol(k1-1+2)
86 IF (ityp==6.OR.ityp==8) THEN
87 ifv=monvol(k1-1+45)
88
89C
90 iequi=monvol(k1-1+15)
91 ivini=monvol(k1-1+38)
92 IF(tt < volmon(kk1-1+49).AND.iequi >= 1) THEN
93 IF(ivini == 1) THEN
94 nskip=mod(ncycle,iequi)
95 IF(nskip == 0) THEN
96 monvol(k1-1+39)=1
97 ELSE
98 nskip=0
99 monvol(k1-1+39)=0
100 ENDIF
101 ELSE
102 monvol(k1-1+39)=1
103 nskip=mod(ncycle,iequi)
104 ENDIF
105 ELSE
106 monvol(k1-1+39)=1
107 nskip=0
108 ENDIF
109 nskip_tab(n) = nskip
110 IF(nskip >= 1) GO TO 200
111
112 imesh=monvol(k1-1+56)
113 IF (imesh==0) THEN
114
115
116 nns=monvol(k1-1+32)
117 nni=monvol(k1-1+68)
118 nnt= nns+nni
119 nna= monvol(k1-1+64)
120
121 ALLOCATE(fvspmd(ifv)%XXX(3,max(1,nnt)))
122 ALLOCATE(fvspmd(ifv)%VVV(3,max(1,nnt)))
123 ALLOCATE(fvspmd(ifv)%WAV(3,max(1,nna)))
124 ALLOCATE(fvspmd(ifv)%WAX(3,max(1,nna)))
125 fvspmd(ifv)%XXX(1:3,1:max(1,nnt)) = zero
126 fvspmd(ifv)%VVV(1:3,1:max(1,nnt)) = zero
127 fvspmd(ifv)%WAV(1:3,1:max(1,nna)) = zero
128 fvspmd(ifv)%WAX(1:3,1:max(1,nna)) = zero
129 IF( nspmd > 1 ) THEN
130 CALL spmd_fvb_gath_begin(ifv,x,fvspmd(ifv)%XXX,fvspmd(ifv)%WAX,
131 . v,fvspmd(ifv)%VVV,fvspmd(ifv)%WAV )
132 ENDIF
133 ENDIF
134 ENDIF
135 200 k1=k1+nimv
136 kk1=kk1+nrvolu
137 ENDDO
138
139 iadpolh=1
140 k1=1
141 k2=1+nimv*nvolu
142 kibjet=k2+licbag
143 kibhol=kibjet+libagjet
144 kibale=kibhol+libaghol
145 kk1=1
146 kk2=1+nrvolu*nvolu
147 krbjet=kk2+lrcbag
148 krbhol=krbjet+lrbagjet
149 krbale=krbhol+lrbaghol
150 ifv=0
151C
152
153 DO n=1,nvolu
154 ityp=monvol(k1-1+2)
155 IF (ityp==6.OR.ityp==8) THEN
156 ifv=monvol(k1-1+45)
157 IF(nskip_tab(n) >= 1) GO TO 100
158 imesh=monvol(k1-1+56)
159 IF (imesh==1) THEN
160 monvol(k1-1+56)=0
161 ELSE
162C
163 id=monvol(k1)
164 nns=monvol(k1-1+32)
165 ntg=monvol(k1-1+33)
166 nni=monvol(k1-1+68)
167 nnt= nns+nni
168 ntgi= monvol(k1-1+69)
169 nbric=monvol(k1-1+35)
170 ki1=kibale+monvol(k1-1+31)
171 ki2=ki1+nnt
172 kr1=krbale+monvol(k1-1+34)
173C
174 nnfv= monvol(k1-1+46)
175 ntrfv=monvol(k1-1+47)
176 npoly=monvol(k1-1+48)
177 npolh=monvol(k1-1+49)
178 ivmin=monvol(k1-1+60)
179 ilvout=monvol(k1-1+44)
180C
181 nba= monvol(k1-1+62)
182 ntga=monvol(k1-1+63)
183 nna= monvol(k1-1+64)
184 kia1=ki2 +6*(ntg+ntgi)
185 kia2=kia1+2*nba
186 kia3=kia2+12*nba
187 kia4=kia3+2*(ntg+ntgi)
188 kia5=kia4+nna
189 kia6=kia5+3*ntga
190 kia7=kia6+ntga
191 kia8=kia7+8*nba
192C
193 kra5=min(svolmon, kr1+7*(nns+nni)+4*(ntg+ntgi)+6*nna)
194 kra6=kra5+3*nna
195C
196 nfvmerge(1)=0
197 nfvmerge(2)=0
198 nfvmerge(3)=0
199 nfvmerge(4)=0
200C
201 IF (ityp == 8) THEN
202 fvbag_dtmin = fvdata(ifv)%DTMIN
203 ELSE
204 fvbag_dtmin = dtmin1(52)
205 ENDIF
206 CALL fvupd1(
207 . ntg, monvol(ki1), monvol(ki2) , x , npolh ,
208 . fvdata(ifv)%MPOLH, fvdata(ifv)%QPOLH, fvdata(ifv)%EPOLH , v ,
209 . fvdata(ifv)%PPOLH, fvdata(ifv)%RPOLH, fvdata(ifv)%GPOLH ,
210 . fvdata(ifv)%IFVNOD, fvdata(ifv)%RFVNOD, fvdata(ifv)%IFVTRI ,
211 . fvdata(ifv)%IFVPOLY, fvdata(ifv)%IFVTADR, fvdata(ifv)%IFVPOLH ,
212 . fvdata(ifv)%IFVPADR, nnfv, ntrfv , volmon(kk1), npoly ,
213 . id, fvdata(ifv)%CPAPOLH, fvdata(ifv)%CPBPOLH ,
214 . fvdata(ifv)%CPCPOLH, fvdata(ifv)%RMWPOLH, fvdata(ifv)%VPOLH_INI,
215 . ivmin, fvdata(ifv)%IDPOLH , monvol(kia4) ,
216 . monvol(kia5), monvol(kia6), fvdata(ifv)%IBPOLH ,
217 . fvdata(ifv)%REDIR_ANIM,fvdata(ifv)%NOD_ANIM,fvdata(ifv)%NNS_ANIM ,
218 . fvdata(ifv)%NPOLH_ANIM,fvdata(ifv)%DTPOLH ,ilvout , nnt , nna ,
219 . ifv, volmon(kra5), fvdata(ifv)%TPOLH ,
220 . fvdata(ifv)%CPDPOLH, fvdata(ifv)%CPEPOLH, fvdata(ifv)%CPFPOLH ,
221 . ityp, nfvmerge, volmon(kra6) ,
222 . monvol(kia8), monvol(k1) , fvbag_dtmin , numnod)
223C
224 monvol(k1-1+49)=npolh
225 fvdata(ifv)%NPOLH=npolh
226 monvol(k1-1+70)=monvol(k1-1+70)+nfvmerge(1)
227 monvol(k1-1+71)=monvol(k1-1+71)+nfvmerge(2)
228 monvol(k1-1+72)=monvol(k1-1+72)+nfvmerge(3)
229 monvol(k1-1+73)=monvol(k1-1+73)+nfvmerge(4)
230 ENDIF
231 ENDIF
232 100 k1=k1+nimv
233 kk1=kk1+nrvolu
234 ENDDO
235C
236 RETURN
237 END
238C
239!||====================================================================
240!|| fvupd1 ../engine/source/airbag/fvupd.F
241!||--- called by ------------------------------------------------------
242!|| fvupd0 ../engine/source/airbag/fvupd.F
243!||--- calls -----------------------------------------------------
244!|| fvtemp ../engine/source/airbag/fvtemp.F
245!|| spmd_fvb_gath_end ../engine/source/mpi/airbags/spmd_fvb.F
246!||--- uses -----------------------------------------------------
247!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
248!|| fvmbag_meshcontrol_mod ../common_source/modules/airbag/fvmbag_meshcontrol_mod.F
249!||====================================================================
250 SUBROUTINE fvupd1(NEL , IBUF , ELEM , X , NPOLH ,
251 . MPOLH , QPOLH , EPOLH , V ,
252 . PPOLH , RPOLH , GPOLH ,
253 . IFVNOD , RFVNOD , IFVTRI ,
254 . IFVPOLY , IFVTADR , IFVPOLH ,
255 . IFVPADR , NNS , NNTR , RVOLU, NPOLY ,
256 . ID , CPAPOLH , CPBPOLH ,
257 . CPCPOLH , RMWPOLH , VPOLH_INI,
258 . IVMIN , IDPOLH , IBUFA ,
259 . ELEMA , TAGELA , IBPOLH ,
260 . REDIR_ANIM, NOD_ANIM, NNS_ANIM ,
261 . NPOLH_ANIM, DTPOLH , ILVOUT , NNT , NNA ,
262 . IFV , XXXA , TPOLH,
263 . CPDPOLH , CPEPOLH , CPFPOLH ,
264 . ITYP , NFVMERGE, VVVA ,
265 . NCONA , IVOLU ,FVBAG_DTMIN, NUMNOD)
266C-----------------------------------------------
267C M o d u l e s
268C-----------------------------------------------
269 USE fvbag_mod
270 USE fvmbag_meshcontrol_mod
271C-----------------------------------------------
272C I m p l i c i t T y p e s
273C-----------------------------------------------
274#include "implicit_f.inc"
275C-----------------------------------------------
276C C o m m o n B l o c k s
277C-----------------------------------------------
278#include "scr18_c.inc"
279#include "com01_c.inc"
280#include "com08_c.inc"
281#include "units_c.inc"
282#include "task_c.inc"
283#include "mvsiz_p.inc"
284C-----------------------------------------------
285C D u m m y A r g u m e n t s
286C-----------------------------------------------
287 INTEGER, INTENT(IN) :: NUMNOD, NNTR, NNS,NNS_ANIM, NPOLH_ANIM,ILVOUT, NNT, NNA, IFV, ITYP,NPOLY, ID, IVMIN, NEL
288 INTEGER,INTENT(INOUT) ::NPOLH
289 INTEGER IBUF(*), ELEM(3,*), IFVNOD(3,*), IFVTRI(6,NNTR),
290 . IFVPOLY(*), IFVTADR(*), IFVPOLH(*), IFVPADR(*),
291 . IDPOLH(*), IBUFA(*), ELEMA(3,*),
292 . TAGELA(*), IBPOLH(*), REDIR_ANIM(*),
293 . NFVMERGE(4), NCONA(16,*),
294 . IVOLU(*)
295 my_real
296 . X(3,NUMNOD), MPOLH(NPOLH), QPOLH(3,NPOLH), EPOLH(NPOLH), PPOLH(NPOLH),
297 . RPOLH(NPOLH), GPOLH(NPOLH), RFVNOD(2,NNS), RVOLU(*),
298 . CPAPOLH(NPOLH), CPBPOLH(NPOLH), CPCPOLH(NPOLH), RMWPOLH(NPOLH),
299 . VPOLH_INI(NPOLH), NOD_ANIM(3,NNS_ANIM), DTPOLH(NPOLH), XXXA(3,*),
300 . TPOLH(NPOLH), CPDPOLH(NPOLH), CPEPOLH(NPOLH), CPFPOLH(NPOLH),
301 . V(3,NUMNOD) , VVVA(3,*), FVBAG_DTMIN
302C-----------------------------------------------
303C L o c a l V a r i a b l e s
304C-----------------------------------------------
305 INTEGER I, IEL, N1, N2, N3, J, JJ, K, KK, NPA,
306 . IMAX, IP1, IP2, ITAG(NPOLH), ITAGP(NPOLY),
307 . COUNT(NPOLH), II, CC, LEN, NPOLH_OLD, NNP,
308 . IFVPADR_OLD(NPOLH+1), REDIR(NPOLH), ILOOP,
309 . POLHAPP(2,NPOLY), CMAX, ITYPM,
310 . idp1, idp2, idpolh_old(npolh), ibpolh_old(npolh), i1, i2,
311 . nnsa,kkk,ip3,itypl,dtmergv12
312 my_real
313 . ksi, eta, x1, y1, z1, x2, y2, z2, x3, y3, z3,
314 . pnod(3,nns), x12, y12, z12, x13, y13, z13, nrx, nry,
315 . nrz, area2, parea(nntr), pnorm(3,nntr), pvolu(npolh),
316 . area, nx, ny, nz, vm, areamax, mpolh_old(npolh),
317 . qpolh_old(3,npolh), epolh_old(npolh), pvolu_old(npolh),
318 . volumin, areapoly(npoly), cpapolh_old(npolh),
319 . cpbpolh_old(npolh), cpcpolh_old(npolh),
320 . rmwpolh_old(npolh), gpolh_old(npolh),
321 . vpolh_ini_old(npolh), vvmax(npolh), vol1,
322 . vol2, dtmin, fac, dtpolh_old(npolh),
323 . tpolh_old(npolh), cpdpolh_old(npolh), cpepolh_old(npolh),
324 . cpfpolh_old(npolh), efac, cpa, cpb, cpc, cpd, cpe, cpf,
325 . rmw, temp0, temp, pvoltmp,
326 . masspolh, dti
327C
328 INTEGER, ALLOCATABLE :: MERGE(:,:), IFVPOLH_OLD(:)
329C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
330 IF (NSPMD == 1) then
331C traitement necessaire pour rester p/on
332 DO i=1,fvspmd(ifv)%NN_L+fvspmd(ifv)%NNI_L
333 i1=fvspmd(ifv)%IBUF_L(1,i)
334 i2=fvspmd(ifv)%IBUF_L(2,i)
335 fvspmd(ifv)%XXX(1,i1)=x(1,i2)
336 fvspmd(ifv)%XXX(2,i1)=x(2,i2)
337 fvspmd(ifv)%XXX(3,i1)=x(3,i2)
338 ENDDO
339C
340 IF (kmesh(ifv) >= 2) THEN
341 DO i = 1, fvspmd(ifv)%NNA_L
342 i1=fvspmd(ifv)%IBUFA_L(1,i)
343 i2=fvspmd(ifv)%IBUFA_L(2,i)
344 IF(ncona(2,i) == 1) THEN
345 fvspmd(ifv)%WAX(1,i1)=x(1,i2)
346 fvspmd(ifv)%WAX(2,i1)=x(2,i2)
347 fvspmd(ifv)%WAX(3,i1)=x(3,i2)
348 ELSE
349 fvspmd(ifv)%WAX(1,i1)=xxxa(1,i1)
350 fvspmd(ifv)%WAX(2,i1)=xxxa(2,i1)
351 fvspmd(ifv)%WAX(3,i1)=xxxa(3,i1)
352 ENDIF
353 ENDDO
354 ELSE
355 DO i=1,fvspmd(ifv)%NNA_L
356 i1=fvspmd(ifv)%IBUFA_L(1,i)
357 i2=fvspmd(ifv)%IBUFA_L(2,i)
358 fvspmd(ifv)%WAX(1,i1)=x(1,i2)
359 fvspmd(ifv)%WAX(2,i1)=x(2,i2)
360 fvspmd(ifv)%WAX(3,i1)=x(3,i2)
361 ENDDO
362 ENDIF
363C WA utilise temporairement pour stocker XXXA
364 DO i=1,nna
365 xxxa(1,i)=fvspmd(ifv)%WAX(1,i)
366 xxxa(2,i)=fvspmd(ifv)%WAX(2,i)
367 xxxa(3,i)=fvspmd(ifv)%WAX(3,i)
368 END DO
369C
370 DO i=1,fvspmd(ifv)%NN_L+fvspmd(ifv)%NNI_L
371 i1=fvspmd(ifv)%IBUF_L(1,i)
372 i2=fvspmd(ifv)%IBUF_L(2,i)
373 fvspmd(ifv)%VVV(1,i1)=v(1,i2)
374 fvspmd(ifv)%VVV(2,i1)=v(2,i2)
375 fvspmd(ifv)%VVV(3,i1)=v(3,i2)
376 ENDDO
377C
378 IF (kmesh(ifv) >= 2) THEN
379 DO i = 1, fvspmd(ifv)%NNA_L
380 i1=fvspmd(ifv)%IBUFA_L(1,i)
381 i2=fvspmd(ifv)%IBUFA_L(2,i)
382 IF(ncona(2,i) == 1) THEN
383 fvspmd(ifv)%WAV(1,i1)=v(1,i2)
384 fvspmd(ifv)%WAV(2,i1)=v(2,i2)
385 fvspmd(ifv)%WAV(3,i1)=v(3,i2)
386 ELSE
387 fvspmd(ifv)%WAV(1,i1)=vvva(1,i1)
388 fvspmd(ifv)%WAV(2,i1)=vvva(2,i1)
389 fvspmd(ifv)%WAV(3,i1)=vvva(3,i1)
390 ENDIF
391 ENDDO
392 ELSE
393 DO i=1,fvspmd(ifv)%NNA_L
394 i1=fvspmd(ifv)%IBUFA_L(1,i)
395 i2=fvspmd(ifv)%IBUFA_L(2,i)
396 fvspmd(ifv)%WAV(1,i1)=v(1,i2)
397 fvspmd(ifv)%WAV(2,i1)=v(2,i2)
398 fvspmd(ifv)%WAV(3,i1)=v(3,i2)
399 ENDDO
400 ENDIF
401C WA utilise temporairement pour stocker VVVA
402 DO i=1,nna
403 IF(ncona(2,i) == 1) THEN
404 vvva(1,i)=fvspmd(ifv)%WAV(1,i)
405 vvva(2,i)=fvspmd(ifv)%WAV(2,i)
406 vvva(3,i)=fvspmd(ifv)%WAV(3,i)
407 ENDIF
408 ENDDO
409C
410 ELSE
411
412
413
414
415
416C
417 nnsa=fvspmd(ifv)%NNSA
418C Cacher XXX, VVV WAX WA dans FVSPMD
419c CALL SPMD_FVB_GATH_BEGIN(IFV,X,FVSPMD(IFV)%XXX,FVSPMD(IFV)%WAX,
420c . V,FVSPMD(IFV)%VVV,FVSPMD(IFV)%WAV )
421 CALL spmd_fvb_gath_end(ifv,x,fvspmd(ifv)%XXX,fvspmd(ifv)%WAX,
422 . v,fvspmd(ifv)%VVV,fvspmd(ifv)%WAV )
423
424c CALL SPMD_FVB_GATH(IFV, X, XXX, WA, XXXSA, 3)
425C WA utilise temporairement pour stocker XXXA
426 IF (kmesh(ifv) >= 2) THEN
427 DO i=1,nna
428 IF (ncona(2, i) /= 0) THEN
429 xxxa(1,i)=fvspmd(ifv)%WAX(1,i)
430 xxxa(2,i)=fvspmd(ifv)%WAX(2,i)
431 xxxa(3,i)=fvspmd(ifv)%WAX(3,i)
432 ENDIF
433 END DO
434 ELSE
435
436 DO i=1,nna
437 xxxa(1,i)=fvspmd(ifv)%WAX(1,i)
438 xxxa(2,i)=fvspmd(ifv)%WAX(2,i)
439 xxxa(3,i)=fvspmd(ifv)%WAX(3,i)
440 END DO
441 ENDIF
442C
443
444C XXXSA et VVVSA utilise temporairement
445C WA utilise temporairement pour stocker VVVA
446 DO i=1,nna
447 IF(ncona(2,i) == 1) THEN
448 vvva(1,i)=fvspmd(ifv)%WAV(1,i)
449 vvva(2,i)=fvspmd(ifv)%WAV(2,i)
450 vvva(3,i)=fvspmd(ifv)%WAV(3,i)
451 END IF
452 END DO
453C
454 IF (ispmd/=fvspmd(ifv)%PMAIN-1) GOTO 300
455 ENDIF
456C
457 IF(tt == dt1) THEN
458 dti = dt1
459 ELSE
460 dti = dt12
461 ENDIF
462
463
464!$OMP PARALLEL PRIVATE(I,II,J,JJ,K,KK,IP1,IP2,IEL,AREA,NX,NY,NZ,PVOLTMP)
465!$OMP+ PRIVATE(X1,Y1,Z1,N1,N2,N3,X12,Y12,Z12,X13,Y13,Z13)
466!$OMP+ PRIVATE(X2,Y2,Z2,X3,Y3,Z3,NRX,NRY,NRZ,AREA2)
467!$OMP+ PRIVATE(KSI,ETA,FAC,I1,I2)
468C
469C Calcul position et vitesse des noeuds internes
470!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
471 DO i=1,nna
472 IF(ncona(2,i) == 0) THEN
473 fvspmd(ifv)%WAV(1,i)=zero
474 fvspmd(ifv)%WAV(2,i)=zero
475 fvspmd(ifv)%WAV(3,i)=zero
476 ii=ncona(1,i)
477 IF(ii==0) cycle
478 DO j=1,ii
479 k=ncona(j+2,i)
480 fvspmd(ifv)%WAV(1,i)=fvspmd(ifv)%WAV(1,i)+vvva(1,k)
481 fvspmd(ifv)%WAV(2,i)=fvspmd(ifv)%WAV(2,i)+vvva(2,k)
482 fvspmd(ifv)%WAV(3,i)=fvspmd(ifv)%WAV(3,i)+vvva(3,k)
483 ENDDO
484 fvspmd(ifv)%WAV(1,i)=fvspmd(ifv)%WAV(1,i)/ii
485 fvspmd(ifv)%WAV(2,i)=fvspmd(ifv)%WAV(2,i)/ii
486 fvspmd(ifv)%WAV(3,i)=fvspmd(ifv)%WAV(3,i)/ii
487 ENDIF
488 ENDDO
489!$OMP END DO
490
491 IF(dt1 == zero) THEN
492!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
493 DO i=1,nna
494 IF(ncona(2,i) == 0) THEN
495 fvspmd(ifv)%WAV(1,i)=rvolu(67)
496 fvspmd(ifv)%WAV(2,i)=rvolu(68)
497 fvspmd(ifv)%WAV(3,i)=rvolu(69)
498 ENDIF
499 ENDDO
500!$OMP END DO
501 ENDIF
502
503C Calcul la position des noeuds internes
504!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
505 DO i=1,nna
506 IF(ncona(2,i) == 0) THEN
507 vvva(1,i)=fvspmd(ifv)%WAV(1,i)
508 vvva(2,i)=fvspmd(ifv)%WAV(2,i)
509 vvva(3,i)=fvspmd(ifv)%WAV(3,i)
510 xxxa(1,i)=xxxa(1,i)+dti*fvspmd(ifv)%WAV(1,i)
511 xxxa(2,i)=xxxa(2,i)+dti*fvspmd(ifv)%WAV(2,i)
512 xxxa(3,i)=xxxa(3,i)+dti*fvspmd(ifv)%WAV(3,i)
513 ENDIF
514 ENDDO
515!$omp END DO
516
517
518C Calcul la position de tous les points
519!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
520 DO i=1,nns
521 IF (ifvnod(1,i)==1) THEN
522 iel=ifvnod(2,i)
523 ksi=rfvnod(1,i)
524 eta=rfvnod(2,i)
525C
526 n1=elema(1,iel)
527 n2=elema(2,iel)
528 n3=elema(3,iel)
529 IF (tagela(iel)>0) THEN
530 x1=fvspmd(ifv)%XXX(1,n1)
531 y1=fvspmd(ifv)%XXX(2,n1)
532 z1=fvspmd(ifv)%XXX(3,n1)
533 x2=fvspmd(ifv)%XXX(1,n2)
534 y2=fvspmd(ifv)%XXX(2,n2)
535 z2=fvspmd(ifv)%XXX(3,n2)
536 x3=fvspmd(ifv)%XXX(1,n3)
537 y3=fvspmd(ifv)%XXX(2,n3)
538 z3=fvspmd(ifv)%XXX(3,n3)
539 ELSEIF (tagela(iel)<0) THEN
540 x1=xxxa(1,n1)
541 y1=xxxa(2,n1)
542 z1=xxxa(3,n1)
543 x2=xxxa(1,n2)
544 y2=xxxa(2,n2)
545 z2=xxxa(3,n2)
546 x3=xxxa(1,n3)
547 y3=xxxa(2,n3)
548 z3=xxxa(3,n3)
549 ENDIF
550 pnod(1,i)=(one-ksi-eta)*x1+ksi*x2+eta*x3
551 pnod(2,i)=(one-ksi-eta)*y1+ksi*y2+eta*y3
552 pnod(3,i)=(one-ksi-eta)*z1+ksi*z2+eta*z3
553 ELSEIF (ifvnod(1,i)==2) THEN
554 i2=ifvnod(3,i)
555 pnod(1,i)=xxxa(1,i2)
556 pnod(2,i)=xxxa(2,i2)
557 pnod(3,i)=xxxa(3,i2)
558 ENDIF
559 ENDDO
560!$OMP END DO
561
562!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
563 DO i=1,nns
564 IF (ifvnod(1,i)==3) THEN
565 i1=ifvnod(2,i)
566 i2=ifvnod(3,i)
567 fac=rfvnod(1,i)
568 pnod(1,i)=fac*pnod(1,i1)+(one-fac)*pnod(1,i2)
569 pnod(2,i)=fac*pnod(2,i1)+(one-fac)*pnod(2,i2)
570 pnod(3,i)=fac*pnod(3,i1)+(one-fac)*pnod(3,i2)
571 ENDIF
572 ENDDO
573!$OMP END DO
574
575 IF (npolh_anim>0) THEN
576!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
577 DO i=1,nns_anim
578 ii=redir_anim(i)
579 nod_anim(1,i)=pnod(1,ii)
580 nod_anim(2,i)=pnod(2,ii)
581 nod_anim(3,i)=pnod(3,ii)
582 ENDDO
583!$OMP END DO
584 ENDIF
585
586C Normale et aire des triangles
587!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
588 DO i=1,nntr
589 n1=ifvtri(1,i)
590 n2=ifvtri(2,i)
591 n3=ifvtri(3,i)
592 x1=pnod(1,n1)
593 y1=pnod(2,n1)
594 z1=pnod(3,n1)
595 x2=pnod(1,n2)
596 y2=pnod(2,n2)
597 z2=pnod(3,n2)
598 x3=pnod(1,n3)
599 y3=pnod(2,n3)
600 z3=pnod(3,n3)
601 x12=x2-x1
602 y12=y2-y1
603 z12=z2-z1
604 x13=x3-x1
605 y13=y3-y1
606 z13=z3-z1
607 nrx=y12*z13-z12*y13
608 nry=z12*x13-x12*z13
609 nrz=x12*y13-y12*x13
610 area2=sqrt(nrx**2+nry**2+nrz**2)
611 parea(i)=half*area2
612 IF (area2>0) THEN
613 pnorm(1,i)=nrx/area2
614 pnorm(2,i)=nry/area2
615 pnorm(3,i)=nrz/area2
616 ELSE
617 pnorm(1,i)=zero
618 pnorm(2,i)=zero
619 pnorm(3,i)=zero
620 ENDIF
621 ENDDO
622!$OMP END DO
623C
624C Volume des polyhedres
625!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
626 DO i=1,npolh
627 pvolu(i)= zero
628 pvoltmp = zero
629C Boucle sur les polygones du polyhedre
630 DO j=ifvpadr(i),ifvpadr(i+1)-1
631 jj=ifvpolh(j)
632C Boucle sur les triangles du polygone
633 DO k=ifvtadr(jj), ifvtadr(jj+1)-1
634 kk=ifvpoly(k)
635 area=parea(kk)
636 iel=ifvtri(4,kk)
637 IF (iel>0) THEN
638 nx=pnorm(1,kk)
639 ny=pnorm(2,kk)
640 nz=pnorm(3,kk)
641 ELSE
642 ip1=ifvtri(5,kk)
643 ip2=ifvtri(6,kk)
644 IF (ip1==i) THEN
645 nx=pnorm(1,kk)
646 ny=pnorm(2,kk)
647 nz=pnorm(3,kk)
648 ENDIF
649 IF (ip2==i) THEN
650 nx=-pnorm(1,kk)
651 ny=-pnorm(2,kk)
652 nz=-pnorm(3,kk)
653 ENDIF
654 IF (ip1==i.AND.ip2==i) THEN
655 nx=zero
656 ny=zero
657 nz=zero
658 ENDIF
659 ENDIF
660 n1=ifvtri(1,kk)
661 x1=pnod(1,n1)
662 y1=pnod(2,n1)
663 z1=pnod(3,n1)
664 pvoltmp=pvoltmp+third*area*(x1*nx+y1*ny+z1*nz)
665 ENDDO
666 ENDDO
667 pvolu(i) = pvoltmp
668 ENDDO
669!$OMP END DO
670!$OMP END PARALLEL
671
672 IF(ivolu(39) == 0) RETURN
673
674C Pas de temps mini
675C DTMIN=DTMIN1(52)
676 dtmin = fvbag_dtmin
677 dtmergv12=idtmin(52)
678 IF(dtmergv12==2) dtmergv12=1
679C Volume moyen
680 vm=zero
681 npa=0
682 DO i=1,npolh
683 IF (pvolu(i)>zero) THEN
684 vm=vm+pvolu(i)
685 npa=npa+1
686 ENDIF
687 ENDDO
688 IF(npa>0)THEN
689 vm=vm/npa
690 ENDIF
691
692 !RVOLU(31) : cgmerg
693 !RVOLU(33) : VM(from starter)
694 !IVOLU(60) : IVMIN/Igmerg
695 IF (ivmin == 1) THEN
696 ! mean volume is current one
697 volumin=vm*rvolu(31)
698 ELSEIF (ivmin == -1)THEN
699 ! specific case : Iswitch=2 : full merging request on Tswitch/Pswitch criteria
700 volumin = ep20
701 ELSE
702 ! mean volume is initial one
703 volumin=rvolu(33)*rvolu(31)
704 ENDIF
705
706C Aire des polygones et polyhedres appuyes
707 DO i=1,npoly
708 areapoly(i)=zero
709 polhapp(1,i)=0
710 polhapp(2,i)=0
711 DO j=ifvtadr(i),ifvtadr(i+1)-1
712 jj=ifvpoly(j)
713 IF (jj==-1) GOTO 50
714 iel=ifvtri(4,jj)
715 IF (iel==0) THEN
716 ip1=ifvtri(5,jj)
717 ip2=ifvtri(6,jj)
718 areapoly(i)=areapoly(i)+parea(jj)
719 polhapp(1,i)=ip1
720 polhapp(2,i)=ip2
721 ENDIF
722 ENDDO
723 50 ENDDO
724C
725 IF (npolh==1) GOTO 300
726 100 DO i=1,npolh
727 itag(i)=0
728 ENDDO
729 DO i=1,npoly
730 itagp(i)=0
731 ENDDO
732C Volume max de voisins
733!$OMP PARALLEL PRIVATE(I,J,JJ,K,KK,IEL,II)
734!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
735 DO i=1,npolh
736 vvmax(i)=zero
737 DO j=ifvpadr(i),ifvpadr(i+1)-1
738 jj=ifvpolh(j)
739 DO k=ifvtadr(jj), ifvtadr(jj+1)-1
740 kk=ifvpoly(k)
741 iel=ifvtri(4,kk)
742 IF (iel==0) THEN
743 IF (ifvtri(5,kk)==i) THEN
744 ii=ifvtri(6,kk)
745 ELSEIF (ifvtri(6,kk)==i) THEN
746 ii=ifvtri(5,kk)
747 ENDIF
748 vvmax(i)=max(vvmax(i),pvolu(ii))
749 ENDIF
750 ENDDO
751 ENDDO
752 vvmax(i)=rvolu(34)*vvmax(i)
753 ENDDO
754!$OMP END DO NOWAIT
755C
756!$OMP SINGLE
757 pvolu_old(1:npolh)=pvolu(1:npolh)
758!$OMP END SINGLE
759!$OMP END PARALLEL
760C
761 iloop=0
762 DO i=1,npolh
763 IF (itag(i)/=0) cycle
764 IF (pvolu(i)<=volumin.OR.pvolu(i)<=vvmax(i).OR.
765 . mpolh(i)<=zero.OR.epolh(i)<=zero.OR.
766 . (dtmergv12 == 0 .AND. dtpolh(i) <= dtmin .AND.
767 . pvolu(i) <= ten*volumin) .OR.
768 . (dtmergv12 == 1 .AND. dtpolh(i)<=dtmin) ) THEN
769C
770 itypm=1
771 IF (pvolu(i)>volumin) itypm=2
772 IF (mpolh(i)<=zero.OR.epolh(i)<=zero) itypm=3
773 IF (dtpolh(i)<=dtmin) itypm=4
774C
775C Recherche le polyedre voisin Imax ayant la plus grande surface commune avec le polyedre I
776C
777 areamax=zero
778 imax=0
779 DO j=ifvpadr(i),ifvpadr(i+1)-1
780 jj=ifvpolh(j)
781 area=areapoly(jj)
782 ip1=polhapp(1,jj)
783 ip2=polhapp(2,jj)
784 IF (area>areamax) THEN
785 IF (ip1==i) THEN
786 imax=ip2
787 areamax=area
788 ELSEIF (ip2==i) THEN
789 imax=ip1
790 areamax=area
791 ENDIF
792 ENDIF
793 ENDDO
794C Only one polyhedron remaining
795 IF(imax==0) cycle
796C
797 IF (itag(imax)/=0) THEN
798C Polyedre Imax a deja re u un polyedre
799 iloop=1
800 ELSE
801C Merge polyedre I dans polyedre Imax
802 DO j=ifvpadr(imax),ifvpadr(imax+1)-1
803 jj=ifvpolh(j)
804 k=ifvtadr(jj)
805 kk=ifvpoly(k)
806C Tag polygone commun aux polyedres Imax et I
807 IF (ifvtri(4,kk)==0.AND.(ifvtri(5,kk)==i.OR.
808 . ifvtri(6,kk)==i))
809 . itagp(jj)=1
810 ENDDO
811C
812 itag(i)=imax
813 itag(imax)=-i
814 vol1=pvolu(i)
815 vol2=pvolu(imax)
816 pvolu(imax)=pvolu(imax)+pvolu(i)
817C
818 IF(itypm == 1) nfvmerge(1)=nfvmerge(1)+1
819 IF(itypm == 2) nfvmerge(2)=nfvmerge(2)+1
820 IF(itypm == 3) nfvmerge(3)=nfvmerge(3)+1
821 IF(itypm == 4) nfvmerge(4)=nfvmerge(4)+1
822C
823 IF (ilvout >= 2) THEN
824 idp1=idpolh(i)
825 idp2=idpolh(imax)
826 IF (itypm==1) THEN
827 WRITE(iout,
828 . '(A46,I8,A6,G11.4,A1,A20,I8,A7,G11.4,A1,A12,I10)')
829 . ' ** GLOBAL MERGE: MERGING FINITE VOLUME ',idp1,
830 . ' (VOL=',vol1,')',
831 . ' WITH FINITE VOLUME ',idp2,' (VOL=',vol2,')',' MONVOL ID ',id
832 ELSEIF (itypm==2) THEN
833 WRITE(iout,
834 . '(A46,I8,A6,G11.4,A1,A20,I8,A7,G11.4,A1,A12,I10)')
835 . ' ** NEIGHBORHOOD MERGE: MERGING FINITE VOLUME ',idp1,
836 . ' (VOL=',vol1,')',
837 . ' WITH FINITE VOLUME ',idp2,' (VOL=',vol2,')',' MONVOL ID ',id
838 ELSEIF (itypm==3) THEN
839 WRITE(iout,
840 . '(A46,I8,A6,G11.4,A1,A20,I8,A7,G11.4,A1,A12,I10)')
841 . ' ** STABILITY MERGE: MERGING FINITE VOLUME ',idp1,
842 . ' (VOL=',vol1,')',
843 . ' WITH FINITE VOLUME ',idp2,' (VOL=',vol2,')',' MONVOL ID ',id
844 ELSEIF (itypm==4) THEN
845 WRITE(iout,
846 . '(A46,I8,A6,G11.4,A1,A20,I8,A7,G11.4,A1,A12,I10)')
847 . ' ** TIME STEP MERGE: MERGING FINITE VOLUME ',idp1,
848 . ' (VOL=',vol1,')',
849 . ' WITH FINITE VOLUME ',idp2,' (VOL=',vol2,')',' MONVOL ID ',id
850 ENDIF
851 ENDIF
852 ENDIF
853 ENDIF
854 ENDDO
855C
856 DO i=1,npolh
857 DO j=ifvpadr(i),ifvpadr(i+1)-1
858 jj=ifvpolh(j)
859 k=ifvtadr(jj)
860 kk=ifvpoly(k)
861 IF (ifvtri(4,kk)==0.AND.ifvtri(5,kk)==ifvtri(6,kk)) THEN
862 itagp(jj)=1
863 ENDIF
864 ENDDO
865 ENDDO
866 DO i=1,npolh
867 count(i)=1
868 ENDDO
869 DO i=1,npolh
870 ii=itag(i)
871 IF (ii>0) count(ii)=count(ii)+1
872 ENDDO
873
874 cmax=0
875 DO i=1,npolh
876 cmax=max(cmax,count(i))
877 ENDDO
878 IF (cmax==1) GOTO 300
879C
880 ALLOCATE(merge(cmax+1,npolh))
881 DO i=1,npolh
882 merge(1,i)=1
883 merge(2,i)=i
884 ENDDO
885 DO i=1,npolh
886 ii=itag(i)
887 IF (ii>0) THEN
888 cc=merge(1,ii)
889 cc=cc+1
890 merge(1,ii)=cc
891 merge(cc+1,ii)=i
892 merge(1,i)=0
893 ENDIF
894 ENDDO
895C
896 len=ifvpadr(npolh+1)-1
897 ALLOCATE(ifvpolh_old(len))
898
899!$OMP PARALLEL PRIVATE(I)
900!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
901 DO i=1,ifvpadr(npolh+1)-1
902 ifvpolh_old(i)=ifvpolh(i)
903 ENDDO
904!$OMP END DO
905!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
906 DO i=1,npolh+1
907 ifvpadr_old(i)=ifvpadr(i)
908 ENDDO
909!$OMP END DO
910!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
911 DO i=1,npolh
912 mpolh_old(i)=mpolh(i)
913 qpolh_old(1,i)=qpolh(1,i)
914 qpolh_old(2,i)=qpolh(2,i)
915 qpolh_old(3,i)=qpolh(3,i)
916 epolh_old(i)=epolh(i)
917 gpolh_old(i)=gpolh(i)
918 cpapolh_old(i)=cpapolh(i)
919 cpbpolh_old(i)=cpbpolh(i)
920 cpcpolh_old(i)=cpcpolh(i)
921 rmwpolh_old(i)=rmwpolh(i)
922 vpolh_ini_old(i)=vpolh_ini(i)
923 idpolh_old(i)=idpolh(i)
924 ibpolh_old(i)=ibpolh(i)
925 tpolh_old(i)=tpolh(i)
926 cpdpolh_old(i)=cpdpolh(i)
927 cpepolh_old(i)=cpepolh(i)
928 cpfpolh_old(i)=cpfpolh(i)
929 dtpolh_old(i)=dtpolh(i)
930C
931 mpolh(i)=zero
932 qpolh(1,i)=zero
933 qpolh(2,i)=zero
934 qpolh(3,i)=zero
935 epolh(i)=zero
936 pvolu(i)=zero
937 gpolh(i)=zero
938 cpapolh(i)=zero
939 cpbpolh(i)=zero
940 cpcpolh(i)=zero
941 rmwpolh(i)=zero
942 tpolh(i)=zero
943 cpdpolh(i)=zero
944 cpepolh(i)=zero
945 cpfpolh(i)=zero
946 ENDDO
947!$OMP END DO
948!$OMP END PARALLEL
949
950 npolh_old=npolh
951 npolh=0
952 nnp=0
953 DO i=1,npolh_old
954 cc=merge(1,i)
955 IF (cc==0) cycle
956 npolh=npolh+1
957 ifvpadr(npolh)=nnp+1
958 IF(cc == 1) THEN
959 jj=merge(2,i)
960 redir(jj)=npolh
961 DO k=ifvpadr_old(jj),ifvpadr_old(jj+1)-1
962 kk=ifvpolh_old(k)
963 IF (itagp(kk)==1) cycle
964 nnp=nnp+1
965 ifvpolh(nnp)=kk
966 ENDDO
967C
968 mpolh(npolh)=mpolh_old(jj)
969 qpolh(1,npolh)=qpolh_old(1,jj)
970 qpolh(2,npolh)=qpolh_old(2,jj)
971 qpolh(3,npolh)=qpolh_old(3,jj)
972 epolh(npolh)=epolh_old(jj)
973C
974 IF (mpolh(npolh)<=zero.OR.epolh(npolh)<=zero) iloop=1
975C
976 pvolu(npolh)=pvolu_old(jj)
977 gpolh(npolh)=gpolh_old(jj)
978 cpapolh(npolh)=cpapolh_old(jj)
979 cpbpolh(npolh)=cpbpolh_old(jj)
980 cpcpolh(npolh)=cpcpolh_old(jj)
981 rmwpolh(npolh)=rmwpolh_old(jj)
982 cpdpolh(npolh)=cpdpolh_old(jj)
983 cpepolh(npolh)=cpepolh_old(jj)
984 cpfpolh(npolh)=cpfpolh_old(jj)
985 vpolh_ini(npolh)=vpolh_ini_old(i)
986 idpolh(npolh)=idpolh_old(i)
987 ibpolh(npolh)=ibpolh_old(i)
988 dtpolh(npolh)=dtpolh_old(i)
989 ELSE
990 masspolh=zero
991 DO j=1,cc
992 jj=merge(j+1,i)
993 redir(jj)=npolh
994 DO k=ifvpadr_old(jj),ifvpadr_old(jj+1)-1
995 kk=ifvpolh_old(k)
996 IF (itagp(kk)==1) cycle
997 nnp=nnp+1
998 ifvpolh(nnp)=kk
999 ENDDO
1000C
1001 mpolh(npolh)=mpolh(npolh)+mpolh_old(jj)
1002 qpolh(1,npolh)=qpolh(1,npolh)+qpolh_old(1,jj)
1003 qpolh(2,npolh)=qpolh(2,npolh)+qpolh_old(2,jj)
1004 qpolh(3,npolh)=qpolh(3,npolh)+qpolh_old(3,jj)
1005 epolh(npolh)=epolh(npolh)+epolh_old(jj)
1006 pvolu(npolh)=pvolu(npolh)+pvolu_old(jj)
1007C
1008 IF (mpolh(npolh)<=zero.OR.epolh(npolh)<=zero) iloop=1
1009 IF (pvolu(npolh) <= zero) iloop=1
1010C
1011 IF(mpolh_old(jj) > 0) THEN
1012 masspolh=masspolh+mpolh_old(jj)
1013 gpolh(npolh) =gpolh(npolh) +mpolh_old(jj)*gpolh_old(jj)
1014 cpapolh(npolh)=cpapolh(npolh)+mpolh_old(jj)*cpapolh_old(jj)
1015 cpbpolh(npolh)=cpbpolh(npolh)+mpolh_old(jj)*cpbpolh_old(jj)
1016 cpcpolh(npolh)=cpcpolh(npolh)+mpolh_old(jj)*cpcpolh_old(jj)
1017 rmwpolh(npolh)=rmwpolh(npolh)+mpolh_old(jj)*rmwpolh_old(jj)
1018 cpdpolh(npolh)=cpdpolh(npolh)+mpolh_old(jj)*cpdpolh_old(jj)
1019 cpepolh(npolh)=cpepolh(npolh)+mpolh_old(jj)*cpepolh_old(jj)
1020 cpfpolh(npolh)=cpfpolh(npolh)+mpolh_old(jj)*cpfpolh_old(jj)
1021 ENDIF
1022 ENDDO
1023
1024 IF(masspolh > zero) THEN
1025 gpolh(npolh) =gpolh(npolh) /masspolh
1026 cpapolh(npolh)=cpapolh(npolh)/masspolh
1027 cpbpolh(npolh)=cpbpolh(npolh)/masspolh
1028 cpcpolh(npolh)=cpcpolh(npolh)/masspolh
1029 rmwpolh(npolh)=rmwpolh(npolh)/masspolh
1030 cpdpolh(npolh)=cpdpolh(npolh)/masspolh
1031 cpepolh(npolh)=cpepolh(npolh)/masspolh
1032 cpfpolh(npolh)=cpfpolh(npolh)/masspolh
1033 ENDIF
1034 vpolh_ini(npolh)=vpolh_ini_old(i)
1035 idpolh(npolh)=idpolh_old(i)
1036 IF (dt1 /= zero) THEN
1037C In case of initial engine merging, time step HAS TO be same as the one that would have
1038C been calculated if mergind had occurred during starter
1039 ibpolh(npolh)=0
1040 ENDIF
1041 dtpolh(npolh)=ep30
1042 ENDIF
1043 ENDDO
1044 ifvpadr(npolh+1)=nnp+1
1045C
1046
1047 DO i=1,nntr
1048 IF (ifvtri(4,i)<=0) THEN
1049 ip1=ifvtri(5,i)
1050 ip2=ifvtri(6,i)
1051 ifvtri(5,i)=redir(ip1)
1052 ifvtri(6,i)=redir(ip2)
1053 ENDIF
1054 ENDDO
1055 DO i=1,npoly
1056 IF (itagp(i)==1) THEN
1057 DO j=ifvtadr(i),ifvtadr(i+1)-1
1058 ifvpoly(j)=-1
1059 ENDDO
1060 ENDIF
1061 ip1=polhapp(1,i)
1062 ip2=polhapp(2,i)
1063 IF (ip1>0) THEN
1064 polhapp(1,i)=redir(ip1)
1065 polhapp(2,i)=redir(ip2)
1066 ENDIF
1067 ENDDO
1068 DEALLOCATE(merge, ifvpolh_old)
1069
1070
1071!$OMP PARALLEL PRIVATE(I)
1072!$OMP+ PRIVATE(TEMP,TEMP0,EFAC,CPA,CPB,CPC,CPD,CPE,CPF,RMW)
1073!$OMP+ PRIVATE(ITYPL)
1074 itypl = ityp
1075!$OMP DO SCHEDULE(DYNAMIC,MVSIZ)
1076 DO i=1,npolh
1077 IF( epolh(i) <= zero .OR.
1078 . mpolh(i) <= zero .OR.
1079 . pvolu(i) <= zero) cycle
1080 rpolh(i)=mpolh(i)/pvolu(i)
1081 efac =epolh(i)/mpolh(i)
1082 cpa =cpapolh(i)
1083 cpb =cpbpolh(i)
1084 cpc =cpcpolh(i)
1085 cpd =cpdpolh(i)
1086 cpe =cpepolh(i)
1087 cpf =cpfpolh(i)
1088 rmw =rmwpolh(i)
1089 temp0=rvolu(25)
1090 CALL fvtemp(itypl , efac , cpa , cpb , cpc ,
1091 . cpd , cpe , cpf , rmw , temp0,
1092 . temp )
1093 tpolh(i)=temp
1094 ppolh(i)=rpolh(i)*rmwpolh(i)*temp
1095 ENDDO
1096!$OMP END DO
1097!$OMP END PARALLEL
1098
1099C--------------------------
1100C Impression
1101C--------------------------
1102 IF(ilvout ==4 .OR. ilvout ==5) THEN
1103C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
1104 WRITE(iout,'(/,4A)') ' FINITE VOLUME',' BRICK ',
1105 . ' VOLUME MASS TEMPER. POLYGONE TRIANGLE',
1106 . ' AREA TRIANGLE BRICK1 BRICK2 '
1107C
1108 DO i=1,npolh
1109 i1= idpolh(i)
1110 i2= ibpolh(i)
1111 IF(i2==0 .OR. ilvout==5) THEN
1112 ii=0
1113 kkk=0
1114 DO j=ifvpadr(i),ifvpadr(i+1)-1
1115 jj=ifvpolh(j)
1116 DO k=ifvtadr(jj),ifvtadr(jj+1)-1
1117 kkk=kkk+1
1118 kk=ifvpoly(k)
1119 area=parea(kk)
1120 iel=ifvtri(4,kk)
1121 ip1=ifvtri(5,kk)
1122 ip2=ifvtri(6,kk)
1123 ip3=ifvtri(1,kk)
1124 IF(kkk==1) THEN
1125C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
1126 WRITE(iout,'(3I10,3G10.3,5X,I6,4X,I6,4X,G14.6,3I10,
1127 . G14.6)') i,i1,i2,pvolu(i),mpolh(i),tpolh(i),
1128 . jj,kk,area,iel,ip1,ip2,
1129 . dtpolh_old(i)
1130 ELSE
1131 WRITE(iout,'(65X,I6,4X,I6,4X,G14.6,3I10,G14.6)')
1132 . jj,kk,area,iel,ip1,ip2,
1133 . pnod(1,ip3)
1134 ENDIF
1135 ENDDO
1136 ENDDO
1137 ENDIF
1138 ENDDO
1139 ENDIF
1140C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
1141 IF (iloop==1) THEN
1142 IF (npolh==1) THEN
1143 IF (ilvout >= 1) THEN
1144 WRITE(iout,'(A,I10)') ' ** MONVOL ID ',id
1145 WRITE(iout,'(A)')' ONLY ONE FINITE VOLUME REMAIN - EXITING'
1146 ENDIF
1147 GOTO 300
1148 ELSE
1149 IF (ilvout >= 1) THEN
1150 WRITE(iout,'(A,I10,2A,I10)') ' ** MONVOL ID ',id,
1151 . ' FINITE VOLUME MESH UPDATE - LOOPING -',
1152 . ' NUMBER OF FINITE VOLUMES : ',npolh
1153 ENDIF
1154 ENDIF
1155 GOTO 100
1156 ENDIF
1157C
1158
1159 300 CONTINUE
1160
1161 DEALLOCATE(fvspmd(ifv)%XXX)
1162 DEALLOCATE(fvspmd(ifv)%VVV)
1163 DEALLOCATE(fvspmd(ifv)%WAV)
1164 DEALLOCATE(fvspmd(ifv)%WAX)
1165
1166 RETURN
1167 END
my_real
#define my_real
Definition cppsort.cpp:32
fvtemp
subroutine fvtemp(ityp, efac_in, cpa_in, cpb_in, cpc_in, cpd_in, cpe_in, cpf_in, rmw_in, temp0_in, temp_in)
Definition fvtemp.F:35
fvupd0
subroutine fvupd0(monvol, x, v, volmon, smonvol, svolmon)
Definition fvupd.F:34
fvupd1
subroutine fvupd1(nel, ibuf, elem, x, npolh, mpolh, qpolh, epolh, v, ppolh, rpolh, gpolh, ifvnod, rfvnod, ifvtri, ifvpoly, ifvtadr, ifvpolh, ifvpadr, nns, nntr, rvolu, npoly, id, cpapolh, cpbpolh, cpcpolh, rmwpolh, vpolh_ini, ivmin, idpolh, ibufa, elema, tagela, ibpolh, redir_anim, nod_anim, nns_anim, npolh_anim, dtpolh, ilvout, nnt, nna, ifv, xxxa, tpolh, cpdpolh, cpepolh, cpfpolh, ityp, nfvmerge, vvva, ncona, ivolu, fvbag_dtmin, numnod)
Definition fvupd.F:266
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
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
fvmbag_meshcontrol_mod
Definition fvmbag_meshcontrol_mod.F:46
fvmbag_meshcontrol_mod::kmesh
integer, dimension(:), allocatable kmesh
Definition fvmbag_meshcontrol_mod.F:48
spmd_fvb_gath_end
subroutine spmd_fvb_gath_end(ifv, x, xxx, xxxa, v, vvv, vvva)
Definition spmd_fvb.F:223
spmd_fvb_gath_begin
subroutine spmd_fvb_gath_begin(ifv, x, xxx, xxxa, v, vvv, vvva)
Definition spmd_fvb.F:33