c -- copyer.f --  routines used by cm.f

c ---------------------------------------------------------------------
c Copy context from ccc0 to ddd0, including all needed fake zones,
c and all boundaries.  The check for complete prefetch is made just
c before each copy so we can start copying before all reads are done.

      subroutine copyIn( myid,  iz0,iz1, status )
      implicit none
      include 'thingftn.h'

      integer myid, iz0, iz1, status(NWSTATUS_THING,9)

      include 'iq.h'
      include 'bdrysin.h'
      include 'context.h'

      integer nbytes, nbytesRIO, thisbytes, thisremote
      real elapsed, elapsedRIO, thistime

      integer z,y,x,k, ierr, maxz
c ---
      maxz = (iz1-iz0+1)

      elapsed= 0
      elapsedRIO= 0
      nbytes= 0
      nbytesRIO= 0

c      write(0,*) "cm: copyin iz0,iz1=", iz0, iz1

      ierr= wait_thing( status(1,1), FOREVER )
      call getIOstatistics_thing( status(1,1), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

c ccc0 interior zones.  ccc0 has been supplied with periodic boundaries.

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, npy
            do x = 1, npx
               do k = 1, nvar
                  ddd0(k,x,y,z) = ccc0(k,x,y,z)
               enddo
d               if ( ddd0(1,x,y,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 1 xyz", x,y,z
d                  stop
d               endif
            enddo
         enddo
      enddo

c Each prefetch gets the section of boundaries required
c for the update region plus fake zones in z

      ierr= wait_thing( status(1,2), FOREVER )
      call getIOstatistics_thing( status(1,2), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, npy
            do x = 1, nbdyf
               do k = 1, nvar
                  ddd0(k,x-nbdyf,y,z)= xl(k,x,y,z)
               enddo
d               if ( ddd0(1,x-nbdyf,y,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 2 xyz", x-nbdyf,y,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,3), FOREVER )
      call getIOstatistics_thing( status(1,3), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, npy
            do x = 1, nbdyf
               do k = 1, nvar
                  ddd0(k,x+npx,y,z)= xr(k,x,y,z)
               enddo
d               if ( ddd0(1,x+npx,y,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 3 xyz", x+npx,y,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,4), FOREVER )
      call getIOstatistics_thing( status(1,4), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, nbdyf
            do x = 1, npx
               do k = 1, nvar
                  ddd0(k,x,y-nbdyf,z)= yb(k,x,y,z)
               enddo
d               if ( ddd0(1,x,y-nbdyf,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 4 xyz", x,y-nbdyf,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,5), FOREVER )
      call getIOstatistics_thing( status(1,5), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, nbdyf
            do x = 1, npx
               do k = 1, nvar
                  ddd0(k,x,y+npy,z)= yt(k,x,y,z)
               enddo
d               if ( ddd0(1,x,y+npy,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 5 xyz", x,y+npy,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,6), FOREVER )
      call getIOstatistics_thing( status(1,6), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, nbdyf
            do x = 1, nbdyf
               do k = 1, nvar
                  ddd0(k,x-nbdyf,y-nbdyf,z)= xlyb(k,x,y,z)
               enddo
d               if ( ddd0(1,x-nbdyf,y-nbdyf,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 6 xyz", x-nbdyf,y-nbdyf,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,7), FOREVER )
      call getIOstatistics_thing( status(1,7), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, nbdyf
            do x = 1, nbdyf
               do k = 1, nvar
                  ddd0(k,x-nbdyf,npy+y,z)= xlyt(k,x,y,z)
               enddo
d               if ( ddd0(1,x-nbdyf,npy+y,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 7 xyz", x-nbdyf,npy+y,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,8), FOREVER )
      call getIOstatistics_thing( status(1,8), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, nbdyf
            do x = 1, nbdyf
               do k = 1, nvar
                  ddd0(k,npx+x,npy+y,z)= xryt(k,x,y,z)
               enddo
d               if ( ddd0(1,npx+x,npy+y,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 8 xyz", npx+x,npy+y,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      ierr= wait_thing( status(1,9), FOREVER )
      call getIOstatistics_thing( status(1,9), thistime, thisbytes, thisremote )
      if ( thisremote .ne. 0 ) then
         nbytesRIO = nbytesRIO + thisbytes
         elapsedRIO= elapsedRIO + thistime
      else
         nbytes = nbytes + thisbytes
         elapsed= elapsed + thistime
      endif

      do z = 1-nbdyf, maxz+nbdyf
         do y = 1, nbdyf
            do x = 1, nbdyf
               do k = 1, nvar
                  ddd0(k,npx+x,y-nbdyf,z)= xryb(k,x,y,z)
               enddo
d               if ( ddd0(1,npx+x,y-nbdyf,z) .eq. 0 ) then
d                  write(0,*) "CM read 0 on prefetch loop 9 xyz", npx+x,y-nbdyf,z
d                  stop
d               endif
            enddo
         enddo
      enddo

      if ( nbytes.eq.0 ) elapsed= 1
      if ( nbytesRIO.eq.0 ) elapsedRIO= 1
c      write(0,*) "cm",myid," prefetch  local ",nbytes, nbytes/elapsed/1.0e6,
c     &           " remote ",nbytesRIO, nbytesRIO/elapsedRIO/1.0e6

c      write(0,1010) myid, nbytes, nbytes/elapsed/1.0e6,
c     &              nbytesRIO, nbytesRIO/elapsedRIO/1.0e6
c 1010 format("cm:",i3," prefetch local bytes/MBsec",i12,2x, f7.2,
c     &           " remote nbytes/MBsec",i10,f7.2)

      return
      end
c
c
c
c ------------------------------------------------------------------------
c start writeback of boundary and interior zones for a tile,
c including the work unpacking to scratch arrays ccc1 and /bdrysout/
c
c itx,ity  --  Tile coordinates 1..nyx, 1..nty
c iset     --  0 or 1, which data set to write
c iz0:iz1  --  range of realzone output to write, in range 1:nz
c accumulated energies (for real zones only)
c write_thing status vector
c
c The return value is the number of writes started (and so the number of
c waits that must clear before they're all completed)
c
c 'iset' is 0 or 1, specifying which prefix to use to write -
c to write an extra non-local copy, icheckset should be set to '2' or '3'
c
      integer function writeBack( ddd,iset, isetcheck, itx, ity, iz0, iz1, status )
      implicit none

      include 'thingftn.h'
      include 'iq.h'
      include 'context.h'
      include 'bdrysout.h'

      real ddd(nvar,1-nbdyf:npx+nbdyf, 1-nbdyf:npy+nbdyf, 1-nbdyf:npz+nbdyf)

      integer itx,ity, iset, isetcheck, iz0,iz1, status(NWSTATUS_THING,27)

      integer ix,iy,iz, k, zoff, nreal
      integer maxz, z1stplane

c     // neighboring tile indices, in periodic sense
      integer ntx,nty, itxl,itxr,ityb,ityt
c----------------------

      ntx= (nx+npx-1)/npx
      nty= (ny+npy-1)/npy

      itxl= itx-1
      if ( itxl .le. 0 ) itxl= ntx

      itxr= itx+1
      if ( itxr .gt. ntx ) itxr= 1

      ityb= ity-1
      if ( ityb .le. 0 ) ityb= nty
      ityt= ity+1
      if ( ityt .gt. nty ) ityt= 1

c     // top real block zone (bottom, '1', is iz0)
      maxz= (iz1-iz0+1)

c      write(0,*) "writeback iset,itx,ity=", iset,itx,ity
c      write(0,*) "writeback iz0,iz1= ", iz0,iz1

c     // offset (z zones) to first real zone 
      z1stplane= (iz0-1) + nbdyf

c     // Now copy the real zone data itself

      do iz= 1, maxz
        do iy= 1, npy
          do ix= 1, npx
c unrolled
c            do k= 1, nvar
              ccc1(1,ix,iy,iz)= ddd(1,ix,iy,iz)
              ccc1(2,ix,iy,iz)= ddd(2,ix,iy,iz)
              ccc1(3,ix,iy,iz)= ddd(3,ix,iy,iz)
              ccc1(4,ix,iy,iz)= ddd(4,ix,iy,iz)
              ccc1(5,ix,iy,iz)= ddd(5,ix,iy,iz)
              ccc1(6,ix,iy,iz)= ddd(6,ix,iy,iz)
c            enddo

c            sumkntc = sumkntc + ddd(1,ix,iy,iz) *
c     &        ( ddd(3,ix,iy,iz)**2 + ddd(4,ix,iy,iz)**2 + ddd(5,ix,iy,iz)**2 )
c            sumprs = sumprs + ddd(2,ix,iy,iz)

d         if ( ccc1(1,ix,iy,iz).eq.0 )  then
d            write(0,*) "cm: ZERO writeback @xyz ",ix,iy,iz     
d            stop
d         endif
            enddo
        enddo
      enddo

      zoff = (npx*npy*nvar) * z1stplane
      nreal= (npx*npy*nvar) * maxz
      writeback= 1
      call write_stuff( 1,itx,ity,iset, zoff, nreal, ccc1(1,1,1,1), status(1,writeBack) )

      if ( isetcheck .ne. 0 ) then
         writeBack= writeBack + 1
         call write_stuff( 1,itx,ity,isetcheck, zoff, nreal, ccc1(1,1,1,1), status(1,writeBack) )
      endif

c NO further boundaries are written back as checkpoint data

c     // periodic means, for example, the 'xl' face is written to tile
c        itxl,ity but as xr.  These details and name construction are
c        taken care of in the case'd C routine write_stuff

      do iz= 1, maxz
        do iy= 1, npy
           do ix= 1, nbdyf
             do k= 1, nvar
               xl(k,ix,iy,iz)= ddd(k,ix,iy,iz)
             enddo  
d         if ( ddd(1,ix,iy,iz).eq.0 )  then
d            write(0,*) "cm: ZERO writeback @xyz ",ix,iy,iz     
d            stop
d         endif
            enddo
        enddo
      enddo

      zoff = (nbdyf*npy*nvar) * z1stplane
      nreal= (nbdyf*npy*nvar) * maxz
      writeBack= writeBack + 1
      call write_stuff( 2,itxl,ity,iset, zoff,nreal, xl(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 2,itx,ity,isetcheck, zoff, nreal, xl(1,1,1,1), status(1,writeBack) )
c      endif

      do iz= 1, maxz
        do iy= 1, npy
           do ix= 1, nbdyf
             do k= 1, nvar
               xr(k,ix,iy,iz)= ddd(k,npx-nbdyf+ix,iy,iz)
             enddo  
d         if ( xr(1,ix,iy,iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xr @xyz ",ix,iy,iz     
d            stop
d         endif
            enddo
        enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 3,itxr,ity,iset, zoff,nreal, xr(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 3,itx,ity,isetcheck, zoff, nreal, xr(1,1,1,1), status(1,writeBack) )
c      endif

      do iz= 1, maxz
        do iy= 1, nbdyf
           do ix= 1, npx
             do k= 1, nvar
               yb(k,ix,iy,iz)= ddd(k,ix,iy,iz)
             enddo  
d         if ( yb(1,ix,iy,iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback yb @xyz ",ix,iy,iz     
d            stop
d         endif
            enddo
        enddo
      enddo

      zoff  = (npx*nbdyf*nvar) * z1stplane
      nreal = (npx*nbdyf*nvar) * maxz

      writeBack= writeBack + 1
      call write_stuff( 4,itx,ityb, iset, zoff,nreal, yb(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 4,itx,ityb, isetcheck, zoff,nreal, yb(1,1,1,1), status(1,writeBack) )
c      endif

      do iz= 1, maxz
        do iy= 1, nbdyf
           do ix= 1, npx
             do k= 1, nvar
               yt(k,ix,iy,iz)= ddd(k,ix,npy-nbdyf+iy,iz)
             enddo  
d         if ( yt(1,ix,iy,iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback yt @xyz ",ix,iy,iz     
d            stop
d         endif
            enddo
        enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 5,itx,ityt, iset, zoff,nreal, yt(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 5,itx,ityt, isetcheck, zoff,nreal, yt(1,1,1,1), status(1,writeBack) )
c      endif

      do iz= 1, maxz
        do iy= 1, nbdyf
          do ix= 1, nbdyf
            do k= 1, nvar
              xlyb(k,ix,iy,iz)= ddd(k,ix,iy,iz)
            enddo
d         if ( xlyb(1,ix,iy,iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xlyb @xyz ",ix,iy,iz     
d            stop
d         endif
          enddo
        enddo
      enddo

      zoff  = (nbdyf*nbdyf*nvar) * z1stplane
      nreal = (nbdyf*nbdyf*nvar) * maxz

      writeBack= writeBack + 1
      call write_stuff( 6,itxl,ityb, iset, zoff,nreal, xlyb(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 6,itxl,ityb, isetcheck, zoff,nreal, xlyb(1,1,1,1), status(1,writeBack) )
c      endif

      do iz= 1, maxz
        do iy= 1, nbdyf
          do ix= 1, nbdyf
            do k= 1, nvar
              xlyt(k,ix,iy,iz)= ddd(k,ix,npy-nbdyf+iy,iz)
            enddo
d         if ( xlyt(1,ix,iy,iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xlyt @xyz ",ix,iy,iz     
d            stop
d         endif
          enddo
        enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 7,itxl,ityt,iset, zoff,nreal, xlyt(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 7,itxl,ityt,isetcheck, zoff,nreal, xlyt(1,1,1,1), status(1,writeBack) )
c      endif


      do iz= 1, maxz
        do iy= 1, nbdyf
          do ix= 1, nbdyf
            do k= 1, nvar
              xryt(k,ix,iy,iz)= ddd(k,npx-nbdyf+ix,npy-nbdyf+iy,iz)
            enddo
d         if ( xryt(1,ix,iy,iz).eq.0 ) then
d           write(0,*) "cm: ZERO writeback xryt @xyz ",ix,iy,iz     
d            stop
d         endif
          enddo
        enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 8,itxr,ityt,iset, zoff,nreal, xryt(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 8,itxr,ityt,isetcheck, zoff,nreal, xryt(1,1,1,1), status(1,writeBack ) )
c      endif

      do iz= 1, maxz
        do iy= 1, nbdyf
          do ix= 1, nbdyf
            do k= 1, nvar
              xryb(k,ix,iy,iz)= ddd(k,npx-nbdyf+ix,iy,iz)
            enddo
d         if ( xryb(1,ix,iy,iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xryb @xyz ",ix,iy,iz     
d            stop
d         endif
          enddo
        enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 9,itxr,ityb,iset, zoff,nreal, xryb(1,1,1,1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 9,itxr,ityb,isetcheck, zoff,nreal, xryb(1,1,1,1), status(1,writeBack) )
c      endif

c Just return if this block is in the middle of the tower - this is the simple case.
c
ccc      writeBack= 9

      if ( writeBack .ne. 9 .and. isetcheck .eq. 0 ) stop 'bad writeback'
      if ( writeBack .ne. 10 .and. isetcheck .ne. 0 ) stop 'bad remotewriteback'

      if ( iz0 .gt. nbdyf .and. iz1 .lt. nz+1-nbdyf ) return

c In the case of an end block, we have periodic boundary data to write.
c
c The real zone data may have 'end caps' added for the periodic data if
c the chunk happens to be at the bottom or top of the pillar... or both.
c I'm assuming here that a chunk (npz) >= (nbdyf)
c Each endcap must write 8 chunks of boundary data.
c
      if ( iz1 .lt. nz+1-nbdyf ) goto 1000
c
c --- This block is at the top of a tower.  Write <nbdyf> thick bdry elements
c     to neighbors appropriately periodic.
c
c     // top block- interior zones

      do iz= 1, nbdyf
         do iy= 1, npy
           do ix= 1, npx
             do k= 1, nvar
                ccc1(k,ix,iy,npz+iz)= ddd(k,ix,iy,maxz-nbdyf+iz)
             enddo
d         if ( ccc1(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback ccc1 @xyz ",ix,iy,iz+npz
d            stop
d         endif
           enddo
         enddo
      enddo

      nreal = (npx*npy*nvar) * nbdyf
      zoff= 0
      writeBack= writeBack + 1
      call write_stuff( 1,itx,ity,iset, zoff,nreal, 
     &                  ccc1(1,1,1,npz+1), status(1,writeBack) )

      if ( isetcheck .ne. 0 ) then
         writeBack= writeBack + 1
         call write_stuff( 1,itx,ity,isetcheck, zoff,nreal, ccc1(1,1,1,npz+1), status(1,writeBack) )
      endif

c     // face boundaries: xl 
      do iz= 1, nbdyf
        do iy= 1, npy
           do ix= 1, nbdyf
              do k= 1, nvar
                 xl(k,ix,iy,npz+iz)= ddd(k,ix,iy,maxz-nbdyf+iz)
              enddo
d         if ( xl(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xl @xyz ",ix,iy,iz+npz
d            stop
d         endif
           enddo
        enddo
      enddo

      nreal= (nbdyf*npy*nvar) * nbdyf
      zoff = 0
      writeBack= writeBack + 1
      call write_stuff( 2,itxl,ity,iset, zoff,nreal, 
     &                  xl(1,1,1,npz+1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 2,itxl,ity,isetcheck, zoff,nreal, 
c     &                  xl(1,1,1,npz+1), status(1,writeBack) )
c      endif

c     // xr
      do iz= 1, nbdyf
         do iy= 1, npy
            do ix= 1, nbdyf
               do k= 1, nvar
                  xr(k,ix,iy,npz+iz)= ddd(k,npx-nbdyf+ix,iy,maxz-nbdyf+iz)
               enddo
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 3,itxr,ity,iset, zoff,nreal, 
     &                  xr(1,1,1,npz+1), status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 3,itxr,ity,isetcheck, zoff,nreal, 
c     &        xr(1,1,1,npz+1), status(1,writeBack) )
c      endif

c     // yb
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, npx
               do k= 1, nvar
                  yb(k,ix,iy,npz+iz)= ddd(k,ix,iy,maxz-nbdyf+iz)
               enddo
d         if ( yb(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback yb @xyz ",ix,iy,iz+npz
d            stop
d         endif
            enddo
         enddo
      enddo

      nreal = (npx*nbdyf*nvar) * nbdyf
      writeBack= writeBack + 1
      call write_stuff( 4,itx,ityb,iset, zoff,nreal, 
     &                  yb(1,1,1,npz+1), status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 4,itx,ityb,isetcheck, zoff,nreal, 
c     &        yb(1,1,1,npz+1), status(1,writeBack))
c      endif

c     // yt
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, npx
               do k= 1, nvar
                  yt(k,ix,iy,npz+iz)= ddd(k,ix,npy-nbdyf+iy,maxz-nbdyf+iz)
               enddo
d         if ( yt(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback yt @xyz ",ix,iy,iz+npz
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 5,itx,ityt,iset, zoff,nreal, 
     &                  yt(1,1,1,npz+1), status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 5,itx,ityt,isetcheck, zoff,nreal, 
c     &        yt(1,1,1,npz+1), status(1,writeBack))
c      endif

c     // xlyb
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xlyb(k,ix,iy,npz+iz)= ddd(k,ix,iy,maxz-nbdyf+iz)
               enddo
d         if ( xlyb(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xlyb @xyz ",ix,iy,iz+npz
d            stop
d         endif
            enddo
          enddo
      enddo

      nreal = (nbdyf*nbdyf*nvar) * nbdyf
      writeBack= writeBack + 1
      call write_stuff( 6,itxl,ityb,iset, zoff,nreal, 
     &                  xlyb(1,1,1,npz+1), status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 6,itxl,ityb,isetcheck, zoff,nreal, 
c     &        xlyb(1,1,1,npz+1), status(1,writeBack))
c      endif

c     // xlyt
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xlyt(k,ix,iy,npz+iz)= ddd(k,ix,npy-nbdyf+iy,maxz-nbdyf+iz)
               enddo
d         if ( xlyt(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xlyt @xyz ",ix,iy,iz+npz
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 7,itxl,ityt,iset, zoff,nreal, 
     &                  xlyt(1,1,1,npz+1), status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 7,itxl,ityt,isetcheck, zoff,nreal, 
c     &        xlyt(1,1,1,npz+1), status(1,writeBack))
c      endif

c     // xryt
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xryt(k,ix,iy,npz+iz)= ddd(k,npx-nbdyf+ix,npy-nbdyf+iy,npz-nbdyf+iz)
               enddo
d         if ( xryt(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xryt @xyz ",ix,iy,iz+npz
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 8,itxr,ityt,iset, zoff,nreal, 
     &                  xryt(1,1,1,npz+1), status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 8,itxr,ityt,isetcheck, zoff,nreal, 
c     &        xryt(1,1,1,npz+1), status(1,writeBack))
c      endif

c     // xryb
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xryb(k,ix,iy,npz+iz)= ddd(k,npx-nbdyf+ix,iy,npz-nbdyf+iz)
               enddo
d         if ( xryb(1,ix,iy,npz+iz).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xryb @xyz ",ix,iy,iz+npz
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 9,itxr,ityb,iset, zoff,nreal, 
     &                  xryb(1,1,1,npz+1), status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 9,itxr,ityb,isetcheck, zoff,nreal, 
c     &        xryb(1,1,1,npz+1), status(1,writeBack))
c      endif

c -----------------------------------------------------------------

 1000 continue

c     // Bottom end cap, another possible 8 easy pieces.
c
      if ( iz0 .ne. 1 ) return

c     // bottom block- interior zones

      do iz= 1, nbdyf
         do iy= 1, npy
           do ix= 1, npx
             do k= 1, nvar
                ccc1(k,ix,iy,iz-nbdyf)= ddd(k,ix,iy,iz)
             enddo
d         if ( ccc1(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback ccc1 @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
           enddo
         enddo
      enddo

      nreal = (npx*npy*nvar) * nbdyf
      zoff  = (npx*npy*nvar) * (nz+nbdyf)
      writeBack= writeBack + 1
      call write_stuff( 1,itx,ity,iset, zoff,nreal, 
     &                  ccc1, status(1,writeBack) )

      if ( isetcheck .ne. 0 ) then
         writeBack= writeBack + 1
         call write_stuff( 1,itx,ity,isetcheck, zoff,nreal, 
     &        ccc1, status(1,writeBack) )
      endif

c     // face boundaries: xl 
      do iz= 1, nbdyf
        do iy= 1, npy
           do ix= 1, nbdyf
              do k= 1, nvar
                 xl(k,ix,iy,iz-nbdyf)= ddd(k,ix,iy,iz)
              enddo
d         if ( xl(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xl @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
           enddo
        enddo
      enddo

      nreal= (nbdyf*npy*nvar) * nbdyf
      zoff = (nbdyf*npy*nvar) * (nz+nbdyf)
      writeBack= writeBack + 1
      call write_stuff( 2,itxl,ity,iset, zoff,nreal, 
     &                  xl, status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 2,itxl,ity,isetcheck, zoff,nreal, 
c     &        xl, status(1,writeBack) )
c      endif

c     // xr
      do iz= 1, nbdyf
         do iy= 1, npy
            do ix= 1, nbdyf
               do k= 1, nvar
                  xr(k,ix,iy,iz-nbdyf)= ddd(k,npx-nbdyf+ix,iy,iz)
               enddo
d         if ( xr(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xr @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 3,itxr,ity,iset, zoff,nreal, 
     &                  xr, status(1,writeBack) )

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 3,itxr,ity,isetcheck, zoff,nreal, 
c     &        xr, status(1,writeBack) )
c      endif

c     // yb
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, npx
               do k= 1, nvar
                  yb(k,ix,iy,iz-nbdyf)= ddd(k,ix,iy,iz)
               enddo
d         if ( yb(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback yb @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
         enddo
      enddo

      nreal= (npx*nbdyf*nvar) * nbdyf
      zoff = (npx*nbdyf*nvar) * (nz+nbdyf)
      writeBack= writeBack + 1
      call write_stuff( 4,itx,ityb,iset, zoff,nreal, 
     &                  yb, status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 4,itx,ityb,isetcheck, zoff,nreal, 
c     &        yb, status(1,writeBack))
c      endif

c     // yt
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, npx
               do k= 1, nvar
                  yt(k,ix,iy,iz-nbdyf)= ddd(k,ix,npy-nbdyf+iy,iz)
               enddo
d         if ( yt(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback yt @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 5,itx,ityt,iset, zoff,nreal, 
     &                  yt, status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 5,itx,ityt,isetcheck, zoff,nreal, 
c     &        yt, status(1,writeBack))
c      endif

c     // xlyb
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xlyb(k,ix,iy,iz-nbdyf)= ddd(k,ix,iy,iz)
               enddo
d         if ( xlyb(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xlyb@xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
          enddo
      enddo

      nreal= (nbdyf*nbdyf*nvar) * nbdyf
      zoff = (nbdyf*nbdyf*nvar) * (nz+nbdyf)
      writeBack= writeBack + 1
      call write_stuff( 6,itxl,ityb,iset, zoff,nreal, 
     &                  xlyb, status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 6,itxl,ityb,isetcheck, zoff,nreal, 
c     &        xlyb, status(1,writeBack))
c      endif

c     // xlyt
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xlyt(k,ix,iy,iz-nbdyf)= ddd(k,ix,npy-nbdyf+iy,iz)
               enddo
d         if ( xlyt(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xlyt @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 7,itxl,ityt,iset, zoff,nreal, 
     &                  xlyt, status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 7,itxl,ityt,isetcheck, zoff,nreal, 
c     &        xlyt, status(1,writeBack))
c      endif

c     // xryt
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xryt(k,ix,iy,iz-nbdyf)= ddd(k,npx-nbdyf+ix,npy-nbdyf+iy,iz)
               enddo
d         if ( xryt(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xryt @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 8,itxr,ityt,iset, zoff,nreal, 
     &                  xryt, status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 8,itxr,ityt,isetcheck, zoff,nreal, 
c     &        xryt, status(1,writeBack))
c      endif

c     // xryb
      do iz= 1, nbdyf
         do iy= 1, nbdyf
            do ix= 1, nbdyf
               do k= 1, nvar
                  xryb(k,ix,iy,iz-nbdyf)= ddd(k,npx-nbdyf+ix,iy,iz)
               enddo
d         if ( xryb(1,ix,iy,iz-nbdyf).eq.0 ) then
d            write(0,*) "cm: ZERO writeback xryb @xyz ",ix,iy,iz-nbdyf
d            stop
d         endif
            enddo
         enddo
      enddo

      writeBack= writeBack + 1
      call write_stuff( 9,itxr,ityb,iset, zoff,nreal, 
     &                  xryb, status(1,writeBack))

c      if ( isetcheck .ne. 0 ) then
c         writeBack= writeBack + 1
c         call write_stuff( 9,itxr,ityb,isetcheck, zoff,nreal, 
c     &        xryb, status(1,writeBack))
c      endif

      return
      end