!
!  update_phi.f90
!
      subroutine update_phi(p,mi1,mj1,mk1, &          
                          phi1,mi2,mj2,mk2,phi2)
!
      implicit none
!
      integer :: p,mi1,mj1,mk1
      real :: phi1(mi1,mj1,mk1)
      integer :: mi2,mj2,mk2            
      real :: phi2(mi2,mj2,mk2)
!
      integer :: lend1,mend1,nend1
      integer :: i,j,k,l,m,n,is,ie,js,je,ks,ke
!
! p = the coarse level solution just converged
!
      if (p>=1) then
!
! Loop over coarse mesh
!
        lend1 = mod(mi1,2)
        mend1 = mod(mj1,2) 
        nend1 = mod(mk1,2)                             
!              
        do l=1,mi2
          do m=1,mj2
            do n=1,mk2
!
! Gather range for the fine mesh block
!
              if (mi1 == 1) then
                is = 1
                ie = mi1 
              else if (l < mi2) then
                is = (l-1)*2+1
                ie = is+1
              else
                is = (l-1)*2+1
                ie = is+1 - lend1                
              endif
!
              if (mj1 == 1) then
                js = 1
                je = mj1               
              else if (m < mj2) then
                js = (m-1)*2+1
                je = js + 1
              else
                js = (m-1)*2+1
                je = js+1 - mend1
              endif
!
              if (mk1 == 1) then
                ks = 1
                ke = mk1                 
              else if (n < mk2) then               
                ks = (n-1)*2+1
                ke = ks + 1  
              else
                ks = (n-1)*2+1
                ke = ks+1 - nend1                                
              endif
!
! sum over fine nesh block              
!
              do i = is,ie
              do j = js,je
              do k = ks,ke
!
                phi1(i,j,k) = phi1(i,j,k) + phi2(l,m,n)                                       
!
              enddo
              enddo
              enddo              
!                                           
            enddo
          enddo
        enddo      
!
      else
!
        do i = 1,mi1
        do j = 1,mj1
        do k = 1,mk1
          phi1(i,j,k) = phi1(i,j,k) + phi2(i,j,k)         
        enddo
        enddo
        enddo
!          
      endif 
!      
      end subroutine update_phi    