
MODULE surf_land_bucket_mod

! Surface land bucket module

! This module is used when no external land model is choosen.

  IMPLICIT NONE

CONTAINS

  SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
       spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
       u1, v1, gustiness, rugoro, swnet, lwnet, &
       snow, qsol, agesno, tsoil, &
       qsurf, z0_new, alb1_new, alb2_new, evap, &
       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
#ifdef ISO
       ,xtprecip_rain, xtprecip_snow,xtspechum, &
       xtsnow, xtsol,xtevap,h1, &
       runoff_diag,xtrunoff_diag,Rland_ice &
#endif           
            )

    USE limit_read_mod
    USE surface_data
    USE fonte_neige_mod
    USE calcul_fluxs_mod
    USE cpl_mod
    USE dimphy
    USE geometry_mod, ONLY: longitude,latitude 
    USE mod_grid_phy_lmdz
    USE mod_phys_lmdz_para
    USE indice_sol_mod
#ifdef ISO
    use infotrac_phy, ONLY: ntiso,niso
    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
        ridicule_qsol
    USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
#ifdef ISOVERIF
    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
        iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
#endif
#endif
!****************************************************************************************
! Bucket calculations for surface. 

    INCLUDE "clesphys.h"
    INCLUDE "dimsoil.h"
    INCLUDE "YOMCST.h"

! Input variables  
!****************************************************************************************
    INTEGER, INTENT(IN)                     :: itime, jour, knon
    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
    LOGICAL, INTENT(IN)                     :: debut
    REAL, INTENT(IN)                        :: dtime
    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
    REAL, DIMENSION(klon), INTENT(IN)       :: pref
    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
#ifdef ISO
    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum    
#endif

! In/Output variables
!****************************************************************************************
    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
#ifdef ISO
    REAL, DIMENSION(niso,klon), INTENT(INOUT)       :: xtsnow,xtsol
#endif

! Output variables
!****************************************************************************************
    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
#ifdef ISO
    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
#endif

! Local variables
!****************************************************************************************
    REAL, DIMENSION(klon) :: soilcap, soilflux
    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
    REAL, DIMENSION(klon) :: alb_neig, alb_lim
    REAL, DIMENSION(klon) :: zfra
    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
    REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow 
    INTEGER               :: i
#ifdef ISO
    INTEGER               :: ixt
    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
    REAL, PARAMETER       :: t_coup = 273.15
    REAL, DIMENSION(klon) :: fq_fonte_diag
    REAL, DIMENSION(klon) :: fqfonte_diag
    REAL, DIMENSION(klon) :: snow_evap_diag 
    REAL, DIMENSION(klon) :: fqcalving_diag 
    REAL                  :: max_eau_sol_diag  
    REAL, DIMENSION(klon) :: run_off_lic_diag 
    REAL :: coeff_rel_diag
#endif 

!****************************************************************************************

#ifdef ISO
#ifdef ISOVERIF
        !write(*,*) 'surf_land_bucket 152'
        DO i=1,knon
          IF (iso_eau > 0) THEN
            CALL iso_verif_egalite_choix(precip_snow(i), &
                                     xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
                                     errmax,errmaxrel)
            CALL iso_verif_egalite_choix(qsol(i), &
                                     xtsol(iso_eau,i),'surf_land_bucket 134', &
                                     errmax,errmaxrel)
          ENDIF
        ENDDO
#endif 
#ifdef ISOVERIF
        DO i=1,knon
          DO ixt=1,niso
            CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
          ENDDO !do ixt=1,niso
        ENDDO !do i=1,knon
        !write(*,*) 'surf_land_bucket 152'
#endif
#endif

!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)

    CALL limit_read_rug_alb(itime, dtime, jour,&
         knon, knindex, &
         z0_new, alb_lim)

!* Calcultaion of fluxes 

! calculate total absorbed radiance at surface
       radsol(:) = 0.0
       radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)

! calculate constants
    CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
    if (type_veget=='betaclim') then
       CALL calbeta_clim(knon,jour,latitude(knindex(1:knon)),beta)
    endif
       
! calculate temperature, heat capacity and conduction flux in soil
    IF (soil_model) THEN
       CALL soil(dtime, is_ter, knon, snow, tsurf, qsol,  & 
   longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)

       DO i=1, knon
          cal(i) = RCPD / soilcap(i)
          radsol(i) = radsol(i)  + soilflux(i)
       END DO
    ELSE 
       cal(:) = RCPD * capsol(:)
       IF (klon_glo == 1) THEN
         cal(:) = 0.
       ENDIF
    ENDIF
    
! Suppose zero surface speed
    u0(:)=0.0
    v0(:)=0.0
    u1_lay(:) = u1(:) - u0(:)
    v1_lay(:) = v1(:) - v0(:)

    CALL calcul_fluxs(knon, is_ter, dtime, &
         tsurf, p1lay, cal, beta, tq_cdrag, tq_cdrag, pref, &
         precip_rain, precip_snow, snow, qsurf,  &
         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
         1.,petAcoef, peqAcoef, petBcoef, peqBcoef, &
         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    
#ifdef ISO
   ! verif
#ifdef ISOVERIF
    !write(*,*) 'surf_land_bucket 211'
    DO i=1,knon
      IF (iso_eau > 0) THEN
        CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
             snow(i),'surf_land_bucket 522', &
             errmax,errmaxrel)
      ENDIF !IF (iso_eau > 0) then
    ENDDO !DO i=1,knon 
#endif
   ! end verif
#endif         
#ifdef ISO
    DO i=1,knon
      snow_prec(i)=snow(i)
      qsol_prec(i)=qsol(i)
      DO ixt=1,niso
        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
        xtsol_prec(ixt,i) =xtsol(ixt,i)
      ENDDO !DO ixt=1,niso
      ! initialisation:
      fqfonte_diag(i)  =0.0
      fq_fonte_diag(i) =0.0
      snow_evap_diag(i)=0.0
    ENDDO !DO i=1,knon 
#ifdef ISOVERIF
    ! write(*,*) 'surf_land_bucket 235'
    DO i=1,knon  
      IF (iso_eau > 0) THEN
        CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
                                'surf_land_bucket 141')
      ENDIF
    ENDDO !DO i=1,knon
#endif    
#endif    

!* Calculate snow height, run_off, age of snow

    CALL fonte_neige( knon, is_ter, knindex, dtime, &
         tsurf, precip_rain, precip_snow, &
         snow, qsol, tsurf_new, evap &
#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
     )

#ifdef ISO
#ifdef ISOVERIF
        DO i=1,knon
          DO ixt=1,niso
            CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
          ENDDO
        ENDDO
#endif
#ifdef ISOVERIF
        !write(*,*) 'surf_land_bucket 235'
        DO i=1,knon
          IF (iso_eau > 0) THEN
            CALL iso_verif_egalite_choix(qsol_prec(i), &
                                     xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
                                     errmax,errmaxrel)
            CALL iso_verif_egalite_choix(precip_snow(i), &
                                     xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
                                     errmax,errmaxrel)
             ! attention, dans fonte_neige, on modifie snow sans modifier
             ! xtsnow
             ! c'est fait plus tard dans gestion_neige
!            write(*,*) 'surf_land_bucket 287: i=',i
!            write(*,*) 'snow(i)=',snow(i)
            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
                                     snow_prec(i),'surf_land_bucket 245', &
                                     errmax,errmaxrel)
          ENDIF  
          IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
              IF (qsol_prec(i) > ridicule_qsol) THEN
                CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) &
                                       ,xtsol_prec(iso_O18,i)/qsol_prec(i) &
                                       ,'surf_land_bucket 642')
              ENDIF !IF ((qsol_prec(i) > ridicule_qsol) &
          ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
        ENDDO  !DO i=1,knon 
        !write(*,*) 'surf_land_mod 291'
        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
#endif          
        CALL calcul_iso_surf_ter_vectall(klon,knon, &
             evap,snow_evap_diag,snow, &
             fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
             precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
             tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
             qsol,xtsol,qsol_prec,xtsol_prec, &
             max_eau_sol_diag, &
             xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
             knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
     )
!#ifdef ISOVERIF
!        write(*,*) 'surf_land_bucket 303'
!#endif
#endif

!* Calculate the age of snow

    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
    
    WHERE (snow(1 : knon) < 0.0001) agesno(1 : knon) = 0.
    
    DO i=1, knon
       zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
       alb_lim(i)  = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i))
    END DO

!* Return albedo : 
!    alb1_new and alb2_new are here given the same values

    alb1_new(:) = 0.0
    alb2_new(:) = 0.0
    alb1_new(1:knon) = alb_lim(1:knon)
    alb2_new(1:knon) = alb_lim(1:knon)

!* Calculate the rugosity

    DO i = 1, knon
       z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
    END DO

!* Send to coupler
!  The run-off from river and coast are not calculated in the bucket modele.
!  For testing purpose of the coupled modele we put the run-off to zero.
    IF (type_ocean=='couple') THEN
       dummy_riverflow(:)   = 0.0
       dummy_coastalflow(:) = 0.0
       CALL cpl_send_land_fields(itime, knon, knindex, &
            dummy_riverflow, dummy_coastalflow)
    ENDIF

!* End

  END SUBROUTINE surf_land_bucket

!****************************************************************************************

END MODULE surf_land_bucket_mod
