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