conck.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	conck (level, nvar, naux, time, rest)
	Conservation check for specified level. More...

Function/Subroutine Documentation

conck()

subroutine conck	(		level,
			nvar,
			naux,
			time,
		logical	rest
	)

Conservation check for specified level.

This is mostly a debugging tool and assumes grids don't overlap

Definition at line 7 of file conck.f.

References amr_module::alloc, amr_module::hxposs, amr_module::hyposs, iadd(), amr_module::levelptr, amr_module::lstart, amr_module::mcapa, amr_module::ndihi, amr_module::ndilo, amr_module::ndjhi, amr_module::ndjlo, amr_module::nghost, amr_module::node, amr_module::outunit, amr_module::possk, amr_module::store1, amr_module::storeaux, amr_module::t0, and amr_module::tmass0.

Referenced by amr2(), and tick().

c
      use amr_module
      implicit double precision (a-h,o-z)

      logical  rest

c      iadd(i,j,ivar)  = loc + i - 1 + mitot*((ivar-1)*mjtot+j-1) OLD INDEXING
c      iaddaux(i,j) = locaux + i - 1 + mitot*(j-1) +
c     .                        mitot*mjtot*(mcapa-1)

c ## indexing into mcapa assumes cell volume is in mcapa location
      iadd(ivar,i,j)  = loc + ivar - 1 + nvar*((j-1)*mitot+i-1)
      iaddaux(i,j) = locaux + mcapa - 1 + naux*(i-1) +
     .                                    naux*mitot*(j-1)
c
c
c ******************************************************************
c conck - conservation check  for specified level
c         mostly a debugging tool
c         this assumes grids don't overlap
c
c ******************************************************************
c
c
c  grid loop for given level
c
      hx      = hxposs(level)
      hy      = hyposs(level)
      dt      = possk(level)
      totmass = 0.d0

      mptr = lstart(level)
 20   if (mptr .eq. 0) go to 85
         loc    = node(store1,mptr)
         locaux = node(storeaux,mptr)
         nx     = node(ndihi,mptr) - node(ndilo,mptr) + 1
         ny     = node(ndjhi,mptr) - node(ndjlo,mptr) + 1
         mitot  = nx + 2*nghost
         mjtot  = ny + 2*nghost
c
         if (mcapa .eq. 0) then
           do 50 j  = nghost+1, mjtot-nghost
           do 50 i  = nghost+1, mitot-nghost
              totmass = totmass + alloc(iadd(1,i,j)) 
 50           continue
          else
c          # with capa array:
           do 60 j  = nghost+1, mjtot-nghost
           do 60 i  = nghost+1, mitot-nghost
              totmass = totmass + alloc(iadd(1,i,j))*alloc(iaddaux(i,j)) 
 60           continue
          endif
c
       mptr = node(levelptr,mptr)
       go to 20
c
 85    totmass = totmass * hx * hy
       if (time.eq. t0 .and. (level.eq.1) .and. .not. rest) then
           tmass0 = totmass
           write(6,*) 'Total mass at initial time: ',tmass0
           endif
       write(outunit,777) time, totmass, totmass-tmass0
 777   format('time t = ',e12.5,',  total mass = ',e22.15, '  diff = ',
     &         e11.4)
c
 99   return

Here is the call graph for this function:

Here is the caller graph for this function: