2D AMRCLAW
flagger.f
Go to the documentation of this file.
1 c ::::::::::::::::::::: FLAGGER :::::::::::::::::::::::::
2 c
3 c flagger = set up for and call two routines that flag using
4 c (a) spatial gradients, or other user-specified criteria
5 c (b) richardson error estimates
6 c
7 c the two approaches share an array with boundary ghost values
8 c
9 c ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10 ! Below are comments for Doxygen
28 c
29 c -----------------------------------------------------------
30 c
31  subroutine flagger(nvar,naux,lcheck,start_time)
32 
33  use amr_module
34  implicit double precision (a-h,o-z)
35 
36  integer omp_get_thread_num, omp_get_max_threads
37  integer mythread/0/, maxthreads/1/
38  integer listgrids(numgrids(lcheck)), locuse
39 
40 c call prepgrids(listgrids,numgrids(lcheck),lcheck)
41  mbuff = max(nghost,ibuff+1)
42 c before parallel loop give grids the extra storage they need for error estimation
43  do jg = 1, numgrids(lcheck)
44 c mptr = listgrids(jg)
45  levst = liststart(lcheck)
46  mptr = listofgrids(levst+jg-1)
47  nx = node(ndihi,mptr) - node(ndilo,mptr) + 1
48  ny = node(ndjhi,mptr) - node(ndjlo,mptr) + 1
49  mitot = nx + 2*nghost
50  mjtot = ny + 2*nghost
51  if (flag_richardson) then
52  locbig = igetsp(mitot*mjtot*nvar)
53  node(tempptr,mptr) = locbig
54  else
55  locbig = 0
56  endif
57  mibuff = nx + 2*mbuff ! NOTE THIS NEW DIMENSIONING
58  mjbuff = ny + 2*mbuff ! TO ALLOW ROOM FOR BUFFERING IN PLACE
59  locamrflags = igetsp(mibuff*mjbuff)
60  node(storeflags,mptr) = locamrflags
61  end do
62 
63 !$OMP PARALLEL DO PRIVATE(jg,mptr,nx,ny,mitot,mjtot,locnew,locaux),
64 !$OMP& PRIVATE(time,dx,dy,xleft,ybot,xlow,ylow,locbig),
65 !$OMP& PRIVATE(locold,mbuff,mibuff,mjbuff,locamrflags,i),
66 !$OMP& PRIVATE(locuse),
67 !$OMP& SHARED(numgrids,listgrids,lcheck,nghost,nvar,naux),
68 !$OMP& SHARED(levSt,listStart,listOfGrids),
69 !$OMP& SHARED(tolsp,alloc,node,rnode,hxposs,hyposs,ibuff),
70 !$OMP& SHARED(start_time,possk,flag_gradient,flag_richardson)
71 !$OMP& DEFAULT(none),
72 !$OMP& SCHEDULE(DYNAMIC,1)
73  do jg = 1, numgrids(lcheck)
74 c mptr = listgrids(jg)
75  levst = liststart(lcheck)
76  mptr = listofgrids(levst+jg-1)
77  nx = node(ndihi,mptr) - node(ndilo,mptr) + 1
78  ny = node(ndjhi,mptr) - node(ndjlo,mptr) + 1
79  mitot = nx + 2*nghost
80  mjtot = ny + 2*nghost
81  locnew = node(store1,mptr)
82  locaux = node(storeaux,mptr)
83  time = rnode(timemult,mptr)
84  dx = hxposs(lcheck)
85  dy = hyposs(lcheck)
86  xleft = rnode(cornxlo,mptr)
87  ybot = rnode(cornylo,mptr)
88  xlow = xleft - nghost*dx
89  ylow = ybot - nghost*dy
90 c
91  locbig = node(tempptr,mptr)
92 c # straight copy into scratch array so don't mess up latest soln.
93 
94 c ## at later times want to use newest soln for spatial error flagging
95 c ## at initial time want to use initial conditions (so retain symmetry for example)
96  if (start_time+possk(lcheck) .ne. time) then !exact equality test-relying on ieee arith repeatability
97 c do in other order in case user messes up locbig in flag2refine, already have
98 c them in locnew
99  call bound(time,nvar,nghost,alloc(locnew),mitot,mjtot,mptr,
100  1 alloc(locaux),naux)
101  locuse = locnew ! flag based on newest vals
102  if (flag_richardson) then
103  do 10 i = 1, mitot*mjtot*nvar
104  10 alloc(locbig+i-1) = alloc(locnew+i-1)
105  endif
106 
107  else ! boundary values already in locold
108  locold = node(store2,mptr)
109  locuse = locold ! flag based on old vals at initial time
110  ! put back this way to agree with nosetests
111  if (flag_richardson) then
112  do 11 i = 1, mitot*mjtot*nvar
113  11 alloc(locbig+i-1) = alloc(locold+i-1)
114  endif
115  endif
116 
117 ! # need at least as big as nghost to fit ghost cells. if ibuff is bigger make
118 ! # the flagged array bigger so can buffer in place
119  mbuff = max(nghost,ibuff+1)
120  mibuff = nx + 2*mbuff ! NOTE THIS NEW DIMENSIONING
121  mjbuff = ny + 2*mbuff ! TO ALLOW ROOM FOR BUFFERING IN PLACE
122 
123 ! ## locamrflags used for flag storage. flag2refine flags directly into it.
124 ! ## richardson flags added to it. Then colate finished the job
125  locamrflags = node(storeflags,mptr)
126  do 20 i = 1, mibuff*mjbuff ! initialize
127  20 alloc(locamrflags+i-1) = goodpt
128 
129  if (flag_gradient) then
130 
131 c # call user-supplied routine to flag any points where
132 c # refinement is desired based on user's criterion.
133 c # Default version compares spatial gradient to tolsp.
134 
135 c no longer getting locbig, using "real" solution array in locnew
136  call flag2refine2(nx,ny,nghost,mbuff,nvar,naux,
137  & xleft,ybot,dx,dy,time,lcheck,
138  & tolsp,alloc(locuse),
139  & alloc(locaux),alloc(locamrflags),
140  & goodpt,badpt)
141  endif
142 c
143  if (flag_richardson) then
144  call errest(nvar,naux,lcheck,mptr,nx,ny)
145  endif
146 
147  end do
148 ! $OMP END PARALLEL DO
149 
150  return
151  end
subroutine errest(nvar, naux, lcheck, mptr, nx, ny)
Definition: errest.f:5
integer, parameter timemult
current simulation time on this grid
Definition: amr_module.f90:151
integer, parameter cornxlo
x-coordinate of the left border of this grid
Definition: amr_module.f90:143
function igetsp(nwords)
Allocate contiguous space of length nword in main storage array alloc.
Definition: igetsp.f:9
integer, parameter tempptr
temporary pointer
Definition: amr_module.f90:38
real(kind=8), dimension(maxlv) hyposs
Definition: amr_module.f90:193
real(kind=8), dimension(maxlv) hxposs
Definition: amr_module.f90:193
integer, parameter ndihi
global i index of right border of this grid
Definition: amr_module.f90:111
integer, dimension(nsize, maxgr) node
Definition: amr_module.f90:198
integer, dimension(0:maxlv+1) liststart
Definition: amr_module.f90:189
real(kind=8), parameter goodpt
Definition: amr_module.f90:163
integer, dimension(maxlv) numgrids
Definition: amr_module.f90:198
real(kind=8), dimension(rsize, maxgr) rnode
Definition: amr_module.f90:193
integer, dimension(maxgr) listofgrids
Definition: amr_module.f90:189
logical flag_richardson
Definition: amr_module.f90:258
real(kind=8) tolsp
Definition: amr_module.f90:197
integer, parameter storeflags
pointer to the address of memory storing flags for refinement on this grid
Definition: amr_module.f90:123
integer, parameter ndilo
global i index of left border of this grid
Definition: amr_module.f90:108
integer, parameter ndjlo
global j index of lower border of this grid
Definition: amr_module.f90:114
integer, parameter store1
pointer to the address of memory storing the first copy of solution data on this grid, usually for storing new solution
Definition: amr_module.f90:101
integer ibuff
Definition: amr_module.f90:198
integer, parameter store2
pointer to the address of memory storing the second copy of solution data on this grid...
Definition: amr_module.f90:105
logical flag_gradient
Definition: amr_module.f90:258
subroutine flag2refine2(mx, my, mbc, mbuff, meqn, maux, xlower, ylower, dx, dy, t, level, tolsp, q, aux, amrflags, DONTFLAG, DOFLAG)
User routine to control flagging of points for refinement.
real(kind=8), parameter badpt
Definition: amr_module.f90:165
real(kind=8), dimension(maxlv) possk
Definition: amr_module.f90:193
integer, parameter ndjhi
global j index of upper border of this grid
Definition: amr_module.f90:117
subroutine bound(time, nvar, ng, valbig, mitot, mjtot, mptr, aux, naux)
This routine sets the boundary values for a given grid at level level.
Definition: bound.f90:52
integer, parameter cornylo
y-coordinate of the lower border of this grid
Definition: amr_module.f90:145
integer nghost
Definition: amr_module.f90:232
The module contains the definition of a "node descriptor" as well as other global variables used duri...
Definition: amr_module.f90:21
subroutine flagger(nvar, naux, lcheck, start_time)
Set up for and call two routines that flag using (a) spatial gradients, or other user-specified crite...
Definition: flagger.f:32
integer, parameter storeaux
pointer to the address of memory storing auxiliary data on this grid
Definition: amr_module.f90:120
real(kind=8), dimension(:), allocatable alloc
Definition: amr_module.f90:218