2D AMRCLAW
Functions/Subroutines
bufnst2.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine bufnst2 (nvar, naux, numbad, lcheck, lbase)
 After error estimation, need to tag the cell for refinement, buffer the tags, take care of level nesting, etc. More...
 

Function/Subroutine Documentation

◆ bufnst2()

subroutine bufnst2 (   nvar,
  naux,
  numbad,
  lcheck,
  lbase 
)

After error estimation, need to tag the cell for refinement, buffer the tags, take care of level nesting, etc.

Parameters
[in]nvarnumber of equations for the system
[in]nauxnumber of auxiliary variables
[out]numbadnumber of flagged cells on level lcheck
[in]lbasebase AMR level for current refinement, which stays fixed. Note that lbase is always less or equal to lcheck
[in]lcheckAMR level of grid mptr

Definition at line 16 of file bufnst2.f.

References amr_module::alloc, amr_module::badpt, amr_module::cornxlo, amr_module::cornylo, amr_module::domflags2, amr_module::domflags_base, amr_module::eprint, amr_module::flag_richardson, flagregions2(), amr_module::goodpt, amr_module::hxposs, amr_module::hyposs, iadd(), amr_module::ibuff, igetsp(), amr_module::listofgrids, amr_module::liststart, amr_module::lstart, amr_module::mxnest, amr_module::ndihi, amr_module::ndilo, amr_module::ndjhi, amr_module::ndjlo, amr_module::nghost, amr_module::node, amr_module::numflags, amr_module::numgrids, amr_module::outunit, projec2(), reclam(), amr_module::rnode, setdomflags(), shiftset2(), amr_module::storeflags, amr_module::tempptr, amr_module::timemult, and amr_module::verbosity_regrid.

Referenced by flglvl2().

16 c
17  use amr_module
18  implicit double precision (a-h,o-z)
19 
20 
21  logical vtime
22  integer listgrids(numgrids(lcheck))
23  integer omp_get_thread_num, omp_get_max_threads
24  integer mythread/0/, maxthreads/1/
25  data vtime/.false./
26 
27 c this indexing is for amrflags array, in flag2refine from 1-mbuff:mx+mbuff
28 c but here is from 1:mibuff
29  iadd(i,j) = locamrflags + i-1+ mibuff*(j-1)
30 c
31 
32 c
33 c
34 c
35 !$ maxthreads = omp_get_max_threads()
36 c call prepgrids(listgrids,numgrids(lcheck),lcheck)
37 
38  numpro = 0
39  numbad = 0
40  time = rnode(timemult,lstart(lcheck))
41  dx = hxposs(lcheck)
42  dy = hyposs(lcheck)
43 
44 c mptr = lstart(lcheck)
45  levst = liststart(lcheck)
46 c41 continue
47 !$OMP PARALLEL DO REDUCTION(+:numbad)
48 !$OMP& PRIVATE(jg,mptr,ilo,ihi,jlo,jhi,nx,ny,mitot,mjtot),
49 !$OMP& PRIVATE(mibuff,mjbuff,locamrflags,mbuff,ibytesPerDP),
50 !$OMP& PRIVATE(loctmp,locbig,j,i,numpro2,numflagged),
51 !$OMP& PRIVATE(locdomflags,locdom2),
52 !$OMP& SHARED(numgrids, listgrids,nghost,flag_richardson),
53 !$OMP& SHARED(nvar,eprint,maxthreads,node,rnode,lbase,ibuff),
54 !$OMP& SHARED(alloc,lcheck,numpro,mxnest,dx,dy,time),
55 !$OMP& SHARED(levSt,listOfGrids),
56 !$OMP& DEFAULT(none),
57 !$OMP& SCHEDULE (DYNAMIC,1)
58  do jg = 1, numgrids(lcheck)
59 c mptr = listgrids(jg)
60  mptr = listofgrids(levst+jg-1)
61  ilo = node(ndilo,mptr)
62  ihi = node(ndihi,mptr)
63  jlo = node(ndjlo,mptr)
64  jhi = node(ndjhi,mptr)
65  nx = node(ndihi,mptr) - node(ndilo,mptr) + 1
66  ny = node(ndjhi,mptr) - node(ndjlo,mptr) + 1
67  mitot = nx + 2*nghost
68  mjtot = ny + 2*nghost
69  mbuff = max(nghost,ibuff+1)
70  mibuff = nx + 2*mbuff
71  mjbuff = ny + 2*mbuff
72  locamrflags = node(storeflags,mptr)
73 
74 c ### is richardson used, add those flags to flags computed by spatial gradients
75 c ### (or whatever user-defined criteria used). Even if nothing else used,
76 c ### put flags into locamrflag array.
77 !-- if (flag_richardson) then
78 !-- loctmp = node(store2, mptr)
79 !-- call addflags(alloc(locamrflags),mibuff,mjbuff,
80 !-- . alloc(loctmp),nvar,mitot,mjtot,mptr)
81 !-- endif
82 
83 c still need to reclaim error est space from spest.f
84 c which was saved for possible errest reuse
85  if (flag_richardson) then
86  locbig = node(tempptr,mptr)
87  call reclam(locbig,mitot*mjtot*nvar)
88  endif
89 c
90  if (eprint .and. maxthreads .eq. 1) then ! otherwise race for printing
91  write(outunit,*)" flagged points before projec2",
92  . lcheck," grid ",mptr, " (no buff cells)"
93  do j = mjbuff-mbuff, mbuff+1, -1
94  write(outunit,100)(int(alloc(iadd(i,j))),
95  & i=mbuff+1,mibuff-mbuff)
96  enddo
97  endif
98 
99 c ## new call to flag regions: check if cells must be refined, or exceed
100 c ## maximum refinement level for that region. used to be included with
101 c ## flag2refine. moved here to include flags from richardson too.
102  call flagregions2(nx,ny,mbuff,rnode(cornxlo,mptr),
103  1 rnode(cornylo,mptr),dx,dy,lcheck,time,
104  2 alloc(locamrflags),goodpt,badpt)
105 
106 c for this version project to each grid separately, no giant iflags
107  if (lcheck+2 .le. mxnest) then
108  numpro2 = 0
109  call projec2(lcheck,numpro2,alloc(locamrflags),
110  . ilo,ihi,jlo,jhi,mbuff)
111 c numpro = numpro + numpro2 not used for now. would need critical section for numpro
112  endif
113 
114  if (eprint .and. maxthreads .eq. 1) then
115  write(outunit,*)" flagged points before buffering on level",
116  . lcheck," grid ",mptr, " (no buff cells)"
117  do 47 j = mjbuff-mbuff, mbuff+1, -1
118  write(outunit,100)(int(alloc(iadd(i,j))),
119  & i=mbuff+1,mibuff-mbuff)
120  100 format(80i1)
121  47 continue
122  endif
123 c
124  if (eprint .and. maxthreads .eq. 1) then
125  write(outunit,*)" flagged points after projecting to level",
126  . lcheck, " grid ",mptr,
127  . "(withOUT buff cells)"
128 c . "(with buff cells)"
129 c buffer zone (wider ghost cell region) now set after buffering
130 c so loop over larger span of indices
131  do 49 j = mjbuff-mbuff, mbuff+1, -1
132  write(outunit,100)(int(alloc(iadd(i,j))),
133  . i=mbuff+1,mibuff-mbuff)
134  49 continue
135  endif
136 
137 c
138 c diffuse flagged points in all 4 directions to make buffer zones
139 c note that this code flags with a same value as true flagged
140 c points, not a different number.
141  call shiftset2(alloc(locamrflags),ilo,ihi,jlo,jhi,mbuff)
142 
143  if (eprint .and. maxthreads .eq. 1) then
144  write(outunit,*)" flagged points after buffering on level",
145  . lcheck," grid ",mptr," (WITHOUT buff cells))"
146  do 51 j = mjbuff-mbuff, mbuff+1, -1
147  write(outunit,100)(int(alloc(iadd(i,j))),
148  . i=mbuff+1, mibuff-mbuff)
149  51 continue
150  endif
151 c
152 c count up
153 c
154  numflagged = 0
155  do 82 j = 1, mjbuff
156  do 82 i = 1, mibuff
157  if (alloc(iadd(i,j)) .ne. goodpt) then
158  numflagged=numflagged + 1
159  endif
160  82 continue
161  ! TODO: this output statement is broken?
162 c write(outunit,116) numflagged, mptr
163  116 format(i5,' points flagged on level ',i4,' grid ',i4)
164  node(numflags,mptr) = numflagged
165 !$OMP CRITICAL(nb)
166  numbad = numbad + numflagged
167 !$OMP END CRITICAL(nb)
168 
169 c ADD WORK THAT USED TO BE IN FLGLVL2 FOR MORE PARALLEL WORK WITHOUT JOINING AND SPAWNING AGAIN
170 c in effect this is domgrid, but since variables already defined just need half of it, inserted here
171  ibytesperdp = 8
172 c bad names, for historical reasons. they are both smae size now
173  ! recall that igetsp(1) will allocate 8 bytes
174  locdomflags = igetsp( (mibuff*mjbuff)/ibytesperdp+1)
175  locdom2 = igetsp( (mibuff*mjbuff)/ibytesperdp+1)
176 
177  node(domflags_base,mptr) = locdomflags
178  node(domflags2,mptr) = locdom2
179  call setdomflags(mptr,alloc(locdomflags),ilo,ihi,jlo,jhi,
180  . mbuff,lbase,lcheck,mibuff,mjbuff)
181 
182 
183  end do
184 !$OMP END PARALLEL DO
185 c mptr = node(levelptr,mptr)
186 c if (mptr .ne. 0) go to 41
187 
188  if (verbosity_regrid .ge. lcheck) then
189  write(outunit,*)" total flagged points counted on level ",
190  . lcheck," is ",numbad
191  write(outunit,*)"this may include double counting buffer cells",
192  & " on multiple grids"
193  endif
194 
195  return
integer, parameter timemult
current simulation time on this grid
Definition: amr_module.f90:151
subroutine flagregions2(mx, my, mbuff, xlower, ylower, dx, dy, level, t, amrflags, DONTFLAG, DOFLAG)
Modify array of flagged points to respect minlevels and maxlevels specified by regions.
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
subroutine reclam(index, nwords)
Definition: reclam.f:5
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
subroutine shiftset2(rectflags, ilo, ihi, jlo, jhi, mbuff)
For an input grid, flag cells near the previously flagged cells for creating buffer zone...
Definition: shiftset2.f:26
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
integer pure function iadd(ivar, i, j)
Definition: intfil.f90:294
logical flag_richardson
Definition: amr_module.f90:258
integer, parameter domflags_base
domain flags, indexed within base level (lbase) index space
Definition: amr_module.f90:129
subroutine projec2(level, numpro, rectflags, ilo, ihi, jlo, jhi, mbuff)
This subroutine projects all level level+2 grids to a level level grid and flag the cells being proje...
Definition: projec2.f:52
logical eprint
Definition: amr_module.f90:297
integer, parameter storeflags
pointer to the address of memory storing flags for refinement on this grid
Definition: amr_module.f90:123
integer, parameter domflags2
domain flags, indexed within level-of-this-grid level index space
Definition: amr_module.f90:132
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, dimension(maxlv) lstart
Definition: amr_module.f90:198
integer ibuff
Definition: amr_module.f90:198
real(kind=8), parameter badpt
Definition: amr_module.f90:165
integer, parameter outunit
Definition: amr_module.f90:290
integer, parameter ndjhi
global j index of upper border of this grid
Definition: amr_module.f90:117
integer, parameter cornylo
y-coordinate of the lower border of this grid
Definition: amr_module.f90:145
subroutine setdomflags(mptr, igridflags, ilo, ihi, jlo, jhi, mbuff, lbase, lcheck, mibuff, mjbuff)
set domain flags (not AMR flags) for grid mptr (only), enlarged by buffer zone.
Definition: setdomflags.f:24
integer mxnest
Definition: amr_module.f90:198
integer nghost
Definition: amr_module.f90:232
integer verbosity_regrid
Definition: amr_module.f90:259
The module contains the definition of a "node descriptor" as well as other global variables used duri...
Definition: amr_module.f90:21
integer, parameter numflags
number of flagged cells on this grid
Definition: amr_module.f90:126
real(kind=8), dimension(:), allocatable alloc
Definition: amr_module.f90:218
Here is the call graph for this function:
Here is the caller graph for this function: