OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvinject.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!|| fvinject ../starter/source/airbag/fvinject.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 fvinject(IBUF , ELEM , IBAGJET,
33 . NJET , IGRSURF,
34 . ITAGEL, NN , NEL ,
35 . ID , TAGVENT, TITR ,
36 . ITAB )
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), IBAGJET(NIBJET,*),
56 . NJET,
57 . NN, NEL, ID, TAGVENT(NUMNOD),ITAB(NUMNOD)
58 INTEGER, DIMENSION(NEL), INTENT(INOUT) :: ITAGEL
59 CHARACTER(len=nchartitle) :: TITR
60 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, II, ITABINV(NUMNOD), ITAGINJ(NN), IINJ, JINJ,
65 . ISU, NELSU, IEL, NG1, NG2, NG3, NG4, N1, N2, N3, N4,
66 . NALL, NN1, NN2, IERROR, INOD
67C
68 DO i=1,numnod
69 itabinv(i)=0
70 ENDDO
71C
72 DO i=1,nn
73 ii=ibuf(i)
74 IF(itabinv(ii)==0)itabinv(ii)=i
75C ITAGINJ(I)=0
76 ENDDO
77C
78 DO iinj=1,njet
79 isu=ibagjet(14,iinj)
80 IF(isu==0) cycle
81 nelsu=igrsurf(isu)%NSEG
82 inod=0
83 DO i = 1, nn
84 itaginj(i) = 0
85 ENDDO
86 DO iel=1,nelsu
87 ng1 = igrsurf(isu)%NODES(iel,1)
88 ng2 = igrsurf(isu)%NODES(iel,2)
89 ng3 = igrsurf(isu)%NODES(iel,3)
90 ng4 = igrsurf(isu)%NODES(iel,4)
91 n1=itabinv(ng1)
92 n2=itabinv(ng2)
93 n3=itabinv(ng3)
94 n4=itabinv(ng4)
95 ierror = 0
96 IF(n1==0.AND.tagvent(ng1)==0) THEN
97 ierror = 1
98 ELSE
99 jinj=itaginj(n1)
100 IF(jinj > 0 .AND. jinj < iinj) THEN
101 inod=inod+1
102 CALL ancmsg(msgid=1046,msgtype=msgwarning,
103 . anmode=aninfo_blind_2,
104 . i1=id,i2=itab(ng1),i3=jinj)
105 ENDIF
106 itaginj(n1)=iinj
107 END IF
108 IF(n2==0.AND.tagvent(ng2)==0) THEN
109 ierror = 1
110 ELSE
111 jinj=itaginj(n2)
112 IF(jinj > 0 .AND. jinj < iinj) THEN
113 inod=inod+1
114 CALL ancmsg(msgid=1046,msgtype=msgwarning,
115 . anmode=aninfo_blind_2,
116 . i1=id,i2=itab(ng2),i3=jinj)
117 ENDIF
118 itaginj(n2)=iinj
119 END IF
120 IF(n3==0.AND.tagvent(ng3)==0) THEN
121 ierror = 1
122 ELSE
123 jinj=itaginj(n3)
124 IF(jinj > 0 .AND. jinj < iinj) THEN
125 inod=inod+1
126 CALL ancmsg(msgid=1046,msgtype=msgwarning,
127 . anmode=aninfo_blind_2,
128 . i1=id,i2=itab(ng3),i3=jinj)
129 ENDIF
130 itaginj(n3)=iinj
131 END IF
132 IF(n4==0.AND.tagvent(ng4)==0) THEN
133 ierror = 1
134 ELSE
135 jinj=itaginj(n4)
136 IF(jinj > 0 .AND. jinj < iinj) THEN
137 inod=inod+1
138 CALL ancmsg(msgid=1046,msgtype=msgwarning,
139 . anmode=aninfo_blind_2,
140 . i1=id,i2=itab(ng4),i3=jinj)
141 ENDIF
142 itaginj(n4)=iinj
143 END IF
144 IF(ierror==1)THEN
145 CALL ancmsg(msgid=632,msgtype=msgerror,anmode=aninfo,
146 . i1=id,i2=iinj,c1=titr,c2='INFLATOR')
147 ENDIF
148 ENDDO
149 IF(inod > 0) THEN
150 CALL ancmsg(msgid=1047,msgtype=msgwarning,anmode=aninfo,
151 . i1=id,i2=iinj,i3=inod)
152 ENDIF
153C
154 DO iel=1,nel
155 n1=elem(1,iel)
156 n2=elem(2,iel)
157 n3=elem(3,iel)
158 nall=itaginj(n1)*itaginj(n2)*itaginj(n3)
159 IF (nall/=0) THEN
160 nn1=itaginj(n2)-itaginj(n1)
161 nn2=itaginj(n3)-itaginj(n1)
162 IF (nn1==0.AND.nn2==0) THEN
163 IF (itagel(iel) > 0) THEN
164 CALL ancmsg(msgid=1616,msgtype=msgwarning,
165 . anmode=aninfo_blind_2,
166 . i1=id,i2=itagel(iel),i3=itaginj(n1))
167 ENDIF
168 itagel(iel)=itaginj(n1)
169 ENDIF
170 ENDIF
171 ENDDO
172 ENDDO
173
174C
175 RETURN
176 END
subroutine fvinject(ibuf, elem, ibagjet, njet, igrsurf, itagel, nn, nel, id, tagvent, titr, itab)
Definition fvinject.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