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