2D AMRCLAW
nestck2.f
Go to the documentation of this file.
1 c
34 c
35 c ---------------------------------------------------------
36 c
37  logical function nestck2(mnew,lbase,badpts,npts,numptc,icl,
38  1 nclust, nvar,naux)
39 c
40  use amr_module
41  implicit double precision (a-h,o-z)
42  dimension badpts(2,npts)
43  logical baseCheck, isNested1, isNested2
44  logical projecCheck
45 
46  integer numptc(maxcl), zeroBuff
47 c
48 c ::::::::::::::::::::::: NESTCK :::::::::::::::::::::::::::::::::::
49 
50 c nestck - check that the potential grid mnew is completely
51 c contained in the (coarser) finest grid which stays
52 c fixed, at level lbase. projec algo. will guarantee
53 c containment in all finer grids twixt them.
54 c if grid not contained in some coarse grid, then
55 c bisect in long direction.
56 c EVENTUALLY this has to work, since flagged pts were
57 c checked for proper nesting.
58 c
59 c input parameter:
60 c mnew - grid descriptor of potential grid
61 c lbase - level which stays fixed during regridding
62 c badpts - only the flagged pts. in this cluster (# icl)
63 c :::::::::::::::::::::::::::::::::;::::::::::::::::::::::::::::::::
64 c
65  nestck2 = .true.
66  levnew = node(nestlevel,mnew)
67  lratiox = intratx(levnew-1)
68  lratioy = intraty(levnew-1)
69 c
70 !--c # for CONVEX coarsest grid at level 1, nothing to check
71  if (lbase .eq. 1) then
72  isnested1 = .true.
73 
74 c POTENTIAL BUG FIX
75 c need to also check that new grid can be projected to level-2 grids so is
76 c properly nested. might be an accident of grid gen that makes it stick out
77 c for now check using same call for both purposes
78  else
79 
80  zerobuff = 0 ! dont count buffer zone around grid in checking
81  isnested1 = basecheck(mnew,lbase,node(ndilo,mnew),
82  . node(ndihi,mnew),node(ndjlo,mnew),
83  . node(ndjhi,mnew),nvar,naux,zerobuff)
84  endif
85 
86 c again using new second definition of proper nesting (must have existing grid to project to
87 c to insure new lev-2 grid generated containing levnew grids
88  levtocheck = levnew - 2
89  if (levtocheck .le. 1) then
90  isnested2 = .true. ! base grid convex, no L shaped domains
91  else if (levtocheck .le. lbase) then
92  isnested2 = isnested1
93  else
94  mbuff = max(nghost,ibuff+1) ! you can use buffer zone in checking, since is only to flag points
95  isnested2 = basecheck(mnew,levtocheck,node(ndilo,mnew),
96  . node(ndihi,mnew),node(ndjlo,mnew),
97  . node(ndjhi,mnew),nvar,naux,mbuff)
98 
99  endif
100 
101  if (isnested1 .and. isnested2) then
102  nestck2 = .true.
103  go to 99
104  endif
105 c
106 c ### use grid indices coarsened by 1 level in checking
107 c ### remember to offset by 1 since 1st grid cell is 0,0
108 
109 c ### grid not properly nested. bisect in long direction, and return
110 c ### two clusters instead of 1.
111 c
112  50 if (npts .gt. 1) go to 55
113  write(outunit,101) levnew
114  write(*,101) levnew
115  101 format(' nestck2: 1 pt. cluster at level ',i5,' still not',
116  1 ' nested',/,' pt. too close to boundary')
117  write(outunit,104) badpts(1,npts),badpts(2,npts)
118  write(*,104) badpts(1,npts),badpts(2,npts)
119  104 format(' non-nested flagged pt. at: ',2e15.7)
120  call outtre(mstart, .false.,nvar,naux)
121  call outmsh(mnew, .false.,nvar,naux)
122  stop
123 
124  55 if (nclust .lt. maxcl) go to 60
125  write(outunit,102) maxcl
126  write(*,102) maxcl
127  102 format(' too many clusters: > ',i5,' (from nestck2) ')
128  stop
129 
130  60 if (nprint) write(outunit,103) icl, npts
131  103 format(' bisecting cluster ',i5,' with ',i5,' pts. in nestck2')
132  if (rnode(cornxhi,mnew)-rnode(cornxlo,mnew) .gt.
133  1 rnode(cornyhi,mnew) - rnode(cornylo,mnew)) then
134  rmid = (rnode(cornxhi,mnew) + rnode(cornxlo,mnew) ) / 2.
135  rmid = (node(ndihi,mnew) + node(ndilo,mnew) + 1 ) / 2.
136  rmid = rmid / lratiox
137  idir = 1
138  else
139  rmid = (rnode(cornyhi,mnew) + rnode(cornylo,mnew) ) / 2.
140  rmid = (node(ndjhi,mnew) + node(ndjlo,mnew) + 1) / 2.
141  rmid = rmid / lratioy
142  idir = 2
143  endif
144 c
145  ipt = 1
146  ntop = npts
147 
148  90 if (badpts(idir,ipt) .lt. rmid) go to 100
149 c
150 c ### swap with a point in top half not yet tested. keep smaller
151 c ### half of rect. in bottom half
152 c
153  temp = badpts(1,ipt)
154  badpts(1,ipt) = badpts(1,ntop)
155  badpts(1,ntop) = temp
156  temp = badpts(2,ipt)
157  badpts(2,ipt) = badpts(2,ntop)
158  badpts(2,ntop) = temp
159  ntop = ntop - 1
160  if (ipt .le. ntop) go to 90
161  go to 110
162  100 ipt = ipt +1
163  if (ipt .le. ntop) go to 90
164 c
165 c ### ntop points to top of 1st cluster (= no. of points in 1st cluster)
166 c
167  110 numptc(icl) = npts - ntop
168  do 120 i = icl, nclust
169  nmove = nclust + icl - i
170  120 numptc(nmove+1) = numptc(nmove)
171  numptc(icl) = ntop
172  nclust = nclust + 1
173  nestck2 = .false.
174 c
175  99 return
176  end
integer, parameter cornxlo
x-coordinate of the left border of this grid
Definition: amr_module.f90:143
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, parameter nestlevel
AMR level of the grid.
Definition: amr_module.f90:44
real(kind=8), dimension(rsize, maxgr) rnode
Definition: amr_module.f90:193
integer, parameter maxcl
maximum number of clusters (grids) on each grid level
Definition: amr_module.f90:177
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 ibuff
Definition: amr_module.f90:198
logical function nestck2(mnew, lbase, badpts, npts, numptc, icl, nclust, nvar, naux)
Check that the potential grid mnew is completely contained in the (coarser) finest grid which stays f...
Definition: nestck2.f:39
integer, dimension(maxlv) intraty
Definition: amr_module.f90:198
logical nprint
Definition: amr_module.f90:297
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
integer, dimension(maxlv) intratx
Definition: amr_module.f90:198
subroutine outtre(mlev, outgrd, nvar, naux)
Output a subtree of the grids.
Definition: outtre.f:11
integer, parameter cornxhi
x-coordinate of the right border of this grid
Definition: amr_module.f90:147
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
integer mstart
Definition: amr_module.f90:198
subroutine outmsh(mptr, outgrd, nvar, naux)
Output the grid descriptor of grid mptr and optionally the values on the grid (for a single grid - se...
Definition: outmsh.f:12
integer, parameter cornyhi
y-coordinate of the upper border of this grid
Definition: amr_module.f90:149