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 printoutfluid(set,nset,istartset,iendset,ialset,nprint,
20     &     prlab,prset,ipkonf,lakonf,sti,eei,xstate,ener,
21     &     mi,nstate_,co,konf,qfx,ttime,trab,inotr,ntrans,
22     &     orab,ielorienf,norien,vold,ielmatf,thicke,
23     &     eme,xturb,physcon,nactdoh,ielpropf,prop,xkappa,xmach,
24     &     ithermal,orname)
25!
26!     stores results in the .dat file
27!
28      implicit none
29!
30      character*6 prlab(*)
31      character*8 lakonf(*)
32      character*80 noset,elset,orname(*)
33      character*81 set(*),prset(*)
34!
35      integer nset,istartset(*),iendset(*),ialset(*),nprint,ipkonf(*),
36     &     mi(*),nstate_,ii,jj,iset,l,limit,node,ipos,nelel,ithermal(*),
37     &     nelem,konf(*),inotr(2,*),ntrans,ielorienf(mi(3),*),norien,
38     &     mt,ielmatf(mi(3),*),nactdoh(*),id,ielpropf(*)
39!
40      real*8 sti(6,mi(1),*),xkappa(*),xmach(*),
41     &     eei(6,mi(1),*),xstate(nstate_,mi(1),*),ener(mi(1),*),
42     &     co(3,*),qfx(3,mi(1),*),ttime,
43     &     trab(7,*),orab(7,*),vold(0:mi(2),*),thicke(mi(3),*),
44     &     eme(6,mi(1),*),xturb(2,*),physcon(*),prop(*)
45!
46      mt=mi(2)+1
47!
48      do ii=1,nprint
49!
50!     nodal values
51!
52        if((prlab(ii)(1:4).eq.'VF  ').or.(prlab(ii)(1:4).eq.'PSF ').or.
53     &      (prlab(ii)(1:4).eq.'TSF ').or.(prlab(ii)(1:4).eq.'PTF ').or.
54     &      (prlab(ii)(1:4).eq.'TTF ').or.(prlab(ii)(1:4).eq.'CP  ').or.
55     &      (prlab(ii)(1:4).eq.'TURB').or.(prlab(ii)(1:4).eq.'MACH'))
56     &       then
57!
58          ipos=index(prset(ii),' ')
59          noset='                    '
60          noset(1:ipos-1)=prset(ii)(1:ipos-1)
61!
62!     printing the header
63!
64          if(prlab(ii)(1:4).eq.'VF  ') then
65            write(5,*)
66            write(5,100) noset(1:ipos-2),ttime
67 100        format(' velocities (vx,vy,vz) for set ',A,
68     &           ' and time ',e14.7)
69            write(5,*)
70          elseif(prlab(ii)(1:4).eq.'PSF ') then
71            write(5,*)
72            write(5,101) noset(1:ipos-2),ttime
73 101        format(' static pressures for set ',A,' and time ',e14.7)
74            write(5,*)
75          elseif(prlab(ii)(1:5).eq.'TSF ') then
76            write(5,*)
77            write(5,102) noset(1:ipos-2),ttime
78 102        format(' static temperatures for set ',A,
79     &           ' and time ',e14.7)
80            write(5,*)
81          elseif(prlab(ii)(1:5).eq.'PTF ') then
82            write(5,*)
83            write(5,103) noset(1:ipos-2),ttime
84 103        format(' total pressures for set ',A,' and time ',e14.7)
85            write(5,*)
86          elseif(prlab(ii)(1:4).eq.'TTF ') then
87            write(5,*)
88            write(5,115) noset(1:ipos-2),ttime
89 115        format(' total temperatures for set ',A,' and time ',
90     &           e14.7)
91            write(5,*)
92          elseif(prlab(ii)(1:4).eq.'CP  ') then
93            write(5,*)
94            write(5,117) noset(1:ipos-2),ttime
95 117        format(' pressure coefficients for set ',
96     &           A,' and time ',e14.7)
97            write(5,*)
98          elseif(prlab(ii)(1:4).eq.'TURB') then
99            write(5,*)
100            write(5,118) noset(1:ipos-2),ttime
101 118        format(' turbulence variables for set ',A,
102     &           ' and time ',e14.7)
103            write(5,*)
104          elseif(prlab(ii)(1:4).eq.'MACH') then
105            write(5,*)
106            write(5,119) noset(1:ipos-2),ttime
107 119        format(' Mach numbers for set ',A,
108     &           ' and time ',e14.7)
109            write(5,*)
110          endif
111!
112!     printing the data
113!
114c     do iset=1,nset
115c     if(set(iset).eq.prset(ii)) exit
116c     enddo
117          call cident81(set,prset(ii),nset,id)
118          iset=nset+1
119          if(id.gt.0) then
120            if(prset(ii).eq.set(id)) then
121              iset=id
122            endif
123          endif
124          do jj=istartset(iset),iendset(iset)
125            if(ialset(jj).lt.0) cycle
126            if(jj.eq.iendset(iset)) then
127              node=ialset(jj)
128              call printoutnodefluid(prlab,vold,xturb,physcon,
129     &             ii,node,trab,inotr,ntrans,co,mi,xkappa,xmach)
130            elseif(ialset(jj+1).gt.0) then
131              node=ialset(jj)
132              call printoutnodefluid(prlab,vold,xturb,physcon,
133     &             ii,node,trab,inotr,ntrans,co,mi,xkappa,xmach)
134            else
135              do node=ialset(jj-1)-ialset(jj+1),ialset(jj),
136     &             -ialset(jj+1)
137                call printoutnodefluid(prlab,vold,xturb,physcon,
138     &               ii,node,trab,inotr,ntrans,co,mi,xkappa,xmach)
139              enddo
140            endif
141          enddo
142!
143!     integration point values
144!
145        elseif((prlab(ii)(1:4).eq.'SVF ').or.
146     &         (prlab(ii)(1:4).eq.'HFLF')) then
147!
148          ipos=index(prset(ii),' ')
149          elset='                    '
150          elset(1:ipos-1)=prset(ii)(1:ipos-1)
151!
152          limit=1
153!
154          do l=1,limit
155!
156!     printing the header
157!
158            if(prlab(ii)(1:4).eq.'SVF ') then
159              write(5,*)
160              write(5,106) elset(1:ipos-2),ttime
161 106          format(' viscous stresses (elem, integ.pnt.,sxx,syy,sz
162     &z,sxy,sxz,syz) for set ',A,' and time ',e14.7)
163              write(5,*)
164            elseif(prlab(ii)(1:4).eq.'HFLF') then
165              write(5,*)
166              write(5,112) elset(1:ipos-2),ttime
167 112          format(' heat flux (elem, integ.pnt.,qx,qy,qz) for set
168     &',A,' and time ',e14.7)
169              write(5,*)
170            endif
171!
172!     printing the data
173!
174c     do iset=1,nset
175c     if(set(iset).eq.prset(ii)) exit
176c     enddo
177            call cident81(set,prset(ii),nset,id)
178            iset=nset+1
179            if(id.gt.0) then
180              if(prset(ii).eq.set(id)) then
181                iset=id
182              endif
183            endif
184            do jj=istartset(iset),iendset(iset)
185              if(ialset(jj).lt.0) cycle
186              if(jj.eq.iendset(iset)) then
187                nelem=ialset(jj)
188                nelel=nactdoh(nelem)
189                call printoutint(prlab,ipkonf,lakonf,sti,eei,
190     &               xstate,ener,mi(1),nstate_,ii,nelem,qfx,
191     &               orab,ielorienf,norien,co,konf,ielmatf,thicke,
192     &               eme,ielpropf,prop,nelel,ithermal,
193     &               orname)
194              elseif(ialset(jj+1).gt.0) then
195                nelem=ialset(jj)
196                nelel=nactdoh(nelem)
197                call printoutint(prlab,ipkonf,lakonf,sti,eei,
198     &               xstate,ener,mi(1),nstate_,ii,nelem,qfx,orab,
199     &               ielorienf,norien,co,konf,ielmatf,thicke,eme,
200     &               ielpropf,prop,nelel,ithermal,
201     &               orname)
202              else
203                do nelem=ialset(jj-1)-ialset(jj+1),ialset(jj),
204     &               -ialset(jj+1)
205                  nelel=nactdoh(nelem)
206                  call printoutint(prlab,ipkonf,lakonf,sti,eei,
207     &                 xstate,ener,mi(1),nstate_,ii,nelem,
208     &                 qfx,orab,ielorienf,norien,co,konf,ielmatf,
209     &                 thicke,eme,ielpropf,prop,nelel,ithermal,
210     &                 orname)
211                enddo
212              endif
213            enddo
214!
215          enddo
216        endif
217      enddo
218!
219      return
220      end
221