2D AMRCLAW
update.f
Go to the documentation of this file.
1 c
2 c -----------------------------------------------------------
3 c
4  subroutine update (level, nvar, naux)
5 c
6  use amr_module
7  implicit double precision (a-h,o-z)
8 
9 
10  integer listgrids(numgrids(level))
11 
12 c$$$ OLD INDEXING
13 c$$$ iadd(i,j,ivar) = loc + i - 1 + mitot*((ivar-1)*mjtot+j-1)
14 c$$$ iaddf(i,j,ivar) = locf + i - 1 + mi*((ivar-1)*mj +j-1)
15 c$$$ iaddfaux(i,j) = locfaux + i - 1 + mi*((mcapa-1)*mj + (j-1))
16 c$$$ iaddcaux(i,j) = loccaux + i - 1 + mitot*((mcapa-1)*mjtot+(j-1))
17 
18 c NEW INDEXING, ORDER SWITCHED
19  iadd(ivar,i,j) = loc + ivar-1 + nvar*((j-1)*mitot+i-1)
20  iaddf(ivar,i,j) = locf + ivar-1 + nvar*((j-1)*mi+i-1)
21  iaddfaux(i,j) = locfaux + mcapa-1 + naux*((j-1)*mi + (i-1))
22  iaddcaux(i,j) = loccaux + mcapa-1 + naux*((j-1)*mitot+(i-1))
23 c
24 c
25 c :::::::::::::::::::::::::: UPDATE :::::::::::::::::::::::::::::::::
26 c update - update all grids at level 'level'.
27 c this routine assumes cell centered variables.
28 c the update is done from 1 level finer meshes under it.
29 c input parameter:
30 c level - ptr to the only level to be updated. levels coarser than
31 c this will be at a diffeent time.
32 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
33 c
34  lget = level
35  if (uprint) write(outunit,100) lget
36 100 format(19h updating level ,i5)
37 c need to set up data structure for parallel distrib of grids
38 c call prepgrids(listgrids,numgrids(level),level)
39 
40 c
41 c grid loop for each level
42 c
43  dt = possk(lget)
44 
45 c mptr = lstart(lget)
46 c 20 if (mptr .eq. 0) go to 85
47 
48 
49 !$OMP PARALLEL DO PRIVATE(ng,mptr,loc,loccaux,nx,ny,mitot,mjtot,
50 !$OMP& ilo,jlo,ihi,jhi,mkid,iclo,jclo,
51 !$OMP& ichi,jchi,mi,mj,locf,locfaux,
52 !$OMP& iplo,jplo,iphi,jphi,iff,jff,totrat,i,j,
53 !$OMP& ivar,ico,jco,capa,levSt),
54 !$OMP& SHARED(lget,numgrids,listgrids,listsp,alloc,nvar,naux,
55 !$OMP& intratx,intraty,nghost,uprint,mcapa,node,
56 !$OMP& listOfGrids,listStart,lstart,level),
57 !$OMP& DEFAULT(none)
58 
59  do ng = 1, numgrids(lget)
60  !mptr = listgrids(ng)
61  levst = liststart(lget)
62  mptr = listofgrids(levst + ng - 1)
63  loc = node(store1,mptr)
64  loccaux = node(storeaux,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  ilo = node(ndilo,mptr)
70  jlo = node(ndjlo,mptr)
71  ihi = node(ndihi,mptr)
72  jhi = node(ndjhi,mptr)
73 c
74  if (node(cfluxptr,mptr) .eq. 0) go to 25
75 c locuse = igetsp(mitot*mjtot)
76  call upbnd(alloc(node(cfluxptr,mptr)),alloc(loc),nvar,
77  1 naux,mitot,mjtot,listsp(lget),mptr)
78 c 1 mitot,mjtot,listsp(lget),alloc(locuse),mptr)
79 c call reclam(locuse,mitot*mjtot)
80 c
81 c loop through all intersecting fine grids as source updaters.
82 c
83  25 mkid = lstart(lget+1)
84  30 if (mkid .eq. 0) go to 80
85  iclo = node(ndilo,mkid)/intratx(lget)
86  jclo = node(ndjlo,mkid)/intraty(lget)
87  ichi = node(ndihi,mkid)/intratx(lget)
88  jchi = node(ndjhi,mkid)/intraty(lget)
89 
90  mi = node(ndihi,mkid)-node(ndilo,mkid) + 1 + 2*nghost
91  mj = node(ndjhi,mkid)-node(ndjlo,mkid) + 1 + 2*nghost
92  locf = node(store1,mkid)
93  locfaux = node(storeaux,mkid)
94 c
95 c calculate starting and ending indices for coarse grid update, if overlap
96 c
97  iplo = max(ilo,iclo)
98  jplo = max(jlo,jclo)
99  iphi = min(ihi,ichi)
100  jphi = min(jhi,jchi)
101 
102  if (iplo .gt. iphi .or. jplo .gt. jphi) go to 75
103 c
104 c calculate starting index for fine grid source pts.
105 c
106  iff = iplo*intratx(lget) - node(ndilo,mkid) + nghost + 1
107  jff = jplo*intraty(lget) - node(ndjlo,mkid) + nghost + 1
108  totrat = intratx(lget) * intraty(lget)
109 
110  do 71 i = iplo-ilo+nghost+1, iphi-ilo+nghost+1
111  do 70 j = jplo-jlo+nghost+1, jphi-jlo+nghost+1
112  if (uprint) then
113  write(outunit,101) i,j,mptr,iff,jff,mkid
114  101 format(' updating pt. ',2i4,' of grid ',i3,' using ',2i4,
115  1 ' of grid ',i4)
116  write(outunit,102)(alloc(iadd(ivar,i,j)),ivar=1,nvar)
117  102 format(' old vals: ',4e12.4)
118  endif
119 c
120 c
121 c update using intrat fine points in each direction
122 c
123  do 35 ivar = 1, nvar
124  35 alloc(iadd(ivar,i,j)) = 0.d0
125 c
126  if (mcapa .eq. 0) then
127  do 50 jco = 1, intraty(lget)
128  do 50 ico = 1, intratx(lget)
129  do 40 ivar = 1, nvar
130  alloc(iadd(ivar,i,j))= alloc(iadd(ivar,i,j)) +
131  1 alloc(iaddf(ivar,iff+ico-1,jff+jco-1))
132  40 continue
133  50 continue
134  do 60 ivar = 1, nvar
135  60 alloc(iadd(ivar,i,j)) = alloc(iadd(ivar,i,j))/totrat
136 
137  else
138 
139  do 51 jco = 1, intraty(lget)
140  do 51 ico = 1, intratx(lget)
141  capa = alloc(iaddfaux(iff+ico-1,jff+jco-1))
142  do 41 ivar = 1, nvar
143  alloc(iadd(ivar,i,j))= alloc(iadd(ivar,i,j)) +
144  1 alloc(iaddf(ivar,iff+ico-1,jff+jco-1))*capa
145  41 continue
146  51 continue
147  do 61 ivar = 1, nvar
148  61 alloc(iadd(ivar,i,j)) = alloc(iadd(ivar,i,j))/
149  1 (totrat*alloc(iaddcaux(i,j)))
150  endif
151 c
152  if (uprint) write(outunit,103)(alloc(iadd(ivar,i,j)),
153  . ivar=1,nvar)
154  103 format(' new vals: ',4e12.4)
155 c
156  jff = jff + intraty(lget)
157  70 continue
158  iff = iff + intratx(lget)
159  jff = jplo*intraty(lget) - node(ndjlo,mkid) + nghost + 1
160  71 continue
161 c
162  75 mkid = node(levelptr,mkid)
163  go to 30
164 c
165  80 continue
166  end do
167 
168 !$OMP END PARALLEL DO
169 
170 c
171 c 80 mptr = node(levelptr, mptr)
172 c go to 20
173 c
174 c 85 continue
175 c
176  99 return
177  end
upbnd
subroutine upbnd(listbc, val, nvar, naux, mitot, mjtot, maxsp, mptr)
Definition: upbnd.f:4
iadd
integer pure function iadd(ivar, i, j)
Definition: intfil.f90:293
update
subroutine update(level, nvar, naux)
Definition: update.f:4
amr_module
Definition: amr_module.f90:1
Generated on Thu Mar 9 2017 15:15:52 for 2D AMRCLAW by   doxygen 1.8.6