OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
init_monvol.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!|| init_monvol_mod ../starter/source/airbag/init_monvol.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||====================================================================
28 MODULE init_monvol_mod
29 CONTAINS
30!||====================================================================
31!|| init_monvol ../starter/source/airbag/init_monvol.F
32!||--- called by ------------------------------------------------------
33!|| lectur ../starter/source/starter/lectur.F
34!||--- calls -----------------------------------------------------
35!|| aleno ../starter/source/airbag/fvmbag1.F
36!|| ancmsg ../starter/source/output/message/message.F
37!|| constit ../starter/source/elements/nodes/constit.F
38!|| fvbric0 ../starter/source/airbag/fvbric0.F
39!|| fvbric01 ../starter/source/airbag/fvbric01.F
40!|| fvbric1 ../starter/source/airbag/fvbric1.f
41!|| fvbric2 ../starter/source/airbag/fvbric2.F
42!|| fvbric3 ../starter/source/airbag/fvbric3.F
43!|| fvelprint ../starter/source/airbag/fvelprint.F
44!|| fvelsurf ../starter/source/airbag/fvelsurf.F
45!|| fvinject ../starter/source/airbag/fvinject.F
46!|| fvnodi ../starter/source/airbag/fvmbag1.F
47!|| fvventhole ../starter/source/airbag/fvventhole.F
48!|| hypermesh_tetra ../starter/stub/fvmbags_stub.F
49!|| monvol_check_delete_duplicated ../starter/source/airbag/monvol_check_delete_duplicated.F
50!|| monvol_triangulate_surface ../starter/source/airbag/monvol_triangulate_surface.F
51!|| usr2sys ../starter/source/system/sysfus.F
52!|| writemesh ../starter/source/airbag/writeMesh.F
53!||--- uses -----------------------------------------------------
54!|| fvbric1_mod ../starter/source/airbag/fvbric1.F
55!|| fvbric2_mod ../starter/source/airbag/fvbric2.F
56!|| message_mod ../starter/share/message_module/message_mod.F
57!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
58!|| r2r_mod ../starter/share/modules1/r2r_mod.F
59!||====================================================================
60 SUBROUTINE init_monvol(T_MONVOL, T_MONVOL_METADATA,
61 1 IXC ,IXTG ,X ,NPC ,
62 2 ITAB ,IGRSURF ,
63 3 SENSORS ,IGRBRIC ,MFI ,
64 4 IXS ,V ,LIBAGALE,
65 5 LRBAGALE )
66C-----------------------------------------------
67C M o d u l e s
68C-----------------------------------------------
69 USE r2r_mod
70 USE message_mod
71 USE fvmbag_meshcontrol_mod
72 USE groupdef_mod
73 USE monvol_struct_mod
74 USE sensor_mod
75 USE my_alloc_mod
76 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
77 USE fvbric1_mod , ONLY : fvbric1
78 USE fvbric2_mod , ONLY : fvbric2
79C-----------------------------------------------
80C I m p l i c i t T y p e s
81C-----------------------------------------------
82#include "implicit_f.inc"
83C-----------------------------------------------
84C C o m m o n B l o c k s
85C-----------------------------------------------
86#include "com01_c.inc"
87#include "com04_c.inc"
88#include "scr03_c.inc"
89#include "param_c.inc"
90#include "units_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),NPC(*),ITAB(*),MFI,IXS(NIXS,*),LIBAGALE,LRBAGALE
95 my_real X(3,*), V(3,*)
96C-----------------------------------------------
97 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
98 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
99 TYPE(monvol_struct_), DIMENSION(NVOLU), INTENT(INOUT) :: T_MONVOL
100 TYPE(monvol_metadata_), INTENT(INOUT) :: T_MONVOL_METADATA
101 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER :: NN, LCA, LIBJET, LRBJET, LIBHOL, LRBHOL
106 INTEGER I, J, ID, ITYPE, K, NCA, N,
107 . IMASS, ITEMP, IFLU, ISENS,
108 . IJET,NJ1,NJ2,NJ3,IPT,IPA,IPZ,
109 . NNI,NTGI,
110 . njet,nvent,
111 . ngroot,
112 . np,
113 . ibric, ilvout, iadale,
114 . radale, nns, iadale2, nno, ntg, iadale3, iadale4, nbric,
115 . iadale5, iadale6, iadale7, iadale8, ntga, nna, iadale9,
116 . iadale10, iadale11,
117 . iadale12,
118 . nvb,
119 . iadale13, ntgt, ii, ibid(1), jj
120 INTEGER ID1,ID2
121 INTEGER MAX_ID
122 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGE, ITABINV, TAGVENT, ITABINV1, ITABINV2, INDEX
123 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNODBR
124 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB_SAVE
125 INTEGER :: NFVMBAGS
126 INTEGER :: NJET_NEW(NVOLU)
127 TYPE(group_) :: DUMMY(2)
128
129 my_real ti,gamai, cpai, cpbi, cpci, cpdi, cpei, cpfi, gama, cpa, cpb, cpc,rmwg, cpg, cvg, fmass, ftemp
130 CHARACTER MESS*40
131 CHARACTER(len=nchartitle) :: TITR,TITR1
132 CHARACTER*10 MONVOLTYP(11)
133 INTEGER :: NB_TETRA, NB_VERTICES, NB_EXTRA_VERTICES
134 LOGICAL :: FOUND
135 INTEGER :: SIZE1, SIZE2,LENGTH
136 INTEGER :: COMM_TAG(NVOLU), NCOMMU
137 INTEGER, DIMENSION(:, :), ALLOCATABLE :: IBAGJET_SAVE
138 my_real, DIMENSION(:, :), ALLOCATABLE :: rbagjet_save
139C-----------------------------------------------
140C E x t e r n a l F u n c t i o n s
141C-----------------------------------------------
142 INTEGER USR2SYS
143 EXTERNAL usr2sys
144C-----------------------------------------------
145C D a t a
146C-----------------------------------------------
147 DATA mess/'MONITORED VOLUME DEFINITION '/
148 DATA monvoltyp/' AREA',' PRES',' GAS',
149 . ' AIRBAG',' COMMU',' FVMBAG',
150 . ' AIRBAG1',' fvmbag1',' commu1',
151 . ' lfluid',' fvmbag2'/
152C-----------------------------------------------
153 K = 0
154 MFI = 0
155 NVB = 0
156 IBID = 0
157C-------------------------------------
158C Allocate KMESH (for type 8 airbags)
159C-------------------------------------
160.NOT. IF((ALLOCATED(KMESH))) ALLOCATE(KMESH(NVOLU))
161 TETRAMESHER_USED = .FALSE.
162 NB_TOTAL_NODE = NUMNOD
163.NOT. IF((ALLOCATED(NODE_COORD))) ALLOCATE(NODE_COORD(3, NUMNOD))
164 DO I = 1, NUMNOD
165 NODE_COORD(1, I) = X(1, I)
166 NODE_COORD(2, I) = X(2, I)
167 NODE_COORD(3, I) = X(3, I)
168 ENDDO
169 NB_TOTAL_SOLIDS = NUMELS
170.NOT. IF((ALLOCATED(IXS_TEMP))) ALLOCATE(IXS_TEMP(NIXS * NUMELS))
171 DO I = 1, NUMELS
172 DO II = 1, NIXS
173 IXS_TEMP(NIXS * (I - 1) + II) = IXS(II, I)
174 ENDDO
175 ENDDO
176.NOT. IF((ALLOCATED(ITAB_TMP))) ALLOCATE(ITAB_TMP(NUMNOD), ITABM1_TMP(2 * NUMNOD))
177 DO I = 1, NUMNOD
178 ITAB_TMP(I) = ITAB(I)
179 ENDDO
180!!! Completion of ITAB
181 MAX_ID = MAXVAL(ITAB(1:NUMNOD))
182
183 DO I = NUMNOD + 1, NB_TOTAL_NODE
184 MAX_ID = MAX_ID + 1
185 ITAB_TMP(I) = MAX_ID
186 ENDDO
187
188 CALL CONSTIT(ITAB_TMP,ITABM1_TMP,NB_TOTAL_NODE)
189
190 IADALE=1
191 RADALE=1
192
193 TETRAMESHER_USED = .FALSE.
194 DO N = 1, NVOLU
195 ITYPE = T_MONVOL(N)%TYPE
196 IF (ITYPE == 11) THEN
197C FVMABG2 are in fact FVMBAG1 with simplified input
198 T_MONVOL(N)%TYPE = 8
199 T_MONVOL(N)%IVOLU(2) = T_MONVOL(N)%TYPE
200 ENDIF
201 KMESH(N) = 0
202 IF (ITYPE == 6) THEN
203 KMESH(N) = 1
204 ENDIF
205.OR. IF (ITYPE == 8 ITYPE == 11) THEN
206 KMESH(N) = T_MONVOL(N)%IVOLU(30)
207 ENDIF
208 IF (KMESH(N) >= 2) TETRAMESHER_USED = .TRUE.
209 ENDDO
210
211 DO N=1,NVOLU
212 ITYPE = T_MONVOL(N)%TYPE
213 ID = T_MONVOL(N)%ID
214 ILVOUT = T_MONVOL(N)%IVOLU(44)
215 TITR = T_MONVOL(N)%TITLE
216 NN =IGRSURF(T_MONVOL(N)%EXT_SURFID)%NSEG
217.OR. IF (ITYPE == 6ITYPE == 8) THEN
218C------------------------------------------
219C Elements de l'airbag et elements internes
220C------------------------------------------
221 T_MONVOL(N)%IVOLU(31)=IADALE-1
222 T_MONVOL(N)%IVOLU(34)=RADALE-1
223C Tag les noeuds des briques additionnelles
224 ALLOCATE(TAGNODBR(NUMNOD))
225 TAGNODBR(1:NUMNOD)=0
226 IBRIC=T_MONVOL(N)%IVOLU(61)
227 IF (IBRIC/=0) THEN
228 NBRIC=IGRBRIC(IBRIC)%NENTITY
229 T_MONVOL(N)%NBRIC = NBRIC
230 ALLOCATE(T_MONVOL(N)%TBRIC(2, NBRIC))
231 ALLOCATE(T_MONVOL(N)%TFAC(12, NBRIC))
232 CALL FVBRIC0(
233 . IBID ,IXS ,1 ,NBRIC ,
234 . T_MONVOL(N)%ID,T_MONVOL(N)%IVOLU(44) ,TITR ,TAGNODBR,
235 . T_MONVOL(N)%TBRIC ,T_MONVOL(N)%TFAC,NUMNOD ,IGRBRIC,IBRIC,ITYPE)
236 ENDIF
237C
238 ALLOCATE(TAGE(NN),ITABINV(NUMNOD),TAGVENT(NUMNOD))
239C
240
241 CALL ALENO(NN ,IGRSURF(T_MONVOL(N)%EXT_SURFID)%NODES, NNS,ITABINV,
242 . TAGE, TAGVENT, TAGNODBR, T_MONVOL(N))
243
244 DEALLOCATE(TAGNODBR)
245C
246 NNI=0
247
248 IF (T_MONVOL(N)%INT_SURFID /= 0) THEN
249 ALLOCATE(ITABINV1(NUMNOD))
250 ITABINV1(1:NUMNOD) = 0
251 NP = IGRSURF(T_MONVOL(N)%INT_SURFID)%NSEG
252 CALL FVNODI(NP ,IGRSURF(T_MONVOL(N)%INT_SURFID)%NODES, NNI,ITABINV1 ,
253 . T_MONVOL(N))
254 ENDIF
255! Number of nodes on external surface
256 T_MONVOL(N)%IVOLU(32)=NNS
257! Number of nodes on internal surface
258 T_MONVOL(N)%IVOLU(68)=NNI
259
260 IADALE2=IADALE+NNS+NNI
261 NNO=3
262
263
264! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- !
265! ***************************************************** !
266! ** Triangulation of external and internal surfaces ** !
267! ***************************************************** !
268! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- !
269 NTG = 0
270 NTGI = 0
271 SIZE1 = 0
272 SIZE2 = 0
273 IF (T_MONVOL(N)%EXT_SURFID > 0) THEN
274 SIZE1 = IGRSURF(T_MONVOL(N)%EXT_SURFID)%NSEG
275 ENDIF
276 IF (T_MONVOL(N)%INT_SURFID > 0) THEN
277 SIZE2 = IGRSURF(T_MONVOL(N)%INT_SURFID)%NSEG
278 ENDIF
279! Keep track of original elements ids
280 LENGTH=2 * (SIZE1 + SIZE2 + T_MONVOL(N)%NB_FILL_TRI)
281 CALL MY_ALLOC(T_MONVOL(N)%FVBAG_ELEMID,LENGTH)
282 CALL MY_ALLOC(T_MONVOL(N)%ELTG, (2 * (SIZE1 + SIZE2)))
283 T_MONVOL(N)%ELTG(1:SIZE1 + SIZE2) = 0
284 CALL MONVOL_TRIANGULATE_SURFACE(T_MONVOL(N), IGRSURF, ITABINV, ITABINV1, TAGE,
285 . X, KMESH(N), NNS, NNI, NTG, NTGI, SIZE1, SIZE2, T_MONVOL(N)%FVBAG_ELEMID)
286
287! Check for duplicated triangles on internal + external surface of the airbag
288
289 CALL MONVOL_CHECK_DELETE_DUPLICATED(T_MONVOL(N), NTG, NTGI, ITAB)
290
291 IF (ALLOCATED(ITABINV1)) DEALLOCATE(ITABINV1)
292 IF (ALLOCATED(ITABINV)) DEALLOCATE(ITABINV)
293 IF (ALLOCATED(ITABINV2)) DEALLOCATE(ITABINV2)
294 IF (ALLOCATED(INDEX)) DEALLOCATE(INDEX)
295 IF (ALLOCATED(TAGE)) DEALLOCATE(TAGE)
296
297 T_MONVOL(N)%IVOLU(33)=NTG
298 T_MONVOL(N)%IVOLU(69)=NTGI
299 IADALE3=IADALE2+NNO*NTG
300
301 IF (NTGI > 0) THEN
302 ALLOCATE(T_MONVOL(N)%POROSITY(NTGI))
303 ALLOCATE(T_MONVOL(N)%THSURF_TAG(NSURF, NTGI + 1))
304 ENDIF
305
306 IF (T_MONVOL(N)%INT_SURFID /= 0) THEN
307.NOT. IF ( TETRAMESHER_USED) THEN
308 CALL FVBRIC01(T_MONVOL(N)%NODES, T_MONVOL(N)%ELEM(1, NTG + 1), NTGI, NUMNOD, NBRIC, IXS,
309 . T_MONVOL(N)%TBRIC, T_MONVOL(N)%TFAC)
310 ENDIF
311 ENDIF
312 ALLOCATE(T_MONVOL(N)%ELAREA(NTG + NTGI))
313 IADALE3=IADALE3+NNO*NTGI
314
315 IF (KMESH(N) >= 2) THEN
316! Automatic tetrameshing
317 SELECT CASE (KMESH(N))
318 CASE (12, 14)
319! Hypermesh (12), Hypermesh + writing of mesh as an include file (14)
320 CALL HYPERMESH_TETRA(T_MONVOL(N), NIXS, N, KMESH(N),
321 . NB_EXTRA_VERTICES, NB_TETRA, NB_VERTICES)
322 CASE DEFAULT
323
324 END SELECT
325 WRITE(IOUT,1703) ID,NB_TETRA, NB_EXTRA_VERTICES
326 IF (ALLOCATED(ITAB_SAVE)) DEALLOCATE(ITAB_SAVE)
327 ALLOCATE(ITAB_SAVE(NB_TOTAL_NODE_OLD))
328 ITAB_SAVE(1:NB_TOTAL_NODE_OLD) = ITAB_TMP(1:NB_TOTAL_NODE_OLD)
329
330 DEALLOCATE(ITAB_TMP, ITABM1_TMP)
331!!! First, determine max user ID (external ID)
332 ALLOCATE(ITAB_TMP(NB_TOTAL_NODE), ITABM1_TMP(2 * NB_TOTAL_NODE))
333 DO I = 1, NB_TOTAL_NODE_OLD
334 ITAB_TMP(I) = ITAB_SAVE(I)
335 ENDDO
336!!! Completion of ITAB
337 MAX_ID = MAXVAL(ITAB_TMP(1:NB_TOTAL_NODE_OLD))
338
339 DO I = NB_TOTAL_NODE_OLD + 1, NB_TOTAL_NODE
340 MAX_ID = MAX_ID + 1
341 ITAB_TMP(I) = MAX_ID
342 ENDDO
343
344 CALL CONSTIT(ITAB_TMP,ITABM1_TMP,NB_TOTAL_NODE)
345
346!!! Output .inc file
347.OR. IF (KMESH(N) == 4 KMESH(N) == 14) THEN
348 CALL WRITEMESH(N)
349 ENDIF
350
351 T_MONVOL(N)%NBRIC = NB_TETRA
352 ALLOCATE(T_MONVOL(N)%TBRIC(2, NB_TETRA))
353 ALLOCATE(T_MONVOL(N)%TFAC(12, NB_TETRA))
354
355 IF (ALLOCATED(IBUFSSG_TEMP)) DEALLOCATE(IBUFSSG_TEMP)
356 ALLOCATE(IBUFSSG_TEMP(NB_TETRA))
357 DO I = 1, NB_TETRA
358 IBUFSSG_TEMP(I) = I + NB_TOTAL_SOLIDS_OLD
359 ENDDO
360
361 IF (ALLOCATED(TAGNODBR)) DEALLOCATE(TAGNODBR)
362 ALLOCATE(TAGNODBR(NB_TOTAL_NODE))
363 TAGNODBR(1:NB_TOTAL_NODE)=0
364
365 CALL FVBRIC0(
366 . IBUFSSG_TEMP,IXS_TEMP ,2 ,NB_TETRA,
367 . T_MONVOL(N)%ID ,T_MONVOL(N)%IVOLU(44) ,TITR ,TAGNODBR,
368 . T_MONVOL(N)%TBRIC ,T_MONVOL(N)%TFAC,NB_TOTAL_NODE ,DUMMY,IBRIC,ITYPE)
369 IF (T_MONVOL(N)%INT_SURFID > 0) THEN
370 CALL FVBRIC01(T_MONVOL(N)%NODES, T_MONVOL(N)%ELEM(1, NTG + 1), NTGI, NB_TOTAL_NODE,
371 . NB_TETRA, IXS_TEMP, T_MONVOL(N)%TBRIC, T_MONVOL(N)%TFAC)
372 ENDIF
373
374 DEALLOCATE(TAGNODBR)
375 ENDIF
376
377C--------------------------------------
378C Elements d'injecteur et de vent holes
379C--------------------------------------
380 NJET=T_MONVOL(N)%IVOLU(8)
381 ALLOCATE(T_MONVOL(N)%ITAGEL(T_MONVOL(N)%NTG +T_MONVOL(N)%NTGI))
382 T_MONVOL(N)%ITAGEL(:) = 0
383 ALLOCATE(T_MONVOL(N)%MATTG(T_MONVOL(N)%NTG +T_MONVOL(N)%NTGI))
384 T_MONVOL(N)%MATTG(:) = 0
385
386 CALL FVINJECT(
387 . T_MONVOL(N)%NODES , T_MONVOL(N)%ELEM, T_MONVOL(N)%IBAGJET,
388 . NJET, IGRSURF,
389 . T_MONVOL(N)%ITAGEL,NNS+NNI, NTG,
390 . T_MONVOL(N)%ID ,TAGVENT, TITR,
391 . ITAB )
392
393 NVENT=T_MONVOL(N)%IVOLU(11)
394 NTGT=NTG+NTGI
395 IADALE4=IADALE3+NTGT
396 IADALE5=IADALE4+NTGT
397 IF (TETRAMESHER_USED) THEN
398 CALL FVELSURF(
399 . T_MONVOL(N)%NODES, T_MONVOL(N)%ELEM, T_MONVOL(N)%FVBAG_ELEMID(1:NTGT), IXC, IXTG, NTGT,
400 . T_MONVOL(N)%ELTG, T_MONVOL(N)%MATTG, NB_TOTAL_NODE, .TRUE.)
401 CALL FVVENTHOLE(
402 . T_MONVOL(N)%NODES ,T_MONVOL(N)%ELEM,T_MONVOL(N)%IBAGHOL,
403 . NVENT, IGRSURF,
404 . T_MONVOL(N)%ITAGEL,NNS+NNI, NTG,
405 . T_MONVOL(N)%ID ,TAGVENT, TITR,
406 . T_MONVOL(N)%ELTG, NB_TOTAL_NODE)
407 ELSE
408 CALL FVELSURF(
409 . T_MONVOL(N)%NODES, T_MONVOL(N)%ELEM, T_MONVOL(N)%FVBAG_ELEMID(1:NTGT), IXC, IXTG, NTGT,
410 . T_MONVOL(N)%ELTG, T_MONVOL(N)%MATTG, NUMNOD, .TRUE.)
411 CALL FVVENTHOLE(
412 . T_MONVOL(N)%NODES ,T_MONVOL(N)%ELEM,T_MONVOL(N)%IBAGHOL,
413 . NVENT, IGRSURF,
414 . T_MONVOL(N)%ITAGEL,NNS+NNI, NTG,
415 . T_MONVOL(N)%ID ,TAGVENT, TITR,
416 . T_MONVOL(N)%ELTG, NUMNOD)
417 ENDIF
418 DEALLOCATE(TAGVENT)
419 DEALLOCATE(T_MONVOL(N)%FVBAG_ELEMID)
420C
421 IF (TETRAMESHER_USED) THEN
422 CALL FVELPRINT(
423 . IXC, IXTG, NTGT, T_MONVOL(N)%ITAGEL, T_MONVOL(N)%ELTG,
424 . T_MONVOL(N)%IBAGHOL, ILVOUT, 0 )
425 ELSE
426 CALL FVELPRINT(
427 . IXC, IXTG, NTGT, T_MONVOL(N)%ITAGEL, T_MONVOL(N)%ELTG,
428 . T_MONVOL(N)%IBAGHOL, ILVOUT, 0 )
429 ENDIF
430C----------------------------------
431C Elements volumiques additionnels
432C----------------------------------
433 IBRIC=T_MONVOL(N)%IVOLU(61)
434.OR..AND. IF (IBRIC/=0 (IBRIC==0 KMESH(N)>=2)) THEN
435
436 IF (KMESH(N) >= 2) THEN
437 NBRIC = NB_TETRA
438 IADALE5=IADALE4+2*NTGT
439 IADALE6=IADALE5+2*NBRIC
440 IADALE7=IADALE6+12*NBRIC
441 IADALE8=IADALE7+2*NTGT
442 T_MONVOL(N)%IVOLU(19)=IADALE5
443 T_MONVOL(N)%IVOLU(20)=IADALE8
444
445!!! Now we're done et ready to go on filling bufalei
446 ELSE
447 nbric=igrbric(ibric)%NENTITY
448 iadale5=iadale4+2*ntgt
449 iadale6=iadale5+2*nbric
450 iadale7=iadale6+12*nbric
451 iadale8=iadale7+2*ntgt
452 t_monvol(n)%IVOLU(19)=iadale5
453 t_monvol(n)%IVOLU(20)=iadale8
454
455 ENDIF
456
457 ALLOCATE(t_monvol(n)%TAGELS(t_monvol(n)%NTG + 2 * t_monvol(n)%NTGI))
458 t_monvol(n)%TAGELS(:) = 0
459 IF (tetramesher_used) THEN
460 CALL fvbric1(t_monvol(n),
461 . t_monvol(n)%NODES, t_monvol(n)%ELEM, ixs_temp,
462 . t_monvol(n)%TBRIC,ntg, ntga, nbric,
463 . t_monvol(n)%TFAC,t_monvol(n)%TAGELS, t_monvol(n)%ID, ntgi,
464 . nna, t_monvol(n)%IVOLU(44),
465 . t_monvol(n)%ELTG,node_coord, titr,
466 . nb_total_node)
467 ELSE
468 CALL fvbric1(t_monvol(n),
469 . t_monvol(n)%NODES, t_monvol(n)%ELEM, ixs,
470 . t_monvol(n)%TBRIC,ntg, ntga, nbric,
471 . t_monvol(n)%TFAC,t_monvol(n)%TAGELS, t_monvol(n)%ID, ntgi,
472 . nna, t_monvol(n)%IVOLU(44),
473 . t_monvol(n)%ELTG,x, titr, numnod)
474 ENDIF
475C
476 iadale9 =iadale8+nna
477 iadale10=iadale9+3*ntga
478 iadale11=iadale10+ntga
479 IF (tetramesher_used) THEN
480 CALL fvbric2(
481 . t_monvol(n)%ELEM, ixs_temp, ntg+ntgi, nbric,
482 . t_monvol(n)%TBRIC, t_monvol(n)%TFAC, t_monvol(n)%TAGELS, ntga,
483 . t_monvol(n)%IBUFA, nna, t_monvol(n)%ELEMA,
484 . t_monvol(n)%TAGELA, t_monvol(n)%BRNA,
485 . nb_total_node)
486 ELSE
487 CALL fvbric2(
488 . t_monvol(n)%ELEM, ixs, ntg+ntgi, nbric,
489 . t_monvol(n)%TBRIC, t_monvol(n)%TFAC, t_monvol(n)%TAGELS, ntga,
490 . t_monvol(n)%IBUFA, nna, t_monvol(n)%ELEMA,
491 . t_monvol(n)%TAGELA, t_monvol(n)%BRNA, numnod)
492 ENDIF
493C
494 iadale12=iadale11+8*nbric
495 IF (tetramesher_used) THEN
496 CALL fvbric3(
497 . t_monvol(n)%NODES, t_monvol(n)%IBUFA, nns+nni, nbric, nna,
498 . t_monvol(n)%TBRIC, t_monvol(n)%BRNA, t_monvol(n)%NCONA, itab_tmp,
499 . ilvout, nb_total_node,t_monvol(n)%IVOLU(38),t_monvol(n)%RVOLU(67),kmesh(n), v )
500
501 ELSE
502 CALL fvbric3(
503 . t_monvol(n)%NODES, t_monvol(n)%IBUFA, nns+nni, nbric, nna,
504 . t_monvol(n)%TBRIC, t_monvol(n)%BRNA, t_monvol(n)%NCONA, itab,
505 . ilvout, numnod, t_monvol(n)%IVOLU(38),t_monvol(n)%RVOLU(67),kmesh(n), v )
506 ENDIF
507 ELSE
508 nbric=0
509 ntga=ntg+ntgi
510 nna=0
511 iadale5=iadale4+2*ntga
512 iadale6=iadale5
513 iadale7=iadale6
514 iadale8=iadale7+2*ntga
515 iadale9=iadale8
516 iadale10=iadale9+3*ntga
517 iadale11=iadale10+ntga
518 iadale12=iadale11
519 t_monvol(n)%IVOLU(19)=iadale5
520 t_monvol(n)%IVOLU(20)=iadale8
521
522 t_monvol(n)%NTGA = ntga
523 ALLOCATE(t_monvol(n)%TAGELS(ntg + 2 * ntgi))
524 DO i = 1, ntg + 2 * ntgi
525 t_monvol(n)%TAGELS(i) = 0
526 ENDDO
527 ALLOCATE(t_monvol(n)%ELEMA(3, ntga))
528 DO i = 1, ntga
529 t_monvol(n)%ELEMA(1, i) = t_monvol(n)%ELEM(1, i)
530 t_monvol(n)%ELEMA(2, i) = t_monvol(n)%ELEM(2, i)
531 t_monvol(n)%ELEMA(3, i) = t_monvol(n)%ELEM(3, i)
532 ENDDO
533 ALLOCATE(t_monvol(n)%TAGELA(ntga))
534 DO i = 1, ntga
535 t_monvol(n)%TAGELA(i) = i
536 ENDDO
537 ENDIF
538 t_monvol(n)%IVOLU(62) = nbric
539 t_monvol(n)%IVOLU(63) = ntga
540 t_monvol(n)%IVOLU(64) = nna
541 t_monvol(n)%NNA = nna
542 IF (nna > 0) THEN
543 ALLOCATE(t_monvol(n)%VELOCITY(3, nna), t_monvol(n)%NODE_COORD(3, nna))
544 ENDIF
545C
546 iadale13=iadale12+16*nna
547 t_monvol(n)%IVOLU(18)=iadale13-1
548! Copy addresses to structure
549 t_monvol(n)%IADALE = iadale
550 t_monvol(n)%IADALE2 = iadale2
551 t_monvol(n)%IADALE3 = iadale3
552 t_monvol(n)%IADALE4 = iadale4
553 t_monvol(n)%IADALE5 = iadale5
554 t_monvol(n)%IADALE6 = iadale6
555 t_monvol(n)%IADALE7 = iadale7
556 t_monvol(n)%IADALE8 = iadale8
557 t_monvol(n)%IADALE9 = iadale9
558 t_monvol(n)%IADALE10 = iadale10
559 t_monvol(n)%IADALE11 = iadale11
560 t_monvol(n)%IADALE12 = iadale12
561 t_monvol(n)%IADALE12 = iadale13
562 iadale=iadale13+nsurf*(ntgi+1)
563 radale=radale+7*(nns+nni)+4*ntg+13*nna+5*ntgi
564 mfi=mfi+ 7*(nns+nni)+4*ntg+13*nna+5*ntgi
565C
566 t_monvol(n)%IVOLU(56)=0
567 libagale=iadale-1
568 ENDIF
569 ENDDO
570C
571 libagale=iadale-1
572 lrbagale=radale-1
573
574! ********************* !
575! Communicating airbags !
576! ********************* !
577! Change to local monvol ID
578 lca = 0
579 ncommu = 0
580 comm_tag(1:nvolu) = 0
581 DO nn = 1, nvolu
582 itype = t_monvol(nn)%TYPE
583 IF (itype == 5 .OR. itype == 9) THEN
584 ncommu = ncommu + 1
585 nca = t_monvol(nn)%NCA
586 DO ii = 1, nca
587 id = t_monvol_metadata%ICBAG(1, ii + lca)
588 found = .false.
589 DO jj = 1, nvolu
590 IF (id == t_monvol(jj)%ID) THEN
591 t_monvol_metadata%ICBAG(1, ii + lca) = jj
592 found = .true.
593 EXIT
594 ENDIF
595 ENDDO
596 IF (.NOT. found) THEN
597 CALL ancmsg(msgid = 15, anmode = aninfo, msgtype = msgerror,
598 . i2 = id, i1 = t_monvol(nn)%ID, c1 = t_monvol(nn)%TITLE)
599 ELSE
600! Check compatibility : type 5 with type 5 only, and type 9 with type 9 only
601 IF (itype == 5 .AND. t_monvol(jj)%TYPE /= 5 .OR.
602 . itype == 9 .AND. t_monvol(jj)%TYPE /= 9) THEN
603 CALL ancmsg(msgid = 16, anmode = aninfo, msgtype = msgerror,
604 . i1 = t_monvol(nn)%ID, c1 = t_monvol(nn)%TITLE,
605 . i2 = t_monvol(nn)%TYPE, c2 = t_monvol(jj)%TITLE)
606 ENDIF
607 ENDIF
608 ENDDO
609 lca = lca + nca
610 ENDIF
611 ENDDO
612
613! Tag communicting airbags
614 comm_tag(1:nvolu) = 0
615 lca = 0
616 DO nn = 1, nvolu
617 itype = t_monvol(nn)%TYPE
618 IF (itype == 5 .OR. itype == 9) THEN
619 nca = t_monvol(nn)%NCA
620 IF (comm_tag(nn) == 0) THEN
621 comm_tag(nn) = nn
622 DO ii = 1, nca
623 id1 = t_monvol_metadata%ICBAG(1, ii + lca)
624 IF (comm_tag(id1) /= 0) THEN
625 comm_tag(nn) = comm_tag(id1)
626 DO jj = 1, nca
627 id2 = t_monvol_metadata%ICBAG(1, jj + lca)
628 comm_tag(id2) = comm_tag(id1)
629 ENDDO
630 ENDIF
631 ENDDO
632 ENDIF
633 lca = lca + nca
634 ENDIF
635 ENDDO
636! *************** !
637! Venthole adress !
638! *************** !
639 nventtot = 0
640 DO nn = 1, nvolu
641 t_monvol(nn)%IVOLU(16) = nventtot
642 nvent = t_monvol(nn)%NVENT
643 nventtot = nventtot + nvent
644 ENDDO
645 libhol = 0
646 lrbhol = 0
647 DO nn = 1, nvolu
648 itype = t_monvol(nn)%TYPE
649 IF (itype >= 3.AND.(itype <= 9 .OR. itype == 11))THEN
650 t_monvol(nn)%IVOLU(12) = libhol
651 t_monvol(nn)%IVOLU(13) = lrbhol
652 nvent = t_monvol(nn)%NVENT
653 libhol = libhol + nvent * nibhol
654 lrbhol = lrbhol + nvent * nrbhol
655 ENDIF
656 ENDDO
657C----------------------------------------------------------------------------
658C airbags communiquants, verifie les caracteristiques du gaz a l'initial.
659C----------------------------------------------------------------------------
660 DO n=1,nvolu
661 itype=t_monvol(n)%IVOLU(2)
662 IF(itype==5.OR.itype==9.AND.n/=comm_tag(n))THEN
663 gamai=t_monvol(comm_tag(n))%RVOLU(1)
664 cpai =t_monvol(comm_tag(n))%RVOLU(7)
665 cpbi =t_monvol(comm_tag(n))%RVOLU(8)
666 cpci =t_monvol(comm_tag(n))%RVOLU(9)
667 cpdi =t_monvol(comm_tag(n))%RVOLU(56)
668 cpei =t_monvol(comm_tag(n))%RVOLU(57)
669 cpfi =t_monvol(comm_tag(n))%RVOLU(58)
670 IF(t_monvol(n)%RVOLU(1) /= gamai.OR.
671 . t_monvol(n)%RVOLU(7)/=cpai.OR.
672 . t_monvol(n)%RVOLU(8)/=cpbi.OR.
673 . t_monvol(n)%RVOLU(9)/=cpci.OR.
674 . t_monvol(n)%RVOLU(56)/=cpdi.OR.
675 . t_monvol(n)%RVOLU(57)/=cpei.OR.
676 . t_monvol(n)%RVOLU(58)/=cpfi)THEN
677 id = t_monvol(n)%ID
678 titr = t_monvol(n)%TITLE
679 id1 = t_monvol(comm_tag(n))%ID
680 titr1 = t_monvol(comm_tag(n))%TITLE
681 CALL ancmsg(msgid=474,anmode=aninfo,msgtype=msgerror,
682 . i1=id,
683 . c1=titr,
684 . i2=id1,
685 . c2=titr1)
686 ENDIF
687 ENDIF
688 ENDDO
689
690 DO nn = 1, nvolu
691 njet_new(nn) = t_monvol(nn)%NJET
692 ENDDO
693 DO nn = 1, nvolu
694 itype = t_monvol(nn)%TYPE
695 IF (itype == 5 .OR. itype == 9) THEN
696 IF (comm_tag(nn) /= nn) THEN
697 njet_new(comm_tag(nn)) = njet_new(comm_tag(nn)) + njet_new(nn)
698 ENDIF
699 ENDIF
700 ENDDO
701 DO nn = 1, nvolu
702 itype = t_monvol(nn)%TYPE
703 IF (itype == 5 .OR. itype == 9) THEN
704 IF (comm_tag(nn) /= nn) THEN
705 njet_new(nn) = njet_new(comm_tag(nn))
706 ENDIF
707 ENDIF
708 ENDDO
709
710 DO nn = 1, nvolu
711 IF (comm_tag(nn) == nn) THEN
712! Root communicating airbag
713 njet = t_monvol(nn)%NJET
714 IF (njet > 0) THEN
715 ALLOCATE(ibagjet_save(nibjet, njet))
716 ALLOCATE(rbagjet_save(nrbjet, njet))
717 DO ii = 1, njet
718 DO jj = 1, nibjet
719 ibagjet_save(jj, ii) = t_monvol(nn)%IBAGJET(jj, ii)
720 ENDDO
721 DO jj = 1, nrbjet
722 rbagjet_save(jj, ii) = t_monvol(nn)%RBAGJET(jj, ii)
723 ENDDO
724 ENDDO
725 ELSE
726 ALLOCATE(ibagjet_save(nibjet, 0))
727 ALLOCATE(rbagjet_save(nrbjet, 0))
728 ENDIF
729 IF (ALLOCATED(t_monvol(nn)%RBAGJET)) DEALLOCATE(t_monvol(nn)%RBAGJET)
730 IF (ALLOCATED(t_monvol(nn)%IBAGJET)) DEALLOCATE(t_monvol(nn)%IBAGJET)
731 IF (njet_new(nn) > 0) THEN
732 ALLOCATE(t_monvol(nn)%RBAGJET(nrbjet, njet_new(nn)),
733 . t_monvol(nn)%IBAGJET(nibjet, njet_new(nn)))
734 t_monvol(nn)%RBAGJET(1:nrbjet, 1:njet_new(nn)) = zero
735 t_monvol(nn)%IBAGJET(1:nibjet, 1:njet_new(nn)) = 0
736 DO ii = 1, njet
737 DO jj = 1, nibjet
738 t_monvol(nn)%IBAGJET(jj, ii) = ibagjet_save(jj, ii)
739 ENDDO
740 DO jj = 1, nrbjet
741 t_monvol(nn)%RBAGJET(jj, ii) = rbagjet_save(jj, ii)
742 ENDDO
743 ENDDO
744 ENDIF
745 IF (ALLOCATED(ibagjet_save)) DEALLOCATE(ibagjet_save)
746 IF (ALLOCATED(rbagjet_save)) DEALLOCATE(rbagjet_save)
747 ENDIF
748 ENDDO
749 DO nn = 1, nvolu
750 IF (comm_tag(nn) /= nn) THEN
751! Non root communicating airbag
752 njet = t_monvol(nn)%NJET
753 IF (njet > 0) THEN
754 ALLOCATE(ibagjet_save(nibjet, njet))
755 ALLOCATE(rbagjet_save(nrbjet, njet))
756 DO ii = 1, njet
757 DO jj = 1, nibjet
758 ibagjet_save(jj, ii) = t_monvol(nn)%IBAGJET(jj, ii)
759 ENDDO
760 DO jj = 1, nrbjet
761 rbagjet_save(jj, ii) = t_monvol(nn)%RBAGJET(jj, ii)
762 ENDDO
763 ENDDO
764 ELSE
765 ALLOCATE(ibagjet_save(nibjet, 0))
766 ALLOCATE(rbagjet_save(nrbjet, 0))
767 ENDIF
768 IF (ALLOCATED(t_monvol(nn)%RBAGJET)) DEALLOCATE(t_monvol(nn)%RBAGJET)
769 IF (ALLOCATED(t_monvol(nn)%IBAGJET)) DEALLOCATE(t_monvol(nn)%IBAGJET)
770 IF (njet_new(nn) > 0) THEN
771 ALLOCATE(t_monvol(nn)%RBAGJET(nrbjet, njet_new(nn)),
772 . t_monvol(nn)%IBAGJET(nibjet, njet_new(nn)))
773 t_monvol(nn)%RBAGJET(1:nrbjet, 1:njet_new(nn)) = zero
774 t_monvol(nn)%IBAGJET(1:nibjet, 1:njet_new(nn)) = 0
775 DO ii = 1, njet
776 DO jj = 1, nibjet
777 t_monvol(nn)%IBAGJET(jj, ii) = ibagjet_save(jj, ii)
778 ENDDO
779 DO jj = 1, nrbjet
780 t_monvol(nn)%RBAGJET(jj, ii) = rbagjet_save(jj, ii)
781 ENDDO
782 ENDDO
783 ENDIF
784 IF (ALLOCATED(ibagjet_save)) DEALLOCATE(ibagjet_save)
785 IF (ALLOCATED(rbagjet_save)) DEALLOCATE(rbagjet_save)
786 ENDIF
787 ENDDO
788
789
790C-------------------------------------
791C airbags communiquants, echange des caracteristiques des gaz.
792C-------------------------------------
793 DO n=1,nvolu
794 itype=t_monvol(n)%TYPE
795 IF((itype==5.OR.itype==9).AND.n/=comm_tag(n))THEN
796 ngroot =t_monvol(comm_tag(n))%IVOLU(8)
797 njet =t_monvol(n)%IVOLU(8)
798 DO j=1,njet
799C---------------------------------------------------------------------------------
800C informe le volume pere des caracteristiques du gaz injecte dans un fils
801C---------------------------------------------------------------------------------
802 t_monvol(comm_tag(n))%RBAGJET(1, ngroot + j) = t_monvol(n)%RBAGJET(1, j)
803 t_monvol(comm_tag(n))%RBAGJET(2, ngroot + j) = t_monvol(n)%RBAGJET(2, j)
804 t_monvol(comm_tag(n))%RBAGJET(3, ngroot + j) = t_monvol(n)%RBAGJET(3, j)
805 t_monvol(comm_tag(n))%RBAGJET(4, ngroot + j) = t_monvol(n)%RBAGJET(4, j)
806 t_monvol(comm_tag(n))%RBAGJET(16, ngroot + j) = t_monvol(n)%RBAGJET(16, j)
807 t_monvol(comm_tag(n))%RBAGJET(17, ngroot + j) = t_monvol(n)%RBAGJET(17, j)
808 t_monvol(comm_tag(n))%RBAGJET(18, ngroot + j) = t_monvol(n)%RBAGJET(18, j)
809 t_monvol(comm_tag(n))%IBAGJET(4, ngroot + j) = t_monvol(n)%IBAGJET(4, j)
810 IF(itype==9) THEN
811 t_monvol(comm_tag(n))%IBAGJET(13, ngroot + j) = t_monvol(n)%IBAGJET(13, j)
812 ENDIF
813C----------------------------------------------------
814C deplace les infos relatives a l'injection.
815C----------------------------------------------------
816 IF(j-1/=ngroot)THEN
817 DO k=1,nibjet
818 t_monvol(n)%IBAGJET(k, ngroot + 1) = t_monvol(n)%IBAGJET(k, j)
819 t_monvol(n)%IBAGJET(k, j) = 0
820 ENDDO
821 DO k=1,nrbjet
822 t_monvol(n)%RBAGJET(k, ngroot + 1) = t_monvol(n)%RBAGJET(k, j)
823 t_monvol(n)%RBAGJET(k, j) = zero
824 ENDDO
825 ENDIF
826 ngroot = ngroot + 1
827 ENDDO
828 t_monvol(comm_tag(n))%IVOLU(8)=ngroot
829 t_monvol(comm_tag(n))%NJET = ngroot
830 ENDIF
831 ENDDO
832C----------------------------------------------------------
833C informe tous les volumes des caracteristiques des gaz.
834C----------------------------------------------------------
835 DO n=1,nvolu
836 itype=t_monvol(n)%TYPE
837 IF(itype==5.OR.itype==9.AND.n/=comm_tag(n))THEN
838 njet = t_monvol(comm_tag(n))%NJET
839 DO i=1,njet
840 t_monvol(n)%IBAGJET(4, i) = t_monvol(comm_tag(n))%IBAGJET(4, i) ! sensor
841 IF(itype==9 .AND. t_monvol(n)%IBAGJET(13, i)==0) THEN ! property
842 IF(t_monvol(comm_tag(n))%IBAGJET(13, i) > 0) THEN
843 t_monvol(n)%IBAGJET(13, i) = -t_monvol(comm_tag(n))%IBAGJET(13, i)
844 ELSE
845 t_monvol(n)%IBAGJET(13, i) = t_monvol(comm_tag(n))%IBAGJET(13, i)
846 ENDIF
847 ENDIF
848C
849 t_monvol(n)%RBAGJET(1, i) = t_monvol(comm_tag(n))%RBAGJET(1, i)
850 t_monvol(n)%RBAGJET(2, i) = t_monvol(comm_tag(n))%RBAGJET(2, i)
851 t_monvol(n)%RBAGJET(3, i) = t_monvol(comm_tag(n))%RBAGJET(3, i)
852 t_monvol(n)%RBAGJET(4, i) = t_monvol(comm_tag(n))%RBAGJET(4, i)
853 t_monvol(n)%RBAGJET(16, i) = t_monvol(comm_tag(n))%RBAGJET(16, i)
854 t_monvol(n)%RBAGJET(17, i) = t_monvol(comm_tag(n))%RBAGJET(17, i)
855 t_monvol(n)%RBAGJET(18, i) = t_monvol(comm_tag(n))%RBAGJET(18, i)
856 ENDDO
857 t_monvol(n)%IVOLU(8)=t_monvol(comm_tag(n))%IVOLU(8)
858 t_monvol(n)%NJET = t_monvol(comm_tag(n))%NJET
859 ENDIF
860 ENDDO
861
862! *************** !
863! Injector adress !
864! *************** !
865 libjet = 0
866 lrbjet = 0
867 DO nn = 1, nvolu
868 itype = t_monvol(nn)%TYPE
869 IF (itype >= 4 .AND. (itype <= 9 .OR. itype == 11)) THEN
870 t_monvol(nn)%IVOLU(9) = libjet
871 t_monvol(nn)%IVOLU(10) = lrbjet
872 libjet = libjet + t_monvol(nn)%NJET * nibjet
873 lrbjet = lrbjet + t_monvol(nn)%NJET * nrbjet
874 ENDIF
875 ENDDO
876C-------------------------------------
877 IF(ipri>=7)THEN
878 WRITE(iout,3000)
879 DO n=1,nvolu
880 itype=t_monvol(n)%TYPE
881 IF(itype==5.OR.itype==9)THEN
882 WRITE(iout,1001)t_monvol(n)%ID,trim(titr),monvoltyp(itype)
883C
884 ti =t_monvol(n)%RVOLU(13)
885 gamai=t_monvol(n)%RVOLU(1)
886 cpai =t_monvol(n)%RVOLU(7)
887 cpbi =t_monvol(n)%RVOLU(8)
888 cpci =t_monvol(n)%RVOLU(9)
889 WRITE(iout,1410)gamai,cpai,cpbi,cpci
890C
891 WRITE(iout,1420)
892 njet=t_monvol(n)%IVOLU(8)
893 WRITE(iout,1421)njet
894 DO i=1,njet
895 imass=t_monvol(n)%IBAGJET(1, i)
896 IF(imass/=0)imass=npc(imass)
897 iflu =t_monvol(n)%IBAGJET(2, i)
898 fmass=t_monvol(n)%RBAGJET(5, i)
899 itemp=t_monvol(n)%IBAGJET(3, i)
900 IF(itemp/=0)itemp=npc(itemp)
901 ftemp=t_monvol(n)%RBAGJET(6, i)
902 isens=t_monvol(n)%IBAGJET(4, i)
903 IF (isens > 0) isens = sensors%SENSOR_TAB(isens)%SENS_ID
904 WRITE(iout,1430)i,
905 . imass,iflu,fmass,itemp,ftemp,isens
906C
907 rmwg=t_monvol(n)%RBAGJET(1, i)
908 cpa =t_monvol(n)%RBAGJET(2, i)
909 cpb =t_monvol(n)%RBAGJET(3, i)
910 cpc =t_monvol(n)%RBAGJET(4, i)
911C
912 cpg =cpa+cpb*ti+cpc*ti*ti
913 cvg =cpg-rmwg
914 gama =cpg/cvg
915 WRITE(iout,1440)gama,cpa,cpb,cpc
916C
917 nj1=t_monvol(n)%IBAGJET(5, i)
918 nj2=t_monvol(n)%IBAGJET(6, i)
919 nj3=t_monvol(n)%IBAGJET(7, i)
920 ipt=t_monvol(n)%IBAGJET(8, i)
921 ipa=t_monvol(n)%IBAGJET(9, i)
922 ipz=t_monvol(n)%IBAGJET(10, i)
923 IF(nj1==0)THEN
924 ijet=0
925 ELSE
926 ijet=1
927 ENDIF
928 WRITE(iout,1450)ijet
929 IF(ijet==1)THEN
930 IF(ipt/=0)ipt=npc(ipt)
931 IF(ipa/=0)ipa=npc(ipa)
932 IF(ipz/=0)ipz=npc(ipz)
933 WRITE(iout,1461)itab(nj1),itab(nj2),itab(nj3),ipt,ipa,ipz
934 ENDIF
935 ENDDO
936 ENDIF
937 ENDDO
938 ENDIF
939 WRITE(iout,2000)
940C-------------------------------------
941
942 nfvmbags = 0
943 DO n = 1, nvolu
944 itype=t_monvol(n)%TYPE
945 IF(itype == 6 .OR. itype == 8) THEN
946 nfvmbags = nfvmbags + 1
947! Local numbering of FVMBAGS
948! This numbering does not change when FVMBAGS are switched to UP
949 t_monvol(n)%IVOLU(45) = nfvmbags
950 ENDIF
951 ENDDO
952 DO n = 1, nvolu
953 itype=t_monvol(n)%TYPE
954 IF(itype == 6 .OR. itype == 8) THEN
955! Total number of FVMBAGS (including FVMBAGs switched to UP)
956 t_monvol(n)%IVOLU(29) = nfvmbags
957 ENDIF
958 ENDDO
959
960 ! --------------------
961 ! allocation of NUMBER_TRI_PER_PROC : number of tri element per processor
962 ! for each N nvolu
963 DO n = 1, nvolu
964 ALLOCATE( t_monvol(n)%NUMBER_TRI_PER_PROC(nspmd) )
965 t_monvol(n)%NUMBER_TRI_PER_PROC(1:nspmd) = 0
966 ENDDO
967 ! --------------------
968C
969 RETURN
970C
971 1001 FORMAT(//5x,'VOLUME NUMBER ',i10,
972 . / 5x,'------------------------',
973 . / 5x,'TITLE: ',a,
974 . / 5x,'TYPE OF MONITORED VOLUME. . . . . . . .=',a10)
975 1410 FORMAT(
976 . 5x,'CHARACTERISTICS OF INITIAL GAZ ',
977 . /5x,'------------------------------ ',
978 . /5x,'GAMMA AT INITIAL TEMPERATURE. . . . . .=',1pg20.13,
979 . /5x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
980 . /5x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
981 . /5x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13/)
982 1420 FORMAT(
983 . 5x,'INFLATORS ',
984 . /5x,'--------- ')
985 1421 FORMAT(
986 . 5x,'NUMBER OF INFLATORS . . . . . . . . . .=',i10/)
987 1430 FORMAT(
988 . 5x,'INFLATOR NUMBER . . . . . . . . . . . .=',i10,
989 . /15x,'TIME FUNCTION FOR INCOMING TOTAL MASS .=',i10,
990 . /15x,' or MASS FLUX if IFLU=1 . . . . IFLU =',i10,
991 . /15x,'SCALE FACTOR FOR INCOMING TOTAL MASS .=',1pg20.13,
992 . /15x,'TIME FUNCTION FOR INCOMIMG GAS TEMP . .=',i10,
993 . /15x,'SCALE FACTOR FOR INCOMIMG GAS TEMP . .=',1pg20.13,
994 . /15x,'SENSOR NUMBER . . . . . . . . . . . . .=',i10)
995 1440 FORMAT(
996 . /15x,'GAZ CHARACTERISTICS ',
997 . /15x,'------------------- ',
998 . /15x,'GAMMA AT INITIAL TEMPERATURE. . . . . .=',1pg20.13,
999 . /15x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1000 . /15x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1001 . /15x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13)
1002 1450 FORMAT(
1003 . /15x,'JETTING OPTION. . . . . . . . . . . . .=',i10,
1004 . /15x,'----------------------------------------')
1005 1461 FORMAT(
1006 . 15x,'DIHEDRAL JET. . . . . . . . . . . . . .',
1007 . /15x,'NODE NUMBER DEFINING INJECTION CENTER .=',i10,
1008 . /15x,'NODE NUMBER DEFINING INJECTION AXIS . .=',i10,
1009 . /15x,'NODE NUMBER DEFINING BASE LINE. . . . .=',i10,
1010 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
1011 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
1012 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
1013 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
1014 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
1015 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13)
1016 1703 FORMAT(5x,'FVMBAG MESHING, VOLUME NUMBER',i10,
1017 . /5x,'----------------- ',
1018 . /15x,'TETRAMESH CREATED AUTOMATICALLY',
1019 . /15x,' NUMBER OF TETRAHEDRA',i10,
1020 . /15x,' NUMBER OF ADDED INTERNAL NODES',i10)
1021 2000 FORMAT(/)
1022 3000 FORMAT(
1023 . //,' MONITORED VOLUMES TYPE COMMU : GAS ORGANIZATION'/
1024 . ' -----------------------------------------------')
1025 END SUBROUTINE init_monvol
1026 END MODULE init_monvol_mod
fvbric3
subroutine fvbric3(ibuf, ibufa, nnt, nbric, nna, tbric, brna, ncona, itab, ilvout, nb_node, ivini, vini, kmesh, v)
Definition fvbric3.F:31
fvbric1_mod
Definition fvbric1.F:28
fvbric1_mod::fvbric1
subroutine fvbric1(t_monvoln, ibuf, elem, ixs, tbric, nel, nela, nbric, tfac, tagels, monvid, neli, nna, ilvout, eltg, x, titr, nb_node)
Definition fvbric1.F:46
fvbric2_mod
Definition fvbric2.F:28
fvbric2_mod::fvbric2
subroutine fvbric2(elem, ixs, nel, nbric, tbric, tfac, tagels, nela, ibufa, nna, elema, tagela, brna, nb_node)
Definition fvbric2.F:39
fvmbag_meshcontrol_mod
Definition fvmbag_meshcontrol_mod.F:46
fvmbag_meshcontrol_mod::kmesh
integer, dimension(:), allocatable kmesh
Definition fvmbag_meshcontrol_mod.F:48
fvmbag_meshcontrol_mod::ixs_temp
integer, dimension(:), allocatable ixs_temp
Definition fvmbag_meshcontrol_mod.F:52
fvmbag_meshcontrol_mod::tetramesher_used
logical tetramesher_used
Definition fvmbag_meshcontrol_mod.F:49
fvmbag_meshcontrol_mod::nb_total_node
integer nb_total_node
Definition fvmbag_meshcontrol_mod.F:50
fvmbag_meshcontrol_mod::itab_tmp
integer, dimension(:), allocatable itab_tmp
Definition fvmbag_meshcontrol_mod.F:56
groupdef_mod
Definition groupdef_mod.F:662
init_monvol_mod
Definition init_monvol.F:28
init_monvol_mod::init_monvol
subroutine init_monvol(t_monvol, t_monvol_metadata, ixc, ixtg, x, npc, itab, igrsurf, sensors, igrbric, mfi, ixs, v, libagale, lrbagale)
Definition init_monvol.F:66
message_mod
Definition message_mod.F:1249
monvol_struct_mod
Definition monvol_struct_mod.F:66
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
r2r_mod
Definition r2r_mod.F:125
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
starter
program starter
Definition starter.F:39
groupdef_mod::group_
Definition groupdef_mod.F:700
monvol_struct_mod::monvol_metadata_
Definition monvol_struct_mod.F:76
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84