2D AMRCLAW
icall.f
Go to the documentation of this file.
1 c
2 c --------------------------------------------------------------------
3 c
4  subroutine icall(val,aux,nrow,ncol,nvar,naux,
5  . ilo,ihi,jlo,jhi,level,iputst,jputst)
6 
7  use amr_module
8  implicit double precision (a-h, o-z)
9 
10  dimension val(nvar,nrow,ncol)
11  dimension aux(naux,nrow,ncol)
12 
13  logical sticksout
14 
15 
16 c NEW INDEX ORDERING
17  iadd(ivar,i,j) = loc + ivar-1 + nvar*((j-1)*mitot+i-1)
18  iaddaux(ivar,i,j) = locaux + ivar-1 + naux*((j-1)*mitot+i-1)
19 
20 c ::::::::::::::::::::::::::: ICALL :::::::::::::::::::::::::::::::
21 c
22 c find intersecting grids at the same level. copy data from
23 c intersecting grids to both val and aux arrays.
24 c
25 c use larger definition of grids here - boundary data already in.
26 c aux arrays also enlarged size.
27 c
28 c iputst, jputst: where to copy values into. may not be in
29 c location corresponding to ilo,ihi,etc. if
30 c the patch has been periodically wrapped.
31 
32 c
33 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
34 
35 
36  mptr = lstart(level)
37 
38  10 if (mptr .eq. 0) go to 99
39  iglo = node(ndilo,mptr)
40  ighi = node(ndihi,mptr)
41  jglo = node(ndjlo,mptr)
42  jghi = node(ndjhi,mptr)
43 
44 c # does it intersect?
45 c$$$ ixlo = max(iglo-nghost,ilo)
46 c$$$ ixhi = min(ighi+nghost,ihi)
47 c$$$ jxlo = max(jglo-nghost,jlo)
48 c$$$ jxhi = min(jghi+nghost,jhi)
49 c how did ghost cells get in the allowable region? They are not filled
50 c (since we may be interpolating from newly filled grids, not just grids
51 c that have been primed with bcs to be advanced.
52  ixlo = max(iglo,ilo)
53  ixhi = min(ighi,ihi)
54  jxlo = max(jglo,jlo)
55  jxhi = min(jghi,jhi)
56 
57 
58  if (ixlo .le. ixhi .and. jxlo .le. jxhi) then
59  loc = node(store1,mptr)
60  locaux = node(storeaux,mptr)
61  nx = ighi - iglo + 1
62  ny = jghi - jglo + 1
63  mitot = nx + 2*nghost
64  mjtot = ny + 2*nghost
65  do 30 j = jxlo, jxhi
66  do 30 i = ixlo, ixhi
67  do 20 ivar = 1, nvar
68  ialloc = iadd(ivar,i-iglo+nghost+1,j-jglo+nghost+1)
69  val(ivar,i-ilo+iputst,j-jlo+jputst) = alloc(ialloc)
70  20 continue
71  do 25 iaux = 1, naux
72  ialloc = iaddaux(iaux,i-iglo+nghost+1,j-jglo+nghost+1)
73  aux(iaux,i-ilo+iputst,j-jlo+jputst) = alloc(ialloc)
74  25 continue
75  30 continue
76  endif
77  mptr = node(levelptr, mptr)
78  go to 10
79 
80  99 continue
81 
82 c if cells stick out of domain but not periodic then set elsewhere
83 c either setaux and bc2amr. (called from routine that called this, e.g.
84 c saveqc or filval)
85 
86  return
87  end
logical pure function sticksout(iplo, iphi, jplo, jphi)
Definition: filpatch.f90:348
integer pure function iadd(ivar, i, j)
Definition: intfil.f90:293
subroutine icall(val, aux, nrow, ncol, nvar, naux, ilo, ihi, jlo, jhi, level, iputst, jputst)
Definition: icall.f:4