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