OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvventhole.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!|| fvventhole ../starter/source/airbag/fvventhole.F
25!||--- called by ------------------------------------------------------
26!|| init_monvol ../starter/source/airbag/init_monvol.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE fvventhole(IBUF , ELEM , IBAGHOL,
33 . NVENT , IGRSURF,
34 . ITAGEL, NN , NEL ,
35 . ID , TAGVENT, TITR ,
36 . ELTG, NB_NODE)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE groupdef_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "param_c.inc"
51#include "com04_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IBUF(*), ELEM(3,NEL), IBAGHOL(NIBHOL,*),
56 . NVENT,
57 . NN, NEL, ID, TAGVENT(NB_NODE)
58 INTEGER, DIMENSION(NEL), INTENT(INOUT) :: ITAGEL
59 INTEGER NB_NODE
60 INTEGER, DIMENSION(NEL), INTENT(IN) :: ELTG
61 CHARACTER(len=nchartitle) :: TITR
62 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, II, ITABINV(NB_NODE), ITAGVENT(NN),
67 . ISU, NELSU, IEL, NG1, NG2, NG3, NG4, N1, N2, N3, N4,
68 . IVENT, NALL, NN1, NN2, IERROR
69 INTEGER K, ITY, KEL, IVENTYP, IERROR1
70 CHARACTER*17, CVENTYP
71C----------------------------------------------------
72C TAG Vent Holes and Porous Surfaces nodes : TAGVENT
73C Test if the nodes belong to the airbag
74C----------------------------------------------------
75 DO i=1,nb_node
76 itabinv(i)=0
77 ENDDO
78C
79 DO i=1,nn
80 ii=ibuf(i)
81 itabinv(ii)=i
82 itagvent(i)=0
83 ENDDO
84C
85 DO ivent=1,nvent
86 isu=ibaghol(2,ivent)
87 IF(isu == 0) cycle
88 iventyp=ibaghol(13,ivent)
89 IF(iventyp == 0) cventyp='VENT HOLE SURFACE'
90 IF(iventyp == 1) cventyp='POROUS SURFACE'
91 nelsu=igrsurf(isu)%NSEG
92 DO i=1,nelsu
93 ng1 = igrsurf(isu)%NODES(i,1)
94 ng2 = igrsurf(isu)%NODES(i,2)
95 ng3 = igrsurf(isu)%NODES(i,3)
96 ng4 = igrsurf(isu)%NODES(i,4)
97 n1=itabinv(ng1)
98 n2=itabinv(ng2)
99 n3=itabinv(ng3)
100 n4=itabinv(ng4)
101 ierror = 0
102 IF(n1==0.AND.tagvent(ng1)==0) THEN
103 ierror = 1
104 ELSE
105 IF (n1 /= 0) itagvent(n1)=ivent
106 END IF
107 IF(n2==0.AND.tagvent(ng2)==0) THEN
108 ierror = 1
109 ELSE
110 IF (n2 /= 0) itagvent(n2)=ivent
111 END IF
112 IF(n3==0.AND.tagvent(ng3)==0) THEN
113 ierror = 1
114 ELSE
115 IF (n3 /= 0) itagvent(n3)=ivent
116 END IF
117 IF(n4==0.AND.tagvent(ng4)==0) THEN
118 ierror = 1
119 ELSE
120 IF (n4 /= 0) itagvent(n4)=ivent
121 END IF
122 ENDDO
123 IF(ierror==1)THEN
124 CALL ancmsg(msgid=632,
125 . msgtype=msgerror,
126 . anmode=aninfo,
127 . i1=id,
128 . c1=titr,
129 . c2=cventyp,
130 . i2=igrsurf(isu)%ID)
131 ENDIF
132 ENDDO
133C-----------------------------------------
134C TAG Vent hole and Porous Surface ITAGEL
135C-----------------------------------------
136 DO ivent=1,nvent
137 isu=ibaghol(2,ivent)
138 IF(isu == 0) cycle
139 iventyp=ibaghol(13,ivent)
140 IF(iventyp == 0) cventyp='VENT HOLE '
141 IF(iventyp == 1) cventyp='POROUS SURFACE'
142 nelsu=igrsurf(isu)%NSEG
143 ierror =0
144 ierror1=0
145 DO i=1,nelsu
146 ity = igrsurf(isu)%ELTYP(i)
147 kel = igrsurf(isu)%ELEM(i)
148 IF(ity == 7) kel=kel+numelc
149 IF(ity == 3 .OR. ity == 7) THEN
150 DO iel=1,nel
151 k=eltg(iel)
152 IF(k == kel) THEN
153 IF(itagel(iel) == 0) THEN
154C Element IEL belongs to the current vent hole
155 itagel(iel)=-ivent
156 ELSEIF(itagel(iel) > 0) THEN
157C Element IEL is an injector
158 ierror=ierror+1
159 ELSEIF(itagel(iel) < 0) THEN
160C Element IEL belongs to a previous vent hole
161 ierror1=ierror1+1
162 ENDIF
163 ENDIF
164 ENDDO
165 ELSE
166 DO iel=1,nel
167 n1=elem(1,iel)
168 n2=elem(2,iel)
169 n3=elem(3,iel)
170 nall=itagvent(n1)*itagvent(n2)*itagvent(n3)
171 IF (nall/=0) THEN
172 nn1=itagvent(n2)-itagvent(n1)
173 nn2=itagvent(n3)-itagvent(n1)
174 IF (nn1 == 0.AND.nn2 == 0) THEN
175 IF(itagel(iel) == 0) THEN
176C Element IEL belongs to the current vent hole
177 itagel(iel)=-ivent
178 ELSEIF(itagel(iel) > 0) THEN
179C Element IEL is an injector
180 ierror=ierror+1
181 ELSEIF(itagel(iel) < 0) THEN
182C Element IEL belongs to a previous vent hole
183 ierror1=ierror1+1
184 ENDIF
185 ENDIF
186 ENDIF
187 ENDDO
188 ENDIF
189 ENDDO
190 IF(ierror > 0)THEN
191 CALL ancmsg(msgid=1045,msgtype=msgwarning,anmode=aninfo,
192 . i1=id,i2=ierror,c1=titr,c2=cventyp,i3=ivent)
193 ENDIF
194 IF(ierror1 > 0)THEN
195 CALL ancmsg(msgid=1180,msgtype=msgwarning,anmode=aninfo,
196 . i1=id,i2=ierror1,c1=titr,c2=cventyp,i3=ivent)
197 ENDIF
198 ENDDO
199C
200 RETURN
201 END
subroutine fvventhole(ibuf, elem, ibaghol, nvent, igrsurf, itagel, nn, nel, id, tagvent, titr, eltg, nb_node)
Definition fvventhole.F:37
integer, parameter nchartitle
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