!
! $Header$
!
MODULE fonte_neige_mod
!
! This module will treat the process of snow, melting, accumulating, calving, in 
! case of simplified soil model.
!
!****************************************************************************************
  USE dimphy, ONLY : klon
  USE indice_sol_mod

  IMPLICIT NONE
  SAVE

! run_off_ter and run_off_lic are the runoff at the compressed grid knon for 
! land and land-ice respectively
! Note: run_off_lic is used in mod_landice and therfore not private
  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_ter
  !$OMP THREADPRIVATE(run_off_ter)
  REAL, ALLOCATABLE, DIMENSION(:)             :: run_off_lic
  !$OMP THREADPRIVATE(run_off_lic)

! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_lic_0
  !$OMP THREADPRIVATE(run_off_lic_0)
  
  REAL, PRIVATE                               :: tau_calv  
  !$OMP THREADPRIVATE(tau_calv)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: ffonte_global
  !$OMP THREADPRIVATE(ffonte_global)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqfonte_global
  !$OMP THREADPRIVATE(fqfonte_global)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqcalving_global
  !$OMP THREADPRIVATE(fqcalving_global)
  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
  !$OMP THREADPRIVATE(runofflic_global)
#ifdef ISO
  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_ter
  !$OMP THREADPRIVATE(xtrun_off_ter)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: xtrun_off_lic
  !$OMP THREADPRIVATE(xtrun_off_lic)
  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_lic_0 
  !$OMP THREADPRIVATE(xtrun_off_lic_0)
  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global
  !$OMP THREADPRIVATE(fxtfonte_global)
  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global
  !$OMP THREADPRIVATE(fxtcalving_global)
  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrunofflic_global
  !$OMP THREADPRIVATE(xtrunofflic_global)
#endif

CONTAINS
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige_init(restart_runoff)

! This subroutine allocates and initialize variables in the module. 
! The variable run_off_lic_0 is initialized to the field read from
! restart file. The other variables are initialized to zero.
!
!****************************************************************************************
! Input argument
    REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff 

! Local variables
    INTEGER                           :: error
    CHARACTER (len = 80)              :: abort_message 
    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'


!****************************************************************************************
! Allocate run-off at landice and initilize with field read from restart
!
!****************************************************************************************

    ALLOCATE(run_off_lic_0(klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_lic'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    run_off_lic_0(:) = restart_runoff(:) 

!****************************************************************************************
! Allocate other variables and initilize to zero
!
!****************************************************************************************
    ALLOCATE(run_off_ter(klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_ter'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    run_off_ter(:) = 0.
    
    ALLOCATE(run_off_lic(klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_lic'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    run_off_lic(:) = 0.
    
    ALLOCATE(ffonte_global(klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation ffonte_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    ffonte_global(:,:) = 0.0

    ALLOCATE(fqfonte_global(klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation fqfonte_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    fqfonte_global(:,:) = 0.0

    ALLOCATE(fqcalving_global(klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation fqcalving_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    fqcalving_global(:,:) = 0.0

    ALLOCATE(runofflic_global(klon))
    IF (error /= 0) THEN
       abort_message='Pb allocation runofflic_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    runofflic_global(:) = 0.0

!****************************************************************************************
! Read tau_calv
!
!****************************************************************************************
    CALL conf_interface(tau_calv)


  END SUBROUTINE fonte_neige_init

#ifdef ISO
  SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)

! This subroutine allocates and initialize variables in the module. 
! The variable run_off_lic_0 is initialized to the field read from
! restart file. The other variables are initialized to zero.

    USE infotrac_phy, ONLY: niso
#ifdef ISOVERIF
    USE isotopes_mod, ONLY: iso_eau,iso_HDO
    USE isotopes_verif_mod
#endif
!
!****************************************************************************************
! Input argument
    REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff 

! Local variables
    INTEGER                           :: error
    CHARACTER (len = 80)              :: abort_message 
    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
    INTEGER                           :: i


!****************************************************************************************
! Allocate run-off at landice and initilize with field read from restart
!
!****************************************************************************************

    ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_lic'
       CALL abort_physic(modname,abort_message,1)
    ENDIF    
    
    xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)        

#ifdef ISOVERIF 
      IF (iso_eau > 0) THEN   
        CALL iso_verif_egalite_vect1D( &
     &           xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
     &           niso,klon)
      ENDIF !IF (iso_eau > 0) THEN
#endif        

!****************************************************************************************
! Allocate other variables and initilize to zero
!
!****************************************************************************************

    ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation xtrun_off_ter'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    xtrun_off_ter(:,:) = 0.
    
    ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation xtrun_off_lic'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    xtrun_off_lic(:,:) = 0.

    ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation fxtfonte_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    fxtfonte_global(:,:,:) = 0.0

    ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation fxtcalving_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    fxtcalving_global(:,:,:) = 0.0

    ALLOCATE(xtrunofflic_global(niso,klon))
    IF (error /= 0) THEN
       abort_message='Pb allocation xtrunofflic_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    xtrunofflic_global(:,:) = 0.0

  END SUBROUTINE fonte_neige_init_iso
#endif

!
!****************************************************************************************
!
  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
       tsurf, precip_rain, precip_snow, &
       snow, qsol, tsurf_new, evap, ice_sub &
#ifdef ISO    
     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
#endif
     &   )

    USE indice_sol_mod
#ifdef ISO
    USE infotrac_phy, ONLY: niso
    !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
#ifdef ISOVERIF
    USE isotopes_verif_mod
#endif
#endif
USE yoethf_mod_h
      USE clesphys_mod_h
  USE yomcst_mod_h

! Routine de traitement de la fonte de la neige dans le cas du traitement
! de sol simplifie!
! LF 03/2001
! input:
!   knon         nombre de points a traiter
!   nisurf       surface a traiter
!   knindex      index des mailles valables pour surface a traiter
!   dtime
!   tsurf        temperature de surface
!   precip_rain  precipitations liquides
!   precip_snow  precipitations solides
!
! input/output:
!   snow         champs hauteur de neige
!   qsol         hauteur d'eau contenu dans le sol
!   tsurf_new    temperature au sol
!   evap
!
  INCLUDE "FCTTRE.h"

! Input variables
!****************************************************************************************
    INTEGER, INTENT(IN)                  :: knon
    INTEGER, INTENT(IN)                  :: nisurf
    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    REAL   , INTENT(IN)                  :: dtime
    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf
    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
    REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow

    ! Input/Output variables
!****************************************************************************************

    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
    REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
    REAL, DIMENSION(klon), INTENT(INOUT) :: evap


    REAL, DIMENSION(klon), INTENT(OUT)   :: ice_sub
#ifdef ISO    
        ! sortie de quelques diagnostiques
    REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
    REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
    REAL, DIMENSION(klon), INTENT(OUT) ::  snow_evap_diag 
    REAL, DIMENSION(klon), INTENT(OUT) ::  fqcalving_diag  
    REAL,                  INTENT(OUT) :: max_eau_sol_diag  
    REAL, DIMENSION(klon), INTENT(OUT) ::  runoff_diag   
    REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag  
    REAL,                  INTENT(OUT) :: coeff_rel_diag    
#endif


! Local variables
!****************************************************************************************

    INTEGER               :: i, j
    REAL                  :: fq_fonte
    REAL                  :: coeff_rel
    REAL, PARAMETER       :: snow_max=3000.
    REAL, PARAMETER       :: max_eau_sol = 150.0
!! PB temporaire en attendant mieux pour le modele de neige
! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
    REAL, PARAMETER       :: chasno = 3.334E+05/(2.3867E+06*0.15)
!IM cf JLD/ GKtest
    REAL, PARAMETER       :: chaice = 3.334E+05/(2.3867E+06*0.15)
! fin GKtest
    REAL, DIMENSION(klon) :: ffonte
    REAL, DIMENSION(klon) :: fqcalving, fqfonte
    REAL, DIMENSION(klon) :: d_ts
    REAL, DIMENSION(klon) :: bil_eau_s, snow_evap

    LOGICAL               :: neige_fond

#ifdef ISO
        max_eau_sol_diag=max_eau_sol
#endif


!****************************************************************************************
! Start calculation
! - Initialization
!
!****************************************************************************************
    coeff_rel = dtime/(tau_calv * rday)
    
    bil_eau_s(:) = 0.

!****************************************************************************************
! - Increment snow due to precipitation and evaporation
! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
!
!****************************************************************************************
    WHERE (precip_snow > 0.) 
       snow = snow + (precip_snow * dtime)
    END WHERE

    snow_evap = 0.
    ice_sub(:) = 0.
  
    IF (.NOT. ok_lic_cond) THEN
!---only positive evaporation has an impact on snow 
!---note that this could create a bit of water
!---this was the default until CMIP6 
      WHERE (evap > 0. )
         snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
         snow = snow - snow_evap * dtime         !---snow that remains on the ground
         snow = MAX(0.0, snow)                   !---just in case
      END WHERE
    ELSE
!--now considers both positive and negative evaporation in the budget of snow 
      snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
      snow = snow - snow_evap * dtime         !---snow that remains or deposits on the ground
      snow = MAX(0.0, snow)                   !---just in case
   ENDIF
    
    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime

    IF (nisurf==is_lic) THEN
       DO i=1,knon
          ice_sub(i)=evap(i)-snow_evap(i)
       ENDDO
    ENDIF

#ifdef ISO
    snow_evap_diag(:) = snow_evap(:)
    coeff_rel_diag    = coeff_rel
#endif



!****************************************************************************************
! - Calculate melting snow
! - Calculate calving and decrement snow, if there are to much snow
! - Update temperature at surface
!
!****************************************************************************************

    ffonte(:) = 0.0
    fqcalving(:) = 0.0
    fqfonte(:) = 0.0

    DO i = 1, knon
       ! Y'a-t-il fonte de neige?
       neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
       IF (neige_fond) THEN
          fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
          ffonte(i)    = fq_fonte * RLMLT/dtime
          fqfonte(i)   = fq_fonte/dtime
          snow(i)      = MAX(0., snow(i) - fq_fonte)
          bil_eau_s(i) = bil_eau_s(i) + fq_fonte 
          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno  
#ifdef ISO
          fq_fonte_diag(i) = fq_fonte
#endif


!IM cf JLD OK     
!IM cf JLD/ GKtest fonte aussi pour la glace
          IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
             IF ( ok_lic_melt ) THEN
                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
             ENDIF
             tsurf_new(i) = RTT
          ENDIF
          d_ts(i) = tsurf_new(i) - tsurf(i)
       ENDIF

       ! s'il y a une hauteur trop importante de neige, elle est ecretee
       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
       snow(i)=MIN(snow(i),snow_max)
    ENDDO
#ifdef ISO
    DO i = 1, knon
       fqcalving_diag(i) = fqcalving(i)
       fqfonte_diag(i)   = fqfonte(i)
    ENDDO !DO i = 1, knon
#endif


    IF (nisurf == is_ter) THEN
       DO i = 1, knon
          qsol(i) = qsol(i) + bil_eau_s(i)
          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
#ifdef ISO
          runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
#endif
          qsol(i) = MIN(qsol(i), max_eau_sol) 
       ENDDO
    ELSE IF (nisurf == is_lic) THEN
       DO i = 1, knon
          j = knindex(i)
          !--temporal filtering
          run_off_lic(i)   = coeff_rel*fqcalving(i) + (1.-coeff_rel)*run_off_lic_0(j)
          run_off_lic_0(j) = run_off_lic(i)
          !--add melting snow and liquid precip to runoff of ice cap
          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
       ENDDO
    ENDIF

#ifdef ISO
    DO i = 1, klon    
      run_off_lic_diag(i) = run_off_lic(i)
    ENDDO ! DO i = 1, knon    
#endif
    
!****************************************************************************************
! Save ffonte, fqfonte and fqcalving in global arrays for each 
! sub-surface separately
!
!****************************************************************************************
    DO i = 1, knon
       ffonte_global(knindex(i),nisurf)    = ffonte(i)
       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
    ENDDO

    IF (nisurf == is_lic) THEN
    DO i = 1, knon
       runofflic_global(knindex(i)) = run_off_lic(i)
    ENDDO
    ENDIF

  END SUBROUTINE fonte_neige
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige_final(restart_runoff &
#ifdef ISO      
     &                        ,xtrestart_runoff &
#endif   
     &                        )
!
! This subroutine returns run_off_lic_0 for later writing to restart file.
!
#ifdef ISO
    USE infotrac_phy, ONLY: niso
#ifdef ISOVERIF
    USE isotopes_mod, ONLY: iso_eau
    USE isotopes_verif_mod
#endif
#endif
!
!****************************************************************************************
    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
#ifdef ISO     
    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
#ifdef ISOVERIF
    INTEGER :: i
#endif  
#endif



!****************************************************************************************
! Set the output variables
    restart_runoff(:) = run_off_lic_0(:)
#ifdef ISO
    xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
#ifdef ISOVERIF 
    IF (iso_eau > 0) THEN   
      DO i=1,klon
        IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
     &                              ,xtrun_off_lic_0(iso_eau,i) &
     &                              ,'fonte_neige 413') &
     &      == 1) then
          WRITE(*,*) 'i=',i
          STOP
        ENDIF
      ENDDO !DO i=1,klon
    ENDIF !IF (iso_eau > 0) then 
#endif    
#endif



! Deallocation of all varaibles in the module
!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
!        fqfonte_global, fqcalving_global)

    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
#ifdef ISO
    IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
    IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
    IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
    IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
    IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
    IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
#endif


  END SUBROUTINE fonte_neige_final
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
              fqfonte_out, ffonte_out, run_off_lic_out &
#ifdef ISO     
     &       ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
#endif     
     &       )


! Cumulate ffonte, fqfonte and fqcalving respectively for
! all type of surfaces according to their fraction.
!
! This routine is called from physiq.F before histwrite.
!****************************************************************************************

    USE indice_sol_mod
#ifdef ISO
    USE infotrac_phy, ONLY: niso
#endif

    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf

    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out

#ifdef ISO
    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
    INTEGER   :: i,ixt
#endif
 
    INTEGER   :: nisurf
!****************************************************************************************

    ffonte_out(:)    = 0.0
    fqfonte_out(:)   = 0.0
    fqcalving_out(:) = 0.0
#ifdef ISO        
    fxtfonte_out(:,:)   = 0.0
    fxtcalving_out(:,:) = 0.0
#endif

    DO nisurf = 1, nbsrf
       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
    ENDDO

    run_off_lic_out(:)=runofflic_global(:)

#ifdef ISO
    DO nisurf = 1, nbsrf
      DO i=1,klon
        DO ixt=1,niso
          fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
          fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
        ENDDO !DO ixt=1,niso
      ENDDO !DO i=1,klon
    ENDDO !DO nisurf = 1, nbsrf
    xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
#endif

  END SUBROUTINE fonte_neige_get_vars
!
!****************************************************************************************
!
!#ifdef ISO
!  subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
!    use infotrac_phy, ONLY: niso
!
!    ! inputs
!    INTEGER, INTENT(IN)                      :: knon
!    real, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
!
!    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
!
!  end subroutine fonte_neige_export_xtrun_off_lic_0
!#endif 

#ifdef ISO
  SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
     &           xtprecip_snow,xtprecip_rain, &
     &           fxtfonte_neige,fxtcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)

        ! dans cette routine, on a besoin des variables globales de
        ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
        ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
        ! de dépendance circulaire.

    USE infotrac_phy, ONLY: ntiso,niso
    USE isotopes_mod, ONLY: iso_eau    
    USE indice_sol_mod    
#ifdef ISOVERIF
    USE isotopes_verif_mod
#endif
    IMPLICIT NONE

    ! inputs
    INTEGER, INTENT(IN)                     :: klon,knon
    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
    REAL, DIMENSION(niso,klon), INTENT(IN)  :: fxtfonte_neige,fxtcalving
    INTEGER, INTENT(IN)                     :: nisurf
    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
    REAL, DIMENSION(klon), INTENT(IN)       :: run_off_lic_diag  
    REAL, INTENT(IN)                        :: coeff_rel_diag  

    ! locals
    INTEGER :: i,ixt,j
        
#ifdef ISOVERIF
    IF (nisurf == is_lic) THEN
      IF (iso_eau > 0) THEN  
        DO i = 1, knon
           j = knindex(i)
           CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
     &             run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
        ENDDO
      ENDIF
    ENDIF
#endif

! calcul de run_off_lic 

    IF (nisurf == is_lic) THEN
!         coeff_rel = dtime/(tau_calv * rday)

      DO i = 1, knon
        j = knindex(i)
        DO ixt = 1, niso
          xtrun_off_lic(ixt,i)   = (coeff_rel_diag *  fxtcalving(ixt,i)) &
     &                            +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
          xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
          xtrun_off_lic(ixt,i)   = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
        ENDDO !DO ixt=1,niso
#ifdef ISOVERIF
          IF (iso_eau > 0) THEN             
            IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
     &                  run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
     &                  errmax,errmaxrel) == 1) THEN 
               WRITE(*,*) 'i,j=',i,j   
               WRITE(*,*) 'coeff_rel_diag=',coeff_rel_diag
               STOP
            ENDIF
          ENDIF
#endif
      ENDDO
    ENDIF !IF (nisurf == is_lic) THEN  

! Save ffonte, fqfonte and fqcalving in global arrays for each 
! sub-surface separately
    DO i = 1, knon
      DO ixt = 1, niso
        fxtfonte_global(ixt,knindex(i),nisurf)   = fxtfonte_neige(ixt,i)
        fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
      ENDDO !do ixt=1,niso
    ENDDO   

    IF (nisurf == is_lic) THEN
      DO i = 1, knon    
        DO ixt = 1, niso   
        xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
        ENDDO ! DO ixt=1,niso   
      ENDDO
    ENDIF
       
  END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
#endif


END MODULE fonte_neige_mod
