! ! $Header$ ! MODULE surf_land_mod USE surface_data, ONLY : ok_veget USE dimphy #ifdef CPP_VEGET USE surf_land_orchidee_mod #endif USE surf_land_bucket_mod IMPLICIT NONE CONTAINS ! !**************************************************************************************** ! SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, & rlon, rlat, & debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, & tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & petAcoef, peqAcoef, petBcoef, peqBcoef, & pref, u1_lay, v1_lay, rugoro, pctsrf, & snow, qsol, agesno, tsoil, & z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, & qsurf, tsurf_new, dflux_s, dflux_l, & lwdown_m) INCLUDE "indicesol.h" INCLUDE "dimsoil.h" INCLUDE "YOMCST.h" ! Input variables !**************************************************************************************** INTEGER, INTENT(IN) :: itime, jour, knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex REAL, INTENT(IN) :: date0 REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat LOGICAL, INTENT(IN) :: debut, lafin REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: zlev, ccanopy REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet REAL, DIMENSION(klon), INTENT(IN) :: albedo ! albedo for whole short-wave interval 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 ! pressure reference REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay REAL, DIMENSION(klon), INTENT(IN) :: rugoro REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downwelling longwave radiation at mean surface ! corresponds to previous sollwdown ! In/Output variables !**************************************************************************************** REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol REAL, DIMENSION(klon), INTENT(INOUT) :: agesno REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil ! Output variables !**************************************************************************************** REAL, DIMENSION(klon), INTENT(OUT) :: z0_new REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! albdeo for shortwave interval 1(visible) REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! albedo for shortwave interval 2(near infrared) REAL, DIMENSION(klon), INTENT(OUT) :: evap REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens, fluxlat REAL, DIMENSION(klon), INTENT(OUT) :: qsurf REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l ! Local variables !**************************************************************************************** REAL, DIMENSION(klon) :: p1lay_tmp REAL, DIMENSION(klon) :: pref_tmp REAL, DIMENSION(klon) :: swdown ! downwelling shortwave radiation at land surface REAL, DIMENSION(klon) :: lwdown ! downwelling longwave radiation at land surface REAL, DIMENSION(klon) :: epot_air ! potential air temperature REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used INTEGER :: i !**************************************************************************************** ! Choice between call to vegetation model (ok_veget=true) or simple calculation below ! !**************************************************************************************** IF (ok_veget) THEN !**************************************************************************************** ! Call model sechiba in model ORCHIDEE ! !**************************************************************************************** p1lay_tmp(:) = 0.0 pref_tmp(:) = 0.0 p1lay_tmp(1:knon) = p1lay(1:knon)/100. pref_tmp(1:knon) = pref(1:knon)/100. ! !* Calculate incoming flux for SW and LW interval: swdown, lwdown ! swdown(:) = 0.0 lwdown(:) = 0.0 DO i = 1, knon swdown(i) = swnet(i)/(1-albedo(i)) lwdown(i) = lwnet(i) + RSIGMA*tsurf(i)**4 END DO ! !* Calculate potential air temperature ! epot_air(:) = 0.0 DO i = 1, knon epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA END DO #ifdef CPP_VEGET ! temporary for keeping same results using lwdown_m instead of lwdown CALL surf_land_orchidee(itime, dtime, date0, knon, & knindex, rlon, rlat, pctsrf, & debut, lafin, & zlev, u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & precip_rain, precip_snow, lwdown_m, swnet, swdown, & pref_tmp, & evap, fluxsens, fluxlat, & tsol_rad, tsurf_new, alb1_new, alb2_new, & emis_new, z0_new, qsurf) #endif ! !* Add contribution of relief to surface roughness ! DO i=1,knon z0_new(i) = SQRT(z0_new(i)**2 + rugoro(i)**2) ENDDO ELSE ! not ok_veget !**************************************************************************************** ! No extern vegetation model choosen, call simple bucket calculations instead. ! !**************************************************************************************** CALL 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_lay, v1_lay, rugoro, swnet, lwnet, & snow, qsol, agesno, tsoil, & qsurf, z0_new, alb1_new, alb2_new, evap, & fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l) ENDIF ! ok_veget END SUBROUTINE surf_land ! !**************************************************************************************** ! END MODULE surf_land_mod ! !**************************************************************************************** !