2D AMRCLAW
setuse.f
Go to the documentation of this file.
1 c
2 c ----------------------------------------------------------------
3 c
4  subroutine setuse(listbc,maxsp,ispot,mkid,
5  1 ilo, ihi, jlo, jhi,
6  2 iclo,ichi,jclo,jchi,kflag)
7 c
8 c :::::::::::::::::::::::: SETUSE ::::::::::::::::::::::::::::::::
9 c
10 c set up boundary list for coarse grid, to be used by fluxsv.
11 c loop around boundary of fine grids to do this. each entry has
12 c i, j, side #, fine grid #, loc in fine grid list for fluxes.
13 c for example, side 1 of fine grid fixes side 3 of coarse grid,
14 c so coarse grid list will store the # 3.
15 c wrt coarse grid, the sides are:
16 c 2
17 c 1 3 that is, right edge of a coarse cell = 3
18 c 4 top edge of a coarse cell = 2
19 c
20 c # lkid is the index into the fine grid's saved fluxes.
21 c # the fine grid will save all its fluxes all around its
22 c # perimeter. lkid tells where the coarse grid should
23 c # taking them from. (no ghost cells in this index, but
24 c # it is 1-based for indexing array, not - based for
25 c # integer index of grid location).
26 c
27 c changed 11/11/08: spheredom for periodically mapped spherical
28 c grids. could affect top and bottom if fine grid touches
29 c edge of domain in y direction. if calling with spheredom
30 c (and not yperdom) then grid is NOT periodically mapped.
31 c need kflag to indicate spherically mapped now - otherwise
32 c cant tell the difference, dont skip appropropriate loops
33 c
34 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;
35 c
36  use amr_module
37  implicit double precision (a-h,o-z)
38  dimension listbc(5,maxsp)
39 
40 
41  ibc = ispot
42  ist = iclo - 1
43  iend = ichi + 1
44  jst = jclo - 1
45  jend = jchi + 1
46 c
47 c left side (of fine grid, right side of coarse cell)
48 c
49  if (ist .lt. ilo .or. kflag .ne. 1) go to 20
50  lkid = max(jlo,jclo) - jclo + 1
51  do 10 j = max(jlo,jclo), min(jhi,jchi)
52  ispot = ispot + 1
53  listbc(1,ispot) = ist-ilo+nghost+1
54  listbc(2,ispot) = j-jlo+nghost+1
55  listbc(3,ispot) = 3
56  listbc(4,ispot) = mkid
57  listbc(5,ispot) = lkid
58  lkid = lkid + 1
59  10 continue
60 c
61 c top side (of fine grid, bottom of coarse cell)
62 c
63  20 if (kflag .eq. 1) then ! regular interior case
64  if (jend .gt. jhi) go to 40
65  lkid = (jchi-jclo+1) + max(ilo,iclo)-iclo + 1
66  do 30 i = max(ilo,iclo), min(ihi,ichi)
67  ispot = ispot + 1
68  listbc(1,ispot) = i-ilo+nghost+1
69  listbc(2,ispot) = jend-jlo+nghost+1
70  listbc(3,ispot) = 4
71  listbc(4,ispot) = mkid
72  listbc(5,ispot) = lkid
73 c write(outunit,595)ispot,(listbc(ipl,ispot),ipl=1,5)
74  595 format(" entry ",i5," has ", 5i5)
75  lkid = lkid + 1
76  30 continue
77  else if (kflag .eq. 2) then !spherical
78 c top side of a fine grid is also top side of a coarse cell due to mapping
79 c write(outunit,*)":fixing top cells with fine grid ",mkid
80 c original code was insanely complicated. look at all indices and decide.
81  level = node(nestlevel,mkid) - 1
82  lkid = (jchi-jclo+1)+ 1 ! starts here wrt fine grid. may not use on coarse grid
83  do 31 i = iclo, ichi
84  iwrap = iregsz(level) - i -1
85  if (iwrap .ge. ilo .and. iwrap .le. ihi) then
86  ispot = ispot + 1
87  listbc(1,ispot) = iwrap - ilo + nghost + 1
88  listbc(2,ispot) = jend - jlo + nghost ! note adjustment of j (one less)
89  listbc(3,ispot) = 5 ! affects TOP of mapped coarse cell in diff. way
90  listbc(4,ispot) = mkid
91  listbc(5,ispot) = lkid
92 c write(outunit,595)ispot,(listbc(ipl,ispot),ipl=1,5)
93  endif
94  lkid = lkid + 1 ! increment fine list loc even if not used
95  31 continue
96 
97  endif
98 c
99 c right side (of fine grid, left of coarse cell)
100 c (numbered from bottom to top, so not continuous in lkid numbering)
101 c
102  40 if (iend .gt. ihi .or. kflag .ne. 1) go to 60
103  lkid = (ichi-iclo+1)+(jchi-jclo+1)
104  . + max(jlo,jclo) - jclo + 1
105  do 50 j = max(jlo,jclo), min(jhi,jchi)
106  ispot = ispot + 1
107  listbc(1,ispot) = iend-ilo+nghost+1
108  listbc(2,ispot) = j-jlo+nghost+1
109  listbc(3,ispot) = 1
110  listbc(4,ispot) = mkid
111  listbc(5,ispot) = lkid
112  lkid = lkid + 1
113  50 continue
114 c
115 c bottom side (of fine grid, top of coarse cell, unless spheredom)
116 c (numbered left to right, so not continuous in lkid numbering)
117 c
118  60 if (kflag .eq. 1) then
119  if (jst .lt. jlo) go to 80
120  lkid = 2*(jchi-jclo+1)+(ichi-iclo+1) + max(ilo,iclo)-iclo + 1
121  do 70 i = max(ilo,iclo), min(ihi,ichi)
122  ispot = ispot + 1
123  listbc(1,ispot) = i-ilo+nghost+1
124  listbc(2,ispot) = jst-jlo+nghost+1
125  listbc(3,ispot) = 2
126  listbc(4,ispot) = mkid
127  listbc(5,ispot) = lkid
128  lkid = lkid + 1
129  70 continue
130  else ! spherical
131 c bottom side of fine grid affects bottom of coarse cell
132 c fine grids saves fluxes in usual way
133 c coarse grid only needs to change where to use them
134  if (kflag .ne. 3) go to 80
135 c write(outunit,*)":fixing bottom cells with fine grid ",mkid
136  level = node(nestlevel,mkid)-1
137  lkid = 2*(jchi-jclo+1) + (ichi-iclo+1) + 1
138  do 71 i = iclo, ichi
139  iwrap = iregsz(level) - i - 1
140  if (iwrap .ge. ilo .and. iwrap .le. ihi) then
141  ispot = ispot + 1
142  listbc(1,ispot) = iwrap - ilo + nghost + 1
143  listbc(2,ispot) = nghost+1 ! grid bottom is at zero index
144  listbc(3,ispot) = 6 ! affects BOTTOM of mapped coarse cell in diff. way
145  listbc(4,ispot) = mkid
146  listbc(5,ispot) = lkid
147 c write(outunit,595)ispot,(listbc(ipl,ispot),ipl=1,5)
148  endif
149  lkid = lkid + 1
150  71 continue
151 
152  endif
153 c
154  80 continue
155  return
156  end
amr_module
Definition: amr_module.f90:1
setuse
subroutine setuse(listbc, maxsp, ispot, mkid, ilo, ihi, jlo, jhi, iclo, ichi, jclo, jchi, kflag)
Definition: setuse.f:4
Generated on Thu Mar 9 2017 15:15:52 for 2D AMRCLAW by   doxygen 1.8.6