1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19      subroutine flux(node1,node2,nodem,nelem,lakon,kon,ipkon,
20     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
21     &     nodef,idirf,df,cp,R,rho,physcon,g,co,dvi,numf,
22     &     vold,set,shcon,nshcon,rhcon,nrhcon,ntmat_,mi,ider,
23     &     ttime,time,iaxial,iplausi)
24!
25!     gas element routines
26!
27!     mass flow input for all gas element routines is the gas
28!     flow for a 2 degrees segment with the correct sign
29!     (positive if from node 1 to node2 of the element,
30!      negative if from node 2 to node1 of the element)
31!
32      implicit none
33!
34      logical identity
35      character*8 lakon(*)
36      character*81 set(*)
37!
38      integer nelem,nactdog(0:3,*),node1,node2,nodem,numf,
39     &     ielprop(*),nodef(8),idirf(8),kflag,ipkon(*),kon(*),
40     &     nshcon(*), nrhcon(*),ntmat_,mi(*),ider,iaxial,iplausi
41!
42      real*8 prop(*),v(0:mi(2),*),xflow,f,df(8),R,cp,physcon(*),rho,
43     &     g(3),co(3,*),dvi,vold(0:mi(2),*),shcon(0:3,ntmat_,*),
44     &     rhcon(0:1,ntmat_,*),ttime,time
45!
46      if((lakon(nelem)(2:4).eq.'ATR')
47     &        .or.(lakon(nelem)(2:4).eq.'RTA')) then
48!
49!        absolute to relative system or vice versa
50!
51         call absolute_relative(node1,node2,nodem,nelem,lakon,kon,ipkon,
52     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
53     &        nodef,idirf,df,cp,r,physcon,numf,set,mi,ttime,time,iaxial,
54     &        iplausi)
55!
56      elseif(lakon(nelem)(2:8).eq.'ACCTUBO') then
57!
58!        proprietary
59!
60         call acctube_one(node1,node2,nodem,nelem,lakon,kon,ipkon,
61     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
62     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,mi,ider,
63     &        ttime,time,iaxial,iplausi)
64!
65      elseif(lakon(nelem)(2:8).eq.'ACCTUBE') then
66!
67!        proprietary
68!
69         call acctube(node1,node2,nodem,nelem,lakon,kon,ipkon,
70     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
71     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,mi,ider,
72     &        ttime,time,iaxial,iplausi)
73!
74!	 proprietary
75!
76      elseif(lakon(nelem)(2:5).eq.'AVLV') then
77!
78         call air_valve(node1,node2,nodem,nelem,lakon,kon,ipkon,
79     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
80     &     nodef,idirf,df,cp,R,physcon,dvi,numf,set,co,vold,mi,
81     &     ttime,time,iaxial,iplausi)
82!
83      elseif(lakon(nelem)(2:6).eq.'CARBS') then
84!
85!        carbon seal
86!
87         call carbon_seal(node1,node2,nodem,nelem,lakon,
88     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
89     &     nodef,idirf,df,R,physcon,dvi,numf,set,mi,ttime,time,
90     &     iaxial,iplausi)
91!
92      elseif(lakon(nelem)(2:5).eq.'CHAR') then
93!
94!        characteristic
95!
96         call characteristic(node1,node2,nodem,nelem,lakon,kon,ipkon,
97     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
98     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,
99     &        mi,ttime,time,iaxial,iplausi)
100!
101      elseif(lakon(nelem)(2:5).eq.'CROS') then
102!
103!        cross split
104!
105         call cross_split(node1,node2,nodem,nelem,lakon,kon,ipkon,
106     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
107     &     nodef,idirf,df,cp,r,physcon,numf,set,mi,ider,ttime,time,
108     &     iaxial,iplausi)
109!
110!     proprietary
111!
112      elseif(lakon(nelem)(2:5).eq.'FDPF') then
113         call free_disc_pumping(node1,node2,nodem,nelem,lakon,kon,ipkon,
114     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
115     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,shcon,
116     &        nshcon,rhcon,nrhcon,ntmat_,co,vold,mi,ttime,time,
117     &        iaxial,iplausi)
118!
119!     proprietary
120!
121      elseif(lakon(nelem)(2:5).eq.'FCVF') then
122         call free_convection(node1,node2,nodem,nelem,lakon,kon,ipkon,
123     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
124     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,shcon,
125     &        nshcon,rhcon,nrhcon,ntmat_,co,vold,mi,ttime,time,
126     &        iaxial,iplausi)
127!
128!     gas pipe fanno
129!
130      elseif(lakon(nelem)(2:5).eq.'GAPF') then
131!
132         call gaspipe_fanno(node1,node2,nodem,nelem,lakon,kon,ipkon,
133     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
134     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,shcon,
135     &        nshcon,rhcon,nrhcon,ntmat_,co,vold,mi,ttime,time,
136     &        iaxial,iplausi)
137!
138!     rotating gas pipe
139!
140      elseif(lakon(nelem)(2:5).eq.'GAPR') then
141!
142         call gaspipe_rot(node1,node2,nodem,nelem,lakon,kon,ipkon,
143     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
144     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,shcon,
145     &        nshcon,rhcon,nrhcon,ntmat_,co,vold,mi,ttime,time,
146     &        iaxial,iplausi)
147!
148!     straight and stepped labyrinth
149!
150      elseif(lakon(nelem)(2:4).eq.'LAB') then
151!
152         call labyrinth(node1,node2,nodem,nelem,lakon,
153     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
154     &     nodef,idirf,df,cp,R,physcon,co,dvi,numf,vold,set,
155     &     kon,ipkon,mi,ttime,time,iaxial,iplausi)
156!
157!     liquid pipes including loss elements (hydraulic elements)
158!
159      elseif(lakon(nelem)(2:5).eq.'LIPI') then
160!
161         call liquidpipe(node1,node2,nodem,nelem,lakon,nactdog,identity,
162     &           ielprop,prop,kflag,v,xflow,f,nodef,idirf,df,
163     &           rho,g,co,dvi,numf,vold,mi,ipkon,kon,set,ttime,time,
164     &           iaxial,iplausi)
165!
166!     liquid channel (flow with free surface) including all loss elements
167!
168      elseif(lakon(nelem)(2:5).eq.'LICH') then
169!
170         call liquidchannel(node1,node2,nodem,nelem,lakon,nactdog,
171     &           identity,ielprop,prop,kflag,v,xflow,f,nodef,idirf,df,
172     &           rho,g,co,dvi,numf,mi,ipkon,kon,iplausi)
173!
174!     liquid pipes including loss elements (types derived from their
175!     compressible equivalent)
176!
177      elseif(lakon(nelem)(2:3).eq.'LP') then
178!
179         call liquidpipe(node1,node2,nodem,nelem,lakon,nactdog,identity,
180     &           ielprop,prop,kflag,v,xflow,f,nodef,idirf,df,
181     &           rho,g,co,dvi,numf,vold,mi,ipkon,kon,set,ttime,time,
182     &           iaxial,iplausi)
183!
184!     liquid pump
185!
186      elseif(lakon(nelem)(2:5).eq.'LIPU') then
187!
188         call liquidpump(node1,node2,nodem,nelem,nactdog,identity,
189     &           ielprop,prop,kflag,v,xflow,f,nodef,idirf,df,
190     &           rho,g,co,numf,mi,ttime,time,iaxial,iplausi)
191!
192!     element that fixes the mass flow as a specific percentage of the
193!     sum of the massflow of up to 10 other elements
194!
195      elseif(lakon(nelem)(2:5).eq.'MFPC') then
196         call massflow_percent(node1,node2,nodem,nelem,lakon,kon,ipkon,
197     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
198     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,shcon,
199     &        nshcon,rhcon,nrhcon,ntmat_,co,vold,mi,ttime,time,
200     &        iaxial,iplausi)
201!
202!     Moehring
203!
204      elseif(lakon(nelem)(2:4).eq.'MRG') then
205!
206         call moehring(node1,node2,nodem,nelem,lakon,kon,ipkon,
207     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
208     &        nodef,idirf,df,cp,r,dvi,numf,set,mi,ttime,time,
209     &        iaxial,iplausi)
210!
211!     Bleed tapping, orifice and pre-swirl nozzle
212!
213      elseif(lakon(nelem)(2:3).eq.'OR') then
214!
215         call orifice(node1,node2,nodem,nelem,lakon,kon,ipkon,
216     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
217     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,co,vold,mi,
218     &        ttime,time,iaxial,iplausi)
219!
220!     proprietary
221!
222      elseif(lakon(nelem)(2:4).eq.'RCV') then
223!
224         call rcavi(node1,node2,nodem,nelem,lakon,kon,ipkon,
225     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
226     &     nodef,idirf,df,cp,R,dvi,numf,set,mi,ttime,time,
227     &     iaxial,iplausi)
228!
229!     proprietary
230!
231      elseif(lakon(nelem)(2:3).eq.'RO') then
232!
233         call rcavi2(node1,node2,nodem,nelem,lakon,kon,ipkon,
234     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
235     &     nodef,idirf,df,cp,R,dvi,numf,set,mi,ttime,time,
236     &     iaxial,iplausi)
237!
238!     restrictors
239!
240      elseif(((lakon(nelem)(2:3).eq.'RE').or.
241     &        (lakon(nelem)(2:3).eq.'RB')).and.
242     &       (lakon(nelem)(2:8).ne.'REBRSI1').and.
243     &       (lakon(nelem)(2:8).ne.'REBRSI2')) then
244!
245         call restrictor(node1,node2,nodem,nelem,lakon,kon,ipkon,
246     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
247     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,shcon,
248     &        nshcon,rhcon,nrhcon,ntmat_,mi,ttime,time,iaxial,
249     &        co,vold,iplausi)
250!
251!     proprietary
252!
253      elseif((lakon(nelem)(2:5).eq.'RIMS').or.
254     &       (lakon(nelem)(2:8).eq.'RIMFLEX')) then
255!
256         call rimseal(node1,node2,nodem,nelem,lakon,kon,ipkon,
257     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
258     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,mi,
259     &        ttime,time,iaxial,co,vold,iplausi)
260!
261!     proprietary
262!
263      elseif(lakon(nelem)(2:6).eq.'SPUMP') then
264!
265        call scavenge_pump(node1,node2,nodem,nelem,lakon,kon,ipkon,
266     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
267     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,ntmat_,mi,
268     &        ttime,time,iaxial,iplausi)
269!
270!     branch split Idelchik2
271!
272      elseif(lakon(nelem)(2:8).eq.'REBRSI2') then
273!
274         call tee(node1,node2,nodem,nelem,lakon,kon,ipkon,
275     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
276     &     nodef,idirf,df,cp,r,physcon,numf,set,mi,ider,ttime,time,
277     &     iaxial,iplausi)
278!
279!     user element
280!
281      elseif(lakon(nelem)(2:2).eq.'U') then
282!
283         call user_network_element(node1,node2,nodem,nelem,lakon,kon,
284     &        ipkon,nactdog,identity,ielprop,prop,kflag,v,xflow,f,
285     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,co,vold,mi,
286     &        ttime,time,iaxial,iplausi)
287!
288!     vortex
289!
290      elseif(lakon(nelem)(2:3).eq.'VO') then
291!
292         call vortex(node1,node2,nodem,nelem,lakon,kon,ipkon,
293     &        nactdog,identity,ielprop,prop,kflag,v,xflow,f,
294     &        nodef,idirf,df,cp,r,numf,set,mi,ttime,time,iaxial,
295     &        iplausi)
296!
297!     branch split Idelchik1
298!
299      elseif(lakon(nelem)(2:8).eq.'REBRSI1') then
300!
301         call wye(node1,node2,nodem,nelem,lakon,kon,ipkon,
302     &     nactdog,identity,ielprop,prop,kflag,v,xflow,f,
303     &     nodef,idirf,df,cp,r,physcon,numf,set,mi,ider,ttime,time,
304     &     iaxial,iplausi,dvi)
305!
306      else
307         identity=.true.
308!
309      endif
310!
311      return
312      end
313
314