Changeset 888 for LMDZ4/trunk/libf/phylmd/surf_land_mod.F90

Timestamp:

Feb 4, 2008, 5:24:28 PM (17 years ago)

Author:

Laurent Fairhead

Message:

Modifications sur l'albedo JG
LF

File:

• LMDZ4/trunk/libf/phylmd/surf_land_mod.F90 (modified) (8 diffs)

LMDZ4/trunk/libf/phylmd/surf_land_mod.F90

@@ -20 +20 @@
   SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
        rlon, rlat, &
-       debut, lafin, zlev, epot_air, ccanopy, sollwdown, swnet, swdown, &
+       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
        tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
        petAcoef, peqAcoef, petBcoef, peqBcoef, &
-       ps, u1_lay, v1_lay, rugoro, pctsrf, &
-       radsol, snow, qsurf, qsol, agesno, &
-       tsoil, z0_new, alblw, evap, fluxsens, fluxlat, &
-       tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_ter)
+       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, pctsrf_ter, &
+       lwdown_m)
 
     INCLUDE "indicesol.h"
     INCLUDE "dimsoil.h"
+    INCLUDE "YOMCST.h"
 
 ! Input variables  
@@ -39 +41 @@
     LOGICAL, INTENT(IN)                     :: debut, lafin
     REAL, INTENT(IN)                        :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, epot_air, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)       :: sollwdown, swnet, swdown    
+    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
@@ -48 +51 @@
     REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
     REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)       :: ps
+    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)          :: radsol
     REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
     REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
@@ -62 +67 @@
 ! 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)       :: z0_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: alblw
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new, alb_new
+    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
     REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_ter
@@ -72 +79 @@
 ! Local variables
 !****************************************************************************************
-    REAL, DIMENSION(klon) :: ps_tmp, p1lay_tmp
+    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
@@ -83 +94 @@
    IF (ok_veget) THEN
 !****************************************************************************************
-!  Call model sechiba
+!  Call model sechiba in model ORCHIDEE
 !
 !****************************************************************************************
        p1lay_tmp(:)      = 0.0
-       ps_tmp(:)         = 0.0
+       pref_tmp(:)       = 0.0
        p1lay_tmp(1:knon) = p1lay(1:knon)/100.
-       ps_tmp(1:knon)    = ps(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, &
@@ -97 +125 @@
             zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, & 
             tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-            precip_rain, precip_snow, sollwdown, swnet, swdown, &
-            ps_tmp, &
+            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
+            pref_tmp, &
             evap, fluxsens, fluxlat, &              
-            tsol_rad, tsurf_new, alb_new, alblw, &
+            tsol_rad, tsurf_new, alb1_new, alb2_new, &
             emis_new, z0_new, qsurf)       
 #endif
 
 !  
-!* Ajout de la contribution du relief
+!* Add contribution of relief to surface roughness
 !  
        DO i=1,knon
@@ -118 +146 @@
        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, ps, &
-            u1_lay, v1_lay, rugoro, &
-            radsol, snow, qsol, agesno, tsoil, &
-            qsurf, z0_new, alblw, evap, fluxsens, fluxlat, &
-            tsurf_new, alb_new, dflux_s, dflux_l)
+            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