Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge pull request #4 from rjleveque/test-mjb-fixingFlagArray

Fixed amr_module.f and removed integer*1 arrays from the module.
  • Loading branch information...
commit 7a7a68dc215c5520023fa7b1814c8ae233a4aaee 2 parents 64338d2 + bbda8c6
@rjleveque rjleveque authored
View
21 src/2d/amr_module.f
@@ -1,6 +1,9 @@
module amr_module
-
+ implicit double precision(a-h,o-z)
+
+ save
+
c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
c ::::: data structure info.
c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
@@ -8,7 +11,7 @@ module amr_module
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
View
22 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
View
37 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
View
9 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
View
7 src/2d/shiftset.f
@@ -1,7 +1,8 @@
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
@@ -9,7 +10,9 @@ subroutine shiftset(intarray,intarray2,isize,jsize)
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)
View
10 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
View
7 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
Please sign in to comment.
Something went wrong with that request. Please try again.