xref: /phasta/phSolver/compressible/rstat.f (revision cc72a73fd2b79f4dd0a850fa4af718cd73554811)
1        subroutine rstat (res, ilwork, b)
2c
3c----------------------------------------------------------------------
4c
5c This subroutine calculates the statistics of the residual.
6c
7c input:
8c  res   (nshg,nflow)   : preconditioned residual
9c
10c output:
11c  The time step, cpu-time and entropy-norm of the residual
12c     are printed in the file HISTOR.DAT.
13c
14c
15c Zdenek Johan, Winter 1991.  (Fortran 90)
16c----------------------------------------------------------------------
17c
18        include "common.h"
19        include "mpif.h"
20        include "auxmpi.h"
21c
22        dimension res(nshg,nflow)
23        dimension b(nshg,nflow)
24        dimension rtmp(nshg,2), nrsmax(1), ilwork(nlwork)
25        real*8 resnrm(2), totres(2), eachproc(2)
26        integer jtotrs(2)
27        dimension Forin(4), Forout(4)
28!SCATTER        dimension irecvcount(numpe), resvec(numpe)
29c        integer TMRC
30
31
32        real*8  ftots(3,0:MAXSURF),ftot(3),spmasstot(0:MAXSURF),spmasss
33
34	ttim(68) = ttim(68) - secs(0.0)
35
36        if (numpe == 1) nshgt=nshg   ! global = this processor
37c
38c incompressible style data from flx surface
39c
40      if (numpe > 1) then
41         call MPI_ALLREDUCE (flxID(2,isrfIM), spmasss,1,
42     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
43         call MPI_ALLREDUCE (flxID(1,isrfIM), Atots,1,
44     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
45         call MPI_ALLREDUCE (flxID(3,:), Ftots(1,:),MAXSURF+1,
46     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
47         call MPI_ALLREDUCE (flxID(4,:), Ftots(2,:),MAXSURF+1,
48     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
49         call MPI_ALLREDUCE (flxID(5,:), Ftots(3,:),MAXSURF+1,
50     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
51         call MPI_ALLREDUCE (flxID(2,:), spmasstot(:),MAXSURF+1,
52     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
53      else
54         Ftots=flxID(3:5,:)
55         Atots=flxID(1,isrfIM)
56         spmasss=flxID(2,isrfIM)
57         spmasstot(:)=flxID(2,:)
58      endif
59! 	if(myrank.eq.0) then
60!     write(44,1000)lstep+1,(spmasstot(j),j=1,5)
61!     call flush(44)
62!	endif
63      ftot(1)=sum(Ftots(1,0:MAXSURF))
64      ftot(2)=sum(Ftots(2,0:MAXSURF))
65      ftot(3)=sum(Ftots(3,0:MAXSURF))
66c
67c end of incompressible style
68c
69c
70c.... -------------------->  Aerodynamic Forces  <----------------------
71c
72c.... output the forces and the heat flux
73c
74        if (iter .eq. nitr) then
75          Forin = (/ Force(1), Force(2), Force(3), HFlux /)
76          if (numpe > 1) then
77          call MPI_REDUCE (Forin(1), Forout(1), 4, MPI_DOUBLE_PRECISION,
78     &                                   MPI_SUM, master,
79     &                                   MPI_COMM_WORLD,ierr)
80          endif
81          Force = Forout(1:3)
82          HFlux = Forout(4)
83          if (myrank .eq. master) then
84             write (iforce,1000) lstep+1, (Force(i), i=1,nsd), HFlux,
85     &                           spmasss
86             call flush(iforce)
87          endif
88        endif
89c
90c.... ----------------------->  Convergence  <-------------------------
91c
92c.... compute the maximum residual and the corresponding node number
93c
94        rtmp = zero
95        do i = 1, nflow
96          rtmp(:,1) = rtmp(:,1) + res(:,i)**2
97          rtmp(:,2) = rtmp(:,2) + b(:,i)**2
98        enddo
99
100         eachproc(1)=sum(rtmp(:,1))
101         eachproc(2)=sum(rtmp(:,2))
102         call drvAllReduce (eachproc,resnrm,2)
103
104c
105c.... approximate the number of entries
106c
107        totres = sqrt(resnrm) / float(nshgt)
108        if(resfrt(1) .eq. zero) resfrt = totres
109        jtotrs(1) = int  ( 10.d0 * log10 ( totres(1) / resfrt(1) ) )
110        jtotrs(2) = int  ( 10.d0 * log10 ( totres(2) / resfrt(2) ) )
111c
112c.... get the CPU-time
113c
114        rsec=TMRC()
115        cputme = (rsec-ttim(100))
116c
117c.... output the result
118c
119        if (myrank .eq. master) then
120          !modified to not advance so that solver tolerance satisfaction failure
121          ! can be appended. The line wrap occurs in solgmr
122          if(usingPETSc.eq.0) then
123           write(*, 2000, advance="no") lstep+1, cputme,
124     &           totres(1), jtotrs(1),
125     &           totres(2), jtotrs(2),
126     &                      lGMRES,  iKs, ntotGM
127          else
128           write(*, 2000)       lstep+1, cputme,
129     &            totres(1), jtotrs(1),
130     &            totres(2), jtotrs(2),
131     &                      lGMRES,  iKs, ntotGM
132          endif
133           write(ihist, 2000)       lstep+1, cputme,
134     &            totres(1), jtotrs(1),
135     &            totres(2), jtotrs(2),
136     &                      lGMRES,  iKs, ntotGM
137          call flush(ihist)
138        endif
139	ttim(68) = ttim(68) + secs(0.0)
140
141c
142c.... return
143c
144        return
145c
1461000    format(1p,i6,5e13.5)
1472000    format(1p,i6,e10.3,e10.3,1x,'(',i4,')',
148     &                  1x,e10.3,1x,'(',i4,')',
149     &         ' [',i3,'-',i3,']',i10)
150c
151        end
152        subroutine rstatSclr (rest, ilwork)
153c
154c----------------------------------------------------------------------
155c
156c This subroutine calculates the statistics of the residual.
157c
158c input:
159c  rest   (nshg)   : preconditioned residual
160c
161c output:
162c  The time step, cpu-time and entropy-norm of the residual
163c     are printed in the file HISTOR.DAT.
164c
165c
166c Zdenek Johan, Winter 1991.  (Fortran 90)
167c----------------------------------------------------------------------
168c
169        include "common.h"
170        include "mpif.h"
171        include "auxmpi.h"
172c
173        dimension rest(nshg)
174        dimension rtmp(nshg), nrsmax(1), ilwork(nlwork)
175!SCATTER        dimension irecvcount(numpe), resvec(numpe)
176c        integer TMRC
177
178	ttim(68) = ttim(68) - secs(0.0)
179        if (numpe == 1) nshgt=nshg   ! global = this processor
180c
181c.... ----------------------->  Convergence  <-------------------------
182c
183c.... compute the maximum residual and the corresponding node number
184c
185        rtmp = zero
186        rtmp = rtmp + rest**2
187
188        call sumgat (rtmp, 1, resnrm, ilwork)
189
190        resmaxl = maxval(rtmp)
191
192continue on
193
194        irecvcount = 1
195        resvec = resmaxl
196        if (numpe > 1) then
197        call MPI_ALLREDUCE (resvec, resmax, irecvcount,
198     &                    MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_WORLD,
199     &                    ierr)
200c        call MPI_REDUCE_SCATTER (resvec, resmax, irecvcount,
201c     &                    MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_WORLD,
202c     &                    ierr)
203        else
204          resmax=resmaxl
205        endif
206        nrsmax = maxloc(rtmp)
207c
208c.... correct the residuals
209c
210        if (loctim(itseq) .eq. 0) then
211          resnrm = resnrm
212          resmax = resmax
213        else
214          resnrm = resnrm
215          resmax = resmax
216        endif
217c
218c.... approximate the number of entries
219c
220        totres = resnrm / float(nshgt)
221        totres = sqrt(totres)
222        resmax = sqrt(resmax)
223        if (resfrts .eq. zero) resfrts = totres
224        jtotrs = int  ( 10.d0 * log10 ( totres / resfrts ) )
225        jresmx = int  ( 10.d0 * log10 ( resmax / totres ) )
226c
227c.... get the CPU-time
228c
229        rsec=TMRC()
230        cputme = (rsec-ttim(100))
231c
232c.... output the result
233c
234        if (myrank .eq. master) then
235          print 2000,        lstep+1, cputme, totres, jtotrs, nrsmax,
236     &                     jresmx, lgmress,  iKss, ntotGMs
237          write (ihist,2000) lstep+1, cputme, totres, jtotrs, nrsmax,
238     &                     jresmx, lgmress,  iKss, ntotGMs
239          call flush(ihist)
240        endif
241        if(totres.gt.1.0e-9) istop=istop-1
242
243	ttim(68) = ttim(68) + secs(0.0)
244
245c
246c.... return
247c
248        return
249c
2501000    format(1p,i6,4e13.5)
2512000    format(1p,i6,e10.3,e10.3,3x,'(',i4,')',3x,'<',i6,'|',i4,'>',
252     &         ' [',i3,'-',i3,']',i10)
253c
254        end
255        subroutine rstatp (resNrm,resNrmP)
256c
257c----------------------------------------------------------------------
258c
259c This subroutine calculates the statistics of the residual.
260c
261c input:
262c  res   (nshg,nflow)   : preconditioned residual
263c
264c output:
265c  The time step, cpu-time and entropy-norm of the residual
266c     are printed in the file HISTOR.DAT.
267c
268c
269c Zdenek Johan, Winter 1991.  (Fortran 90)
270c----------------------------------------------------------------------
271c
272        include "common.h"
273        include "mpif.h"
274        include "auxmpi.h"
275c
276        dimension Forin(4), Forout(4)
277!SCATTER        dimension irecvcount(numpe), resvec(numpe)
278c        integer TMRC
279
280
281        real*8  ftots(3,0:MAXSURF),ftot(3),spmasstot(0:MAXSURF),spmasss
282
283	ttim(68) = ttim(68) - secs(0.0)
284
285        if (numpe == 1) nshgt=nshg   ! global = this processor
286c
287c incompressible style data from flx surface
288c
289      if (numpe > 1) then
290         call MPI_ALLREDUCE (flxID(2,isrfIM), spmasss,1,
291     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
292         call MPI_ALLREDUCE (flxID(1,isrfIM), Atots,1,
293     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
294         call MPI_ALLREDUCE (flxID(3,:), Ftots(1,:),MAXSURF+1,
295     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
296         call MPI_ALLREDUCE (flxID(4,:), Ftots(2,:),MAXSURF+1,
297     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
298         call MPI_ALLREDUCE (flxID(5,:), Ftots(3,:),MAXSURF+1,
299     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
300         call MPI_ALLREDUCE (flxID(2,:), spmasstot(:),MAXSURF+1,
301     &        MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
302      else
303         Ftots=flxID(3:5,:)
304         Atots=flxID(1,isrfIM)
305         spmasss=flxID(2,isrfIM)
306         spmasstot(:)=flxID(2,:)
307      endif
308      ftot(1)=sum(Ftots(1,0:MAXSURF))
309      ftot(2)=sum(Ftots(2,0:MAXSURF))
310      ftot(3)=sum(Ftots(3,0:MAXSURF))
311c
312c end of incompressible style
313c
314c
315c.... -------------------->  Aerodynamic Forces  <----------------------
316c
317c.... output the forces and the heat flux
318c
319        if (iter .eq. nitr) then
320          Forin = (/ Force(1), Force(2), Force(3), HFlux /)
321          if (numpe > 1) then
322          call MPI_REDUCE (Forin(1), Forout(1), 4, MPI_DOUBLE_PRECISION,
323     &                                   MPI_SUM, master,
324     &                                   MPI_COMM_WORLD,ierr)
325          endif
326          Force = Forout(1:3)
327          HFlux = Forout(4)
328          if (myrank .eq. master) then
329             write (iforce,1000) lstep+1, (Force(i), i=1,nsd), HFlux,
330     &                           spmasss
331             call flush(iforce)
332          endif
333        endif
334
335c
336c.... approximate the number of entries
337c
338        totres =resNrm / sqrt(float(nshgt))
339        if (resfrt(1) .eq. zero) resfrt(1) = totres
340        jtotrs = int  ( 10.d0 * log10 ( totres / resfrt(1) ) )
341
342        totresP =resNrmP / sqrt(float(nshgt))
343        if (resfrt(2) .eq. zero) resfrt(2) = totresP
344        jtotrsP = int  ( 10.d0 * log10 ( totresP / resfrt(2) ) )
345c
346c.... get the CPU-time
347c
348        rsec=TMRC()
349        cputme = (rsec-ttim(100))
350c
351c.... output the result
352c
353        if (myrank .eq. master) then
354           write(*, 2000)       lstep+1, cputme,
355     &            totresP, jtotrsP,
356     &            totres , jtotrs,
357     &                      lGMRES,  iKs, ntotGM
358           write(ihist, 2000)       lstep+1, cputme,
359     &            totresP, jtotrsP,
360     &            totres , jtotrs,
361     &                      lGMRES,  iKs, ntotGM
362          call flush(ihist)
363        endif
364	ttim(68) = ttim(68) + secs(0.0)
365
366c
367c.... return
368c
369        return
370c
3711000    format(1p,i6,5e13.5)
3722000    format(1p,i6,e10.3,e10.3,1x,'(',i4,')',
373     &                  1x,e10.3,1x,'(',i4,')',
374     &         ' [',i3,'-',i3,']',i10)
375c
376        end
377        subroutine rstatpSclr (resnrm )
378c
379c----------------------------------------------------------------------
380c
381c This subroutine calculates the statistics of the residual.
382c
383c input:
384c  rest   (nshg)   : preconditioned residual
385c
386c output:
387c  The time step, cpu-time and entropy-norm of the residual
388c     are printed in the file HISTOR.DAT.
389c
390c
391c Zdenek Johan, Winter 1991.  (Fortran 90)
392c----------------------------------------------------------------------
393c
394        include "common.h"
395        include "mpif.h"
396        include "auxmpi.h"
397c
398        dimension rest(nshg)
399        dimension rtmp(nshg), nrsmax(1), ilwork(nlwork)
400!SCATTER        dimension irecvcount(numpe), resvec(numpe)
401c        integer TMRC
402
403	ttim(68) = ttim(68) - secs(0.0)
404        if (numpe == 1) nshgt=nshg   ! global = this processor
405c
406c.... ----------------------->  Convergence  <-------------------------
407c
408          resmax = 1
409c
410c.... approximate the number of entries
411c
412        totres = resnrm*resnrm / float(nshgt)
413        totres = sqrt(totres)
414        if (resfrts .eq. zero) resfrts = totres
415        jtotrs = int  ( 10.d0 * log10 ( totres / resfrts ) )
416        jresmx = int  ( 10.d0 * log10 ( resmax / totres ) )
417c
418c.... get the CPU-time
419c
420        rsec=TMRC()
421        cputme = (rsec-ttim(100))
422c
423c.... output the result
424c
425        if (myrank .eq. master) then
426          print 2000,        lstep+1, cputme, totres, jtotrs, nrsmax,
427     &                     jresmx, lgmress,  iKss, ntotGMs
428          write (ihist,2000) lstep+1, cputme, totres, jtotrs, nrsmax,
429     &                     jresmx, lgmress,  iKss, ntotGMs
430          call flush(ihist)
431        endif
432        if(totres.gt.1.0e-9) istop=istop-1
433
434	ttim(68) = ttim(68) + secs(0.0)
435
436c
437c.... return
438c
439        return
440c
4411000    format(1p,i6,4e13.5)
4422000    format(1p,i6,e10.3,e10.3,3x,'(',i4,')',3x,'<',i6,'|',i4,'>',
443     &         ' [',i3,'-',i3,']',i10)
444c
445        end
446
447