source: branches/GRISLIv3/SOURCES/bmelt-grounded.f90 @ 446

!> \file bmelt-grounded.f90
!! Calcule de la fusion basale et le type de base pour la partie posee 
!<

!> SUBROUTINE: bmelt_grounded 
!! Calcule la fusion basale et le type de base pour la partie posee.
!! \author ...
!! \date ...
!! @note cette routine est appelee quelle que soit le type de fusion sous les ice shelves
!! c'est pour cela qu'elle n'est pas dans bmelt-ant-regions_mod.f90
!! @note Used modules:
!! @note   - use module3D_phy
!! @note   - use param_phy_mod
!! @note   - use Icetemp_declar
!<

subroutine bmelt_grounded

  use module3d_phy, only: flot,bmelt,ibase,hwater,T,phid,cl,H,ghf,dtt
  use geography, only: nx,ny,nz
  use param_phy_mod, only: ro
  use icetemp_declar, only: ct,dee,cm,dzm,ncond
  use runparam, only: itracebug

  integer :: i,j

  if (itracebug.eq.1)  call tracebug('entree dans  bmelt-grounded')

  do j=2,ny-1
     do i=2,nx-1

        noflot :   if (.not.flot(i,j)) then    ! partie posée

           temper_gen:   if ((H(i,j).gt.10.).and.(ibase(i,j).ne.1)) then 

              if (ncond.eq.1) then   !  avec socle
                 bmelt(i,j)=(ct(i,j,nz)*(T(i,j,nz-1)-T(i,j,nz))/dee/H(i,j) &
                      -cm*(T(i,j,nz)-T(i,j,nz+1))/dzm+phid(i,j))/ro/cl  
              else                   ! sans socle
                 bmelt(i,j)=(ct(i,j,nz)*(T(i,j,nz-1)-T(i,j,nz))/dee/H(i,j) &
                      +(phid(i,j)-ghf(i,j)))/ro/cl
              endif


              if (bmelt(i,j).ge.0.) then    !  fusion base 2
                 ibase(i,j)=2

              else                          !   regel  

                 !              il reste de l'eau -> regel et on reste en base 2
                 if (hwater(i,j).gt.-bmelt(i,j)*dtt) then
                    ibase(i,j)=2

                    !                 passage a base froide
                 else if (ibase(i,j).eq.3) then
                    ibase(i,j)=4
                    bmelt(i,j)=0.
                    hwater(i,j)=0.

                    !                 regel mais il ne reste pas assez d'eau 
                 else if (hwater(i,j).le.-bmelt(i,j)*dtt) then
                    ibase(i,j)=3
                 endif           !          fin du test si regel  

              endif              !          fin du test fusion ou regel glace posee

           else                 ! glace tres fine ou ibase=1  
              bmelt(i,j)=0.
           endif temper_gen

           bmelt(i,j)=min(bmelt(i,j),15.0)

        endif noflot

     end do
  end do

  return
end subroutine bmelt_grounded