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 postinitialnet(ieg,lakon,v,ipkon,kon,nflow,prop,
20     &     ielprop,ielmat,ntmat_,shcon,nshcon,rhcon,nrhcon,mi,iponoel,
21     &     inoel,itg,ntg,nactdog)
22!
23!     this routine only applies to compressible networks
24!
25!     determination of initial values based on the boundary conditions
26!     and the initial values given by the user by propagating these
27!     through the network (using information on the mass flow direction
28!     derived from unidirectional network elements or mass flow given
29!     by the user (boundary conditions or initial conditions))
30!
31!     it is assumed that mass flows cannot
32!     be identically zero (a zero mass flow leads to convergence problems).
33!
34!     This routine is used for elements in which the pressure gradient
35!     does not allow to determine the mass flow, e.g. the free vortex,
36!     the forced vortex and the rotating pipe
37!
38      implicit none
39!
40      character*8 lakon(*)
41!
42      integer mi(*),ieg(*),nflow,i,ielmat(mi(3),*),ntmat_,node1,node2,
43     &     nelem,index,nshcon(*),ipkon(*),kon(*),nodem,imat,ielprop(*),
44     &     nrhcon(*),neighbor,ichange,iponoel(*),inoel(2,*),indexe,
45     &     itg(*),ntg,j,nactdog(0:3,*)
46!
47      real*8 prop(*),shcon(0:3,ntmat_,*),xflow,v(0:mi(2),*),cp,r,
48     &     dvi,rho,rhcon(0:1,ntmat_,*),kappa,cti,Ti,ri,ro,p1zp2,omega,
49     &     p2zp1
50!
51c      write(*,*) 'postinitialnet '
52c      do i=1,ntg
53c         write(*,'(i10,3(1x,e11.4))') itg(i),(v(j,itg(i)),j=0,2)
54c      enddo
55!
56      do
57         ichange=0
58!
59!        propagation of the mass flow through the network
60!
61         do i=1,nflow
62            nelem=ieg(i)
63            indexe=ipkon(nelem)
64            nodem=kon(indexe+2)
65!
66            if((dabs(v(1,nodem)).le.0.d0).and.
67     &         (nactdog(1,nodem).ne.0)) then
68!
69!              no initial mass flow given yet
70!              check neighbors for mass flow (only if not
71!              branch nor joint)
72!
73!              first end node
74!
75               node1=kon(indexe+1)
76!
77               if(node1.ne.0) then
78                  index=iponoel(node1)
79!
80                  if(inoel(2,inoel(2,index)).eq.0) then
81!
82!                 no branch nor joint; determine neighboring element
83!
84                     if(inoel(1,index).eq.nelem) then
85                        neighbor=inoel(1,inoel(2,index))
86                     else
87                        neighbor=inoel(1,index)
88                     endif
89!
90!                 initial mass flow in neighboring element
91!
92                     xflow=v(1,kon(ipkon(neighbor)+2))
93!
94                     if(dabs(v(1,nodem)).gt.0.d0) then
95!
96!                    propagate initial mass flow
97!
98                        if(dabs(xflow).gt.0.d0) then
99                           v(1,nodem)=xflow
100                           ichange=1
101                           cycle
102                        endif
103                     else
104!
105!                    propagate only the sign of the mass flow
106!
107                        if(dabs(xflow).gt.0.d0) then
108                           v(1,nodem)=xflow
109                           ichange=1
110                           cycle
111                        endif
112                     endif
113                  endif
114               endif
115!
116!              second end node
117!
118               node2=kon(indexe+3)
119!
120               if(node2.ne.0) then
121                  index=iponoel(node2)
122!
123                  if(inoel(2,inoel(2,index)).eq.0) then
124!
125!                 no branch nor joint; determine neighboring element
126!
127                     if(inoel(1,index).eq.nelem) then
128                        neighbor=inoel(1,inoel(2,index))
129                     else
130                        neighbor=inoel(1,index)
131                     endif
132!
133!                 initial mass flow in neighboring element
134!
135                     xflow=v(1,kon(ipkon(neighbor)+2))
136!
137                     if(dabs(v(1,nodem)).gt.0.d0) then
138!
139!                    propagate initial mass flow
140!
141                        if(dabs(xflow).gt.0.d0) then
142                           v(1,nodem)=xflow
143                           ichange=1
144                           cycle
145                        endif
146                     else
147!
148!                    propagate only the sign of the mass flow
149!
150                        if(dabs(xflow).gt.0.d0) then
151                           v(1,nodem)=xflow
152                           ichange=1
153                           cycle
154                        endif
155                     endif
156                  endif
157               endif
158            endif
159         enddo
160c         write(*,*) 'postinitialnet '
161c         do i=1,ntg
162c            write(*,'(i10,3(1x,e11.4))') itg(i),(v(j,itg(i)),j=0,2)
163c         enddo
164         if(ichange.eq.0) exit
165      enddo
166!
167      return
168      end
169
170
171