
c---------------------------------------------------------------------
c Выравнивание массивов для спуска по V-циклу
c @param integer d1, d2, d3 - смещение на краевые условия
c @param integer k - номер сетки
c---------------------------------------------------------------------                  
      subroutine dvmAlignDownCycle(d1, d2, d3, k)
      
      implicit none

      include 'globals.h'
      include 'dvmvars.h'
      
      integer k      
      integer d1, d2, d3       
      
      integer t1, t2, t3  
     
!DVM$ TEMPLATE EXT_V_DOWN (m1(k)+1, m2(k)+1, m3(k)+1)   
!DVM$ DISTRIBUTE EXT_V_DOWN (BLOCK, BLOCK, BLOCK)     
      
       t1 = d1 - 1; t2 = d2 - 1; t3 = d3 - 1;
       
!DVM$ REALIGN p_curr_r_j(i,j,k) WITH EXT_V_DOWN(2*i-1, 2*j-1, 2*k-1)       
!DVM$ REALIGN p_curr_r_k(i,j,k) WITH EXT_V_DOWN(i+t1, j+t2, k+t3)           
      
      return
      end

c---------------------------------------------------------------------
c Выравнивание массивов для подъема по V-циклу
c @param integer d1, d2, d3 - смещение на краевые условия
c @param integer k - номер сетки
c---------------------------------------------------------------------                        
      subroutine dvmAlignUpCycle(k)           

      implicit none

      include 'globals.h'
      include 'dvmvars.h'

      integer k
      
!!DVM$ SHADOW p_curr_u_k(1:1,1:1,1:1) 
!!DVM$ SHADOW p_curr_u_j(1:1,1:1,1:1)
      
!DVM$ TEMPLATE EXT_V_UP (m1(k)+1, m2(k)+1, m3(k)+1)   
!DVM$ DISTRIBUTE EXT_V_UP (BLOCK, BLOCK, BLOCK)  
           
!DVM$ REALIGN p_curr_u_j(i,j,k) WITH EXT_V_UP(2*i-1, 2*j-1, 2*k-1)       
!DVM$ REALIGN p_curr_u_k(i,j,k) WITH EXT_V_UP(i, j, k)   
!DVM$ REALIGN p_curr_r_k(i,j,k) WITH EXT_V_UP(i, j, k) 

       return
       end
    
c---------------------------------------------------------------------
c Инициализация параметров DVM
c @param integer isSecond - 1 при повторном вызове
c---------------------------------------------------------------------            
      subroutine setupDVM(isSecond)    
         implicit none      
                                
         include 'globals.h'         
         include 'dvmvars.h' 
         
         integer allocate, k, j, isSecond
         integer pdim(3) 
         integer d1, d2, d3 
         
!DVM$ TEMPLATE EXT_BOTTOM (m1(lb), m2(lb), m3(lb))
!DVM$ DISTRIBUTE EXT_BOTTOM (BLOCK, BLOCK, BLOCK)         
  
!DVM$ TEMPLATE EXT_LAST (m1(lt)+1, m2(lt)+1, m3(lt)+1)   
!DVM$ DISTRIBUTE EXT_LAST (BLOCK, BLOCK, BLOCK)    
        
        if (isSecond .eq. 0) then
             ! Выделяем массив укозателей        
             do k = lt, 1, -1
                 pdim =(/ m1(k), m2(k), m3(k) /)
                 p_u_ir(k) = allocate(pdim, ir(k))             
                 p_r_ir(k) = allocate(pdim, ir(k))             
             enddo      
             
             ! Выделяем память в куче под невязку
             pdim =(/ m1(lt), m2(lt), m3(lt) /)         
             pv = allocate(pdim, 1) 
             
             ! Добавляем сокращения
             pu = p_u_ir(lt)
             pr = p_r_ir(lt)         
        endif
                   
         ! Выравниваем на спуск
         p_curr_r_j = pr
         do  k= lt, lb+1 , -1
             j = k-1                 
             p_curr_r_k = p_curr_r_j
             p_curr_r_j = p_r_ir(j)                     
         		 	 
             if(m1(k).eq.3)then; d1 = 2; else; d1 = 1; endif
             if(m2(k).eq.3)then; d2 = 2; else; d2 = 1; endif
             if(m3(k).eq.3)then; d3 = 2; else; d3 = 1; endif
         
             call dvmAlignDownCycle(d1, d2, d3, k)         
         enddo 
         
         ! Выравниваем дно
         k = lb      
         p_curr_u_k =  p_u_ir(k)
         p_curr_r_k =  p_r_ir(k)   
!DVM$ REALIGN (i, j, k) WITH EXT_BOTTOM(i,j,k) :: p_curr_u_k
!DVM$ REALIGN (i, j, k) WITH EXT_BOTTOM(i,j,k) :: p_curr_r_k   
         
         ! Выравниваем подъем
         do  k = lb+1, lt-1     
             j = k-1
          
             p_curr_u_j = p_curr_u_k
             p_curr_u_k = p_u_ir(k)      
             p_curr_r_k = p_r_ir(k)
      
             call dvmAlignUpCycle(k)       
         enddo
     	   
         ! Выравниваем последнюю итерацию 
         j = lt - 1
         k = lt

         p_curr_u_j = p_u_ir(j)
      
!DVM$ REALIGN p_curr_u_j(i,j,k) WITH EXT_LAST(2*i-1, 2*j-1, 2*k-1)       
!DVM$ REALIGN pu(i,j,k) WITH EXT_LAST(i, j, k)   
!DVM$ REALIGN pr(i,j,k) WITH EXT_LAST(i, j, k)    
!DVM$ REALIGN pv(i,j,k) WITH EXT_LAST(i, j, k)   
        
      end subroutine setupDVM
          
      
c---------------------------------------------------------------------      
c Заглушка для DVM
c---------------------------------------------------------------------            
      function allocate(dims, disp) 
         integer allocate
         allocate = disp
         return
      end function allocate

c---------------------------------------------------------------------
c Инициализация параметров программы
c---------------------------------------------------------------------
      subroutine setup(n1,n2,n3,k)

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

      implicit none

      include 'globals.h'

      integer  is1, is2, is3, ie1, ie2, ie3
      common /grid/ is1,is2,is3,ie1,ie2,ie3

      integer n1,n2,n3,k
      integer j

      integer ax, mi(3,maxlevel)
      integer ng(3,maxlevel)      
      
      ng(1,lt) = nx(lt)
      ng(2,lt) = ny(lt)
      ng(3,lt) = nz(lt)
      do  ax=1,3
         do  k=lt-1,1,-1
            ng(ax,k) = ng(ax,k+1)/2
         enddo
      enddo
 61   format(10i4)
      do  k=lt,1,-1
         nx(k) = ng(1,k)
         ny(k) = ng(2,k)
         nz(k) = ng(3,k)
      enddo

      do  k = lt,1,-1
         do  ax = 1,3
            mi(ax,k) = 2 + ng(ax,k) 
         enddo

         m1(k) = mi(1,k)
         m2(k) = mi(2,k)
         m3(k) = mi(3,k)

      enddo
     
      k = lt
      is1 = 2 + ng(1,k) - ng(1,lt)
      ie1 = 1 + ng(1,k)
      n1 = 3 + ie1 - is1
      is2 = 2 + ng(2,k) - ng(2,lt)
      ie2 = 1 + ng(2,k) 
      n2 = 3 + ie2 - is2
      is3 = 2 + ng(3,k) - ng(3,lt)
      ie3 = 1 + ng(3,k) 
      n3 = 3 + ie3 - is3


      ir(lt)=1
      do  j = lt-1, 1, -1
         ir(j)=ir(j+1)+one*m1(j+1)*m2(j+1)*m3(j+1)
      enddo

      if( debug_vec(1) .ge. 1 )then
         write(*,*)' in setup, '
         write(*,*)' k  lt  nx  ny  nz ',
     &        ' n1  n2  n3 is1 is2 is3 ie1 ie2 ie3'
         write(*,9) k,lt,ng(1,k),ng(2,k),ng(3,k),
     &              n1,n2,n3,is1,is2,is3,ie1,ie2,ie3
 9       format(15i4)
      endif

      k = lt

      return
      end
      