module util use const use var use comm implicit real*8 (a-h,o-z) contains subroutine check_blowup ! note: diecast has been found to always be stable unless dt is too large ! or user-specified i.c.s or b.c.s are unphysical) call rangerle(v2,in,i0,j0,2,2,i1,j1,ijlo,ijhi,vlo,vhi) call mpi_allreduce(vhi,temp,1,mpi_real8,mpi_max,m_cart,ierr) call mpi_allreduce(vlo,tmp,1,mpi_real8,mpi_min,m_cart,ierr) tmp=temp-tmp if (tmp>=1000.) then write(14,107) itf,ijlo(1),ijlo(2),int(vlo),ijhi(1),ijhi(2),int(vhi),vhi-vlo,tmp 107 format('itf,ilo,jlo,vlo,ihi,jhi,vhi,vmx-vmn|l,vmx-vmn|g=',i8,6i5,2f8.3) write(14,109) itf 109 format('stop. unix-pectedly large velocity at itf=',i7) write(*,*) 'unix-pectedly large velocity at itf=',itf,'myid =',myid open(1111,file='data/blow_check'//grd,form='unformatted') write(1111) u2,v2,t2,s2 close(1111) call mpi_finalize(ierr) stop endif end subroutine ! ---------------------------------------------------------------------- subroutine rangerle(fld,in,ir,jr,il,jl,ih,jh,ijlo,ijhi,fmin,fmax) integer*2 in(ir,jr) real*8 fld(ir,jr) integer ijlo(2),ijhi(2) ijlo=minloc(fld(il:ih,jl:jh),mask=in(il:ih,jl:jh).eq.1) fmin=minval(fld(il:ih,jl:jh),mask=in(il:ih,jl:jh).eq.1) if(fmin>1.e20)fmin=0. ijhi=maxloc(fld(il:ih,jl:jh),mask=in(il:ih,jl:jh).eq.1) fmax=maxval(fld(il:ih,jl:jh),mask=in(il:ih,jl:jh).eq.1) if(fmax<-1.e20)fmax=0. end subroutine ! ---------------------------------------------------------------------- subroutine ranger(fld,in,ir,il,jl,ih,jh,ilo,jlo,ihi,jhi,fmin,fmax) integer*2 in(ir,*) real*8 fld(ir,*) !dog fmin=1.e20 fmax=-1.e20 do 10 j=jl,jh do 10 i=il,ih fmin=(1-in(i,j))*fmin+in(i,j)*min(fmin,fld(i,j)) 10 fmax=(1-in(i,j))*fmax+in(i,j)*max(fmax,fld(i,j)) do 20 j=jl,jh do 20 i=il,ih if (fmax.ne.fld(i,j)) go to 15 ihi=i jhi=j go to 20 15 if (fmin.ne.fld(i,j)) go to 20 ilo=i jlo=j 20 continue end subroutine end module