 SUBROUTINE proddl(w,bli,blo,co,ndim)
!=========================== DOCUMENTATION ============================= 
!DOCDEBh*    UTI/proddl  *
!
!    NOM
! proddl(w,bli,blo,co,ndim)
!    DESCRIPTION  
!*
! Initialise les ddls d un bloc du calcul co a partir des ddls du bloc du calcul ci
! les maillages des calculs sont eventuellement (de)raffine par 2.
!
! Initialise the dof of a co calculation block from the dof of the ci calculation block
! calculation meshes are eventually refined or coarsen 
!*
! 
! 
!    ENTREES / INPUT
!    w   variable primitives  du bloc initial / primitive variable of the initial block
!    bli  objet bloc initial / initial block object
!    blo  objet bloc final / final block object
!    ndim  dimension du maillage 1,2 ou3 / mesh dimension 1,2 or 3
!
!    SORTIES / OUTPUT
!    co  objet calcul de sortie (out) / output calcul object
!
!    SOURCE
! Ce logiciel est regi par la licence [CeCILL-B]
! This software is governed by the [CeCILL-B] license
!=========================== DEBUT DES DECLARATIONS ==================== 
!.1-----  Implicit, Use
  use num
  IMPLICIT NONE
!.2-----  Declaration
  type(bloc), intent(in)      :: bli,blo !! Bloc initial et final / Initial and final block
  type(list_vec), intent(inout)  :: w !! Variables primitives du bloc initial / Primitive variables of the initial block
  integer,intent(in)          :: ndim !! dimension du probleme / Problem dimension
  type(calcul), intent(inout) :: co  !! Objet calcul modifie / Modified calcul object
  
  integer                     :: i,j,k,nxi,nyi,nzi,nxo,nyo,nzo,nci,nco,ici,ico,ierr
!=========================== DEBUT DU CODE EXECUTABLE ==================
nxi=1;nyi=1;nzi=1;nxo=1;nyo=1;nzo=1

  SELECT CASE (ndim)
     CASE (1) ! Cas 1D
       nxi=bli%nx*2**(bli%nrb)
       nyi=1
       nzi=1
       nxo=blo%nx*2**(blo%nrb)
       nyo=1
       nzo=1
     CASE (2) ! Cas 2D
       nxi=bli%nx*2**(bli%nrb)
       nyi=bli%ny*2**(bli%nrb)
       nzi=1
       nxo=blo%nx*2**(blo%nrb)
       nyo=blo%ny*2**(blo%nrb)
       nzo=1
     CASE (3) ! Cas 3D
       nxi=bli%nx*2**(bli%nrb)
       nyi=bli%ny*2**(bli%nrb)
       nzi=bli%nz*2**(bli%nrb)
       nxo=blo%nx*2**(blo%nrb)
       nyo=blo%ny*2**(blo%nrb)
       nzo=blo%nz*2**(blo%nrb)
  END SELECT

  nci=nxi*nyi*nzi
  nco=nxo*nyo*nzo
  ierr=0
  DO i=1,nco
      co%msh%list_cell(i+blo%first_cell)%w%chi    =0.d0
      co%msh%list_cell(i+blo%first_cell)%w%vprim%v=0.d0
      co%msh%list_cell(i+blo%first_cell)%w%vbal%v =0.d0
      co%msh%list_cell(i+blo%first_cell)%w%gprim(1)%v=0.d0
      co%msh%list_cell(i+blo%first_cell)%w%gprim(2)%v=0.d0
      co%msh%list_cell(i+blo%first_cell)%w%gprim(3)%v=0.d0
  END DO

  
!======================================================================
! projection des ddl dans le bloc
!======================================================================
  IF (nci.eq.nco) THEN  ! le maillage interieur est identique
      ierr=1
      DO i=1,nco
          co%msh%list_cell(i+blo%first_cell)%w%vprim%v= w%vec(i)%v
          if(imodel_phy.eq.1.and. ngrad_bathy.eq.0)then ! on recupere le gradient de bathy si besoin
           SELECT CASE (ibathy)
              CASE(0)
              CASE(1) ! Initialisation de la bathymetrie par fonction utilisateur
                      CALL fct_bathy(co%msh%list_cell(i+blo%first_cell)%center%x, &
                                     co%msh%list_cell(i+blo%first_cell)%center%y, &
                                     co%msh%list_cell(i+blo%first_cell)%center%z, &
                                     co%msh%list_cell(i+blo%first_cell)%w%vprim%v(5), &
                                     co%msh%list_cell(i+blo%first_cell)%w%gprim(1)%v(5),&
                                     co%msh%list_cell(i+blo%first_cell)%w%gprim(2)%v(5), &
                                     co%msh%list_cell(i+blo%first_cell)%w%vprim%v(6))
              !~CASE (2) ! Initialisation de la bathymetrie par interpolation lineaire par bloc
              !~CASE (3) ! Initialisation de la bathymetrie par bloc sur le raffinement max
              CASE DEFAULT
                 call print_err('PRODDL','Unforeseen case')
           END SELECT
          endif
      END DO
  END IF
!----------------------
  IF (nci.eq.(nco*(2**ndim)))then ! le maillage est plus grossier
      ierr=1
      if(imodel_phy.eq.1)then
!methode qui conserve eta et pas h !!
        do i=1,nxi
          do j=1,nyi
            do k=1,nzi
              ici=i+(j-1)*nxi+(k-1)*nxi*nyi
              ico=int((i+1)/2)+(int((j+1)/2)-1)*nxo+(int((k+1)/2)-1)*nxo*nyo+blo%first_cell
!changement de repere h=eta
              if(w%vec(ici)%v(1)>hzero_phy)then
                w%vec(ici)%v(1)=w%vec(ici)%v(1)+w%vec(ici)%v(5)
              else
                w%vec(ici)%v(1:3)=0.d0
              endif

              co%msh%list_cell(ico)%w%vprim%v=co%msh%list_cell(ico)%w%vprim%v+w%vec(ici)%v
            enddo
          enddo
        enddo
        do i=1,nxo*nyo*nzo
          co%msh%list_cell(i+blo%first_cell)%w%vprim%v=co%msh%list_cell(i+blo%first_cell)%w%vprim%v/(2.d0**ndim)
!changement de repere h=h
! on met a jour la bathymetrie
           SELECT CASE (ibathy)
              CASE(0)
              CASE(1) ! Initialisation de la bathymetrie par fonction utilisateur
                      CALL fct_bathy(co%msh%list_cell(i+blo%first_cell)%center%x, &
                                     co%msh%list_cell(i+blo%first_cell)%center%y, &
                                     co%msh%list_cell(i+blo%first_cell)%center%z, &
                                     co%msh%list_cell(i+blo%first_cell)%w%vprim%v(5), &
                                     co%msh%list_cell(i+blo%first_cell)%w%gprim(1)%v(5),&
                                     co%msh%list_cell(i+blo%first_cell)%w%gprim(2)%v(5), &
                                     co%msh%list_cell(i+blo%first_cell)%w%vprim%v(6))
              !~CASE (2) ! Initialisation de la bathymetrie par interpolation lineaire par bloc
              !~CASE (3) ! Initialisation de la bathymetrie par bloc sur le raffinement max
              CASE DEFAULT
                 call print_err('PRODDL','Unforeseen case')
           END SELECT

          co%msh%list_cell(i+blo%first_cell)%w%vprim%v(1)=max(0.d0,&
          co%msh%list_cell(i+blo%first_cell)%w%vprim%v(1)-co%msh%list_cell(i+blo%first_cell)%w%vprim%v(5))   
          call Prim2Bal(co%msh%list_cell(i+blo%first_cell)%w)
        enddo

      else

        DO i=1,nxi
          DO j=1,nyi
              DO k=1,nzi
                  ici=i+(j-1)*nxi+(k-1)*nxi*nyi
                  ico=int((i+1)/2)+(int((j+1)/2)-1)*nxo+(int((k+1)/2)-1)*nxo*nyo+blo%first_cell
                  co%msh%list_cell(ico)%w%vprim%v=co%msh%list_cell(ico)%w%vprim%v+w%vec(ici)%v
              END DO
          END DO
        END DO
        DO i=1,nxo*nyo*nzo
          co%msh%list_cell(i+blo%first_cell)%w%vprim%v=co%msh%list_cell(i+blo%first_cell)%w%vprim%v/(2.d0**ndim)
          CALL prim2bal(co%msh%list_cell(i+blo%first_cell)%w)
        END DO
      endif
  END IF   
!----------------------
  IF (nci.eq.(nco/(2**ndim))) THEN ! le maillage est plus fin
      ierr=1
      if(imodel_phy.eq.1)then !methode qui conserve eta et pas h !!
            DO i=1,nxo
              DO j=1,nyo
                  DO k=1,nzo
                      ico=i+(j-1)*nxo+(k-1)*nxo*nyo+blo%first_cell
                      ici=int((i+1)/2)+(int((j+1)/2)-1)*nxi+(int((k+1)/2)-1)*nxi*nyi
                      co%msh%list_cell(ico)%w%vprim%v=w%vec(ici)%v
                      ! on met a jour la bathymetrie
                       SELECT CASE (ibathy)
                          CASE(0)
                          CASE(1) ! Initialisation de la bathymetrie par fonction utilisateur
                                  CALL fct_bathy(co%msh%list_cell(ico)%center%x, &
                                                 co%msh%list_cell(ico)%center%y, &
                                                 co%msh%list_cell(ico)%center%z, &
                                                 co%msh%list_cell(ico)%w%vprim%v(5), &
                                                 co%msh%list_cell(ico)%w%gprim(1)%v(5),&
                                                 co%msh%list_cell(ico)%w%gprim(2)%v(5), &
                                                 co%msh%list_cell(ico)%w%vprim%v(6))
                          !~CASE (2) ! Initialisation de la bathymetrie par interpolation lineaire par bloc
                          !~CASE (3) ! Initialisation de la bathymetrie par bloc sur le raffinement max
                          CASE DEFAULT
                             call print_err('PRODDL','Unforeseen case')
                       END SELECT
                       co%msh%list_cell(ico)%w%vprim%v(1)=max(0.d0,w%vec(ici)%v(1)+&
                       w%vec(ici)%v(5)-co%msh%list_cell(ico)%w%vprim%v(5))
                  END DO
              END DO
          END DO
      else
          DO i=1,nxo
              DO j=1,nyo
                  DO k=1,nzo
                      ico=i+(j-1)*nxo+(k-1)*nxo*nyo+blo%first_cell
                      ici=int((i+1)/2)+(int((j+1)/2)-1)*nxi+(int((k+1)/2)-1)*nxi*nyi
                      co%msh%list_cell(ico)%w%vprim%v=w%vec(ici)%v
                  END DO
              END DO
          END DO
      endif
  END IF   
!----------------------
  IF (ierr.eq.0) THEN ! Impossible
      write(*,*)nci,nco
      call print_err('PRODDL',' ERROR : Incompatible cell numbers')
  END IF
!===========================   FIN DE LA ROUTINE    ====================
END SUBROUTINE proddl
!DOCFIN