Fixed amr_module.f and removed integer*1 arrays from the module.

src/2d/amr_module.f

@@ -1,14 +1,17 @@
 
        module amr_module
-
+       implicit double precision(a-h,o-z)
+
+       save
+
 c      ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 c      :::::   data structure info.
 c      ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 c
        integer    cornxlo,cornylo,cornxhi,cornyhi,timemult
        integer    store1,store2,storeaux
        integer    tempptr,errptr,ffluxptr,cfluxptr
-       integer    rsize
+       integer    rsize, horizontal, vertical
 
        parameter (rsize =  5)
        parameter (nsize = 13)
@@ -41,6 +44,7 @@ module amr_module
        parameter (nil  = 0)
 
 c :::::::  for flagging points
+
        parameter (goodpt = 0.0)
        parameter (badpt  = 2.0)
        parameter (badpro = 3.0)
@@ -49,13 +53,13 @@ module amr_module
        parameter (iinfinity = 999999)
        parameter (horizontal = 1)
        parameter (vertical = 2)
-       parameter  (maxgr = 500)
+       parameter  (maxgr = 5000)
        parameter  (maxlv = 10)
        parameter  (maxcl = 500)
 
 c      The max1d parameter should be changed if using OpenMP grid based 
 c      looping, usually set to max1d = 60
-       parameter  (max1d = 500)
+       parameter  (max1d = 60)
 
        parameter  (maxvar = 10)
        parameter  (maxaux = 20)
@@ -89,9 +93,9 @@ module amr_module
 c        common  /calloc/   alloc(memsize)
 
 c      Dynamic memory: 
-       double precision, save, allocatable, target, dimension(:) ::
+       double precision, allocatable, target, dimension(:) ::
      &        storage
-       double precision, save, pointer, dimension(:) :: alloc
+       double precision, pointer, dimension(:) :: alloc
        integer memsize
 
 
@@ -128,7 +132,7 @@ module amr_module
        parameter (maxwave = 10)
        character * 10 auxtype(maxaux)
        integer  method(7), mthlim(maxwave), mwaves, mcapa
-       double precision cfl,cflmax,cflv1
+       double precision cfl,cflmax,cflv1,cfl_level
 c
 c      ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 c      ::::  for i/o assignments
@@ -163,4 +167,7 @@ module amr_module
      &         uprint      !  updating/upbnding reporting
 
 
+c      variables for conservation checking:
+       double precision tstart,tmass0
+
        end module amr_module

src/2d/bufnst.f

@@ -1,8 +1,7 @@
 c
 c -------------------------------------------------------------
 c
-      subroutine bufnst (nvar,naux,numbad,lcheck,iflags,isize,jsize,
-     &                   ldom3)
+      subroutine bufnst (nvar,naux,numbad,lcheck,iflags,isize,jsize)
 c
       use amr_module
       implicit double precision (a-h,o-z)
@@ -76,23 +75,7 @@ subroutine bufnst (nvar,naux,numbad,lcheck,iflags,isize,jsize,
 c    # first get scratch work space (not that other scratch
 c    # arrays above have been reclaimed. 
 c
-c ## scratch  storage now passed in due to dynamic memory resizing
-c ## need all arrays to be indexed into alloc if memory moved it, 
-c ## but iflags is index above
-c      ibytesPerDP = 8
-c      ldom3 = igetsp((isize+2)*(jsize+2)/ibytesPerDP+1)
-c
-      call shiftset(iflags, alloc(ldom3),isize,jsize)
-
-c     do 55 inum = 1, ibuff
-
-c          call shiftset(iflags,alloc(ldom3),+1,0,isize,jsize)
-c          call shiftset(iflags,alloc(ldom3),-1,0,isize,jsize)
-c          call shiftset(iflags,alloc(ldom3),0,+1,isize,jsize)
-c          call shiftset(iflags,alloc(ldom3),0,-1,isize,jsize)
-c          call shiftset(iflags, alloc(ldom3),isize,jsize)
-
-c55   continue
+      call shiftset(iflags, isize,jsize)
 
       if (eprint) then
          write(outunit,*)" flagged points after buffering on level", 
@@ -113,7 +96,6 @@ subroutine bufnst (nvar,naux,numbad,lcheck,iflags,isize,jsize,
        write(outunit,116) numbad, lcheck
  116   format(i5,' points flagged on level ',i4)
 
-c      call reclam(ldom3,(isize+2)*(jsize+2)/ibytesPerDP+1)
 
       return
       end

src/2d/flglvl.f

@@ -1,11 +1,13 @@
 c
 c -----------------------------------------------------------
 c
-      subroutine flglvl(nvar,naux,lcheck,nxypts,index,lbase,ldom2,
-     .                  npts,t0)
+      subroutine flglvl(nvar,naux,lcheck,nxypts,index,lbase,i1flags,
+     .                  npts,t0,isize,jsize)
 c
       use amr_module
       implicit double precision (a-h,o-z)
+      integer*1 i1flags(isize+2,jsize+2)
+      integer*1 dom1flags(isize+2,jsize+2)
 
 
 c
@@ -34,45 +36,32 @@ subroutine flglvl(nvar,naux,lcheck,nxypts,index,lbase,ldom2,
 c
       isize = iregsz(lcheck)
       jsize = jregsz(lcheck)
-      ibytesPerDP = 8
-      ldom  = igetsp((isize+2)*(jsize+2)/ibytesPerDP+1)
 c    
 c   prepare domain in ldom2 (so can use ldom as scratch array before 
 c   putting in the flags)
 c
       idim = iregsz(lbase)
       jdim = jregsz(lbase)
-      call domprep(alloc(ldom2),lbase,idim,jdim)
+      call domprep(i1flags,lbase,idim,jdim)
 
-      call domshrink(alloc(ldom2),alloc(ldom),idim,jdim)
+      call domshrink(i1flags,dom1flags,idim,jdim)
 
       do 6 lev = lbase+1, lcheck
-         call domup(alloc(ldom2),alloc(ldom),idim,jdim,
+         call domup(i1flags,dom1flags,idim,jdim,
      1              intratx(lev-1)*idim,intraty(lev-1)*jdim,lev-1)
          idim = intratx(lev-1)*idim
          jdim = intraty(lev-1)*jdim
-         call domshrink(alloc(ldom2),alloc(ldom),idim,jdim)
+         call domshrink(i1flags,dom1flags,idim,jdim)
  6    continue
 c     # finish by transferring from iflags to iflags2
-      call domcopy(alloc(ldom2),alloc(ldom),isize,jsize)
+      call domcopy(i1flags,dom1flags,isize,jsize)
 c
       numbad = 0
 c     always call spest to set up stuff (initialize iflags, fill locbig)
-c      call spest(nvar,naux,lcheck,alloc(ldom),isize,jsize,t0)
-c     ### modified to pass in ldom instead of alloc(ldom) - called iflags in spest -
-c     ###  since spest calls igetsp, if alloc is resized and moved, need relative
-c     ### indexing, or iflags would have invalid address on the inside
-      call spest(nvar,naux,lcheck,ldom,isize,jsize,t0)
+      call spest(nvar,naux,lcheck,dom1flags,isize,jsize,t0)
       if (tol .gt. 0.) call errest(nvar,naux,lcheck)
 
-      if (ibuff .gt. 0) then ! get scratch storage for bufnst
-         ibytesPerDP = 8
-         ldom3 = igetsp((isize+2)*(jsize+2)/ibytesPerDP+1)  ! incase need to resize
-      endif
-      call bufnst(nvar,naux,numbad,lcheck,alloc(ldom),isize,jsize,ldom3)
-      if (ibuff .gt. 0) then ! return scratch storage for bufnst
-         call reclam(ldom3,(isize+2)*(jsize+2)/ibytesPerDP+1)
-      endif
+      call bufnst(nvar,naux,numbad,lcheck,dom1flags,isize,jsize)
 
       nxypts = nxypts + numbad
 c
@@ -81,12 +70,10 @@ subroutine flglvl(nvar,naux,lcheck,nxypts,index,lbase,ldom2,
       if (nxypts .gt. 0) then
           index = igetsp(2*nxypts)
           call colate(alloc(index),nxypts,lcheck,
-     1                alloc(ldom),alloc(ldom2),isize,jsize,npts)
+     1                dom1flags,i1flags,isize,jsize,npts)
       else 
          npts = nxypts
       endif
 
-      call reclam(ldom,  (isize+2)*(jsize+2)/ibytesPerDP+1) 
-
       return
       end

src/2d/grdfit.f

@@ -11,6 +11,7 @@ subroutine grdfit (lbase,lcheck,nvar,naux,cut,time,t0)
       integer    numptc(maxcl), prvptr
       logical    fit, nestck, cout
       data       cout/.false./
+      integer*1  i1flags(iregsz(lcheck)+2,jregsz(lcheck)+2)
 c
 c ::::::::::::::::::::: GRDFIT :::::::::::::::::::::::::::::::::;
 c  grdfit called by setgrd and regrid to actually fit the new grids
@@ -20,8 +21,6 @@ subroutine grdfit (lbase,lcheck,nvar,naux,cut,time,t0)
 c
       isize = iregsz(lcheck)
       jsize = jregsz(lcheck)
-      ibytesPerDP = 8
-      ldom2 = igetsp((isize+2)*(jsize+2)/ibytesPerDP+1)
 
 c ### initialize region start and end indices for new level grids
       iregst(lcheck+1) = iinfinity
@@ -34,7 +33,8 @@ subroutine grdfit (lbase,lcheck,nvar,naux,cut,time,t0)
 c     ## flagged points turned off due to proper nesting requirement.
 c     ## (storage based on nptmax calculation however).
 
-      call flglvl (nvar,naux,lcheck,nptmax,index,lbase,ldom2,npts,t0)
+      call flglvl (nvar,naux,lcheck,nptmax,index,lbase,i1flags,npts,t0,
+     .             isize,jsize)
       if (npts .eq. 0) go to 99
 c
       levnew    = lcheck + 1
@@ -88,7 +88,7 @@ subroutine grdfit (lbase,lcheck,nvar,naux,cut,time,t0)
 c
 c 2/28/02 : Added naux to argument list; needed by call to outtre in nestck
       fit = nestck(mnew,lbase,alloc(index+2*ibase),numptc(icl),numptc,
-     1             icl,nclust,alloc(ldom2),isize,jsize,nvar, naux)
+     1             icl,nclust,i1flags,isize,jsize,nvar, naux)
       if (.not. fit) go to 75
 c
 c     ##  grid accepted. put in list.
@@ -120,7 +120,6 @@ subroutine grdfit (lbase,lcheck,nvar,naux,cut,time,t0)
 c    ## array space needs to be reclaimed
       if (nptmax .gt. 0) call reclam(index, 2*nptmax) 
 c
-      call reclam(ldom2, (isize+2)*(jsize+2)/ibytesPerDP+1)
 
       return
       end

src/2d/shiftset.f

@@ -1,15 +1,18 @@
 c
 c ----------------------------------------------------------
 c
-       subroutine shiftset(intarray,intarray2,isize,jsize)
+       subroutine shiftset(intarray,isize,jsize)
+c      subroutine shiftset(intarray,intarray2,isize,jsize)
 c       subroutine old_shiftset(intarray,intarray2,idir,jdir,isize,jsize)
 
       use amr_module
        implicit double precision (a-h, o-z)
 
 
        integer*1 intarray (0:isize+1,0:jsize+1), 
-     1           intarray2(0:isize+1,0:jsize+1)
+     1           intarray2_old(0:isize+1,0:jsize+1)
+
+       integer*1  intarray2(0:isize+1,0:jsize+1)
 
 c :::::::::::::::::::::: CSHIFT :::::::::::::::::::::::::::::::
 c shift by + or - 1 in either direction (but only 1 at a time)

src/2d/spest.f

@@ -1,7 +1,8 @@
 c
 c -------------------------------------------------------------
 c
-      subroutine spest (nvar,naux,lcheck,lociflags,isize,jsize,t0)
+      subroutine spest (nvar,naux,lcheck,dom1flags,isize,jsize,t0)
+c     subroutine spest (nvar,naux,lcheck,lociflags,isize,jsize,t0)
 c      subroutine spest (nvar,naux,lcheck,iflags,isize,jsize,t0)
 c
       use amr_module
@@ -23,7 +24,8 @@ subroutine spest (nvar,naux,lcheck,lociflags,isize,jsize,t0)
 !-- 4        iflags(i,j) = 0
 c
 c  now call initialization routine so can treat iflags as integer *1
-       call init_iflags(alloc(lociflags),isize,jsize)
+c      call init_iflags(alloc(lociflags),isize,jsize)
+       call init_iflags(dom1flags,isize,jsize)
 
        mptr = lstart(lcheck)
  5     continue
@@ -83,7 +85,9 @@ subroutine spest (nvar,naux,lcheck,lociflags,isize,jsize,t0)
 c
          idim3 = 1   ! 3rd dim = 1 here, elsewhere is nvar
 c         call setflags (iflags,isize,jsize,
-         call setflags (alloc(lociflags),isize,jsize,
+c        call setflags (alloc(lociflags),isize,jsize,
+c    1                  alloc(locamrflags),idim3,mitot,mjtot,mptr)
+         call setflags (dom1flags,isize,jsize,
      1                  alloc(locamrflags),idim3,mitot,mjtot,mptr)
          call reclam(locamrflags, mitot*mjtot)
       endif

tests/swirl/setrun.py

@@ -121,7 +121,7 @@ def setrun(claw_pkg='amrclaw'):
     # The current t, dt, and cfl will be printed every time step
     # at AMR levels <= verbosity.  Set verbosity = 0 for no printing.
     #   (E.g. verbosity == 2 means print only on levels 1 and 2.)
-    clawdata.verbosity = 1
+    clawdata.verbosity = 3
 
 
 
@@ -201,7 +201,7 @@ def setrun(claw_pkg='amrclaw'):
 
 
     # max number of refinement levels:
-    mxnest = 3
+    mxnest = 2
 
     clawdata.mxnest = -mxnest   # negative ==> anisotropic refinement in x,y,t
 
@@ -223,6 +223,9 @@ def setrun(claw_pkg='amrclaw'):
     clawdata.ibuff  = 3     # width of buffer zone around flagged points
 
     # More AMR parameters can be set -- see the defaults in pyclaw/data.py
+    #clawdata.rprint = True
+    #clawdata.eprint = True
+    #clawdata.edebug = True
 
     return rundata
     # end of function setrun