2D AMRCLAW
flglvl2.f
Go to the documentation of this file.
1 c :::::::::::::::::::: FLGLVL :::::::::::::::::::::::::::::::::
2 c
17 ! TODO: what's this start_time above
18 c
19 c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
20 c
21 c -----------------------------------------------------------
22 c
23  subroutine flglvl2(nvar,naux,lcheck,nxypts,index,lbase,npts,
24  & start_time)
25 c
26  use amr_module
27  implicit double precision (a-h,o-z)
28  integer clock_start, clock_finish, clock_rate
29 c
30 c
31 c
32  nxypts = 0
33  numbad = 0
34 
35 
36 c flag arrays- based on either spatial gradients (and/or user defined
37 c criteria), or Richardson error estimation
38 
39  call system_clock(clock_start,clock_rate)
40  call flagger(nvar,naux,lcheck,start_time)
41  call system_clock(clock_finish,clock_rate)
42  timeflagger = timeflagger + clock_finish - clock_start
43 
44 
45 c buffer the flagged cells (done for each grid patch of flags)
46 c also project flags from finer levels onto this level to ensure
47 c proper nesting. Finally compute proper domain for each patch
48  call system_clock(clock_start,clock_rate)
49  call bufnst2(nvar,naux,numbad,lcheck,lbase)
50  call system_clock(clock_finish,clock_rate)
51  timebufnst = timebufnst + clock_finish - clock_start
52 
53  nxypts = nxypts + numbad
54 c
55 c colate flagged pts into flagged points array
56 c new version needs to check for proper nesting at this point
57 c also needs to sort, so can remove duplicates.
58 c
59  if (nxypts .gt. 0) then
60 c build domain flags for each grid at level lcheck, instead of
61 c previous approach using domain flags over entire domain
62 c call domgrid(lbase,lcheck) ! will need since there are flagged pts NOW IN BUFNST2
63 c
64 c in new version, there are bad cells but nxypts isnt true count any longer
65 c since there are duplicates, and proper nesting not yet checked
66  index = igetsp(2*nxypts)
67  call colate2(alloc(index),nxypts,lcheck,npts,lbase)
68  else
69  npts = 0 !npts is number of unique flagged points after removing duplicates
70  call freeflags(lcheck) ! otherwise storage freed in colate2. perhaps always do it here
71  endif
72 
73  return
74  end
75 c
76 c ---------------------------------------------------------------------------------
77 c
78  subroutine freeflags(lcheck)
79 
80  use amr_module
81  implicit double precision (a-h, o-z)
82 
83  mptr = lstart(lcheck)
84  10 continue
85  locamrflags = node(storeflags,mptr)
86  locdomflags = node(domflags_base,mptr)
87  locdom2 = node(domflags2,mptr)
88 
89  nx = node(ndihi,mptr) - node(ndilo,mptr) + 1
90  ny = node(ndjhi,mptr) - node(ndjlo,mptr) + 1
91  mbuff = max(nghost,ibuff+1)
92  mibuff = nx + 2*mbuff
93  mjbuff = ny + 2*mbuff
94 
95  ibytesperdp = 8
96  nwords = (mibuff*mjbuff)/ibytesperdp+1
97  call reclam(locdomflags, nwords)
98  call reclam(locdom2, nwords)
99  call reclam(locamrflags,mibuff*mjbuff)
100 
101  mptr = node(levelptr, mptr)
102  if (mptr .ne. 0) go to 10
103 
104  return
105  end
function igetsp(nwords)
Definition: igetsp.f:4
subroutine colate2(badpts, len, lcheck, nUniquePts, lbase)
Definition: colate2.f:4
subroutine freeflags(lcheck)
Definition: flglvl2.f:78
subroutine flglvl2(nvar, naux, lcheck, nxypts, index, lbase, npts, start_time)
Controls the error estimation/flagging bad pts.
Definition: flglvl2.f:23
subroutine reclam(index, nwords)
Definition: reclam.f:4
subroutine bufnst2(nvar, naux, numbad, lcheck, lbase)
After error estimation, need to tag the cell for refinement, buffer the tags, take care of level nest...
Definition: bufnst2.f:8
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