SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/update_esm

Go to the documentation of this file.
00001 !     ##############################################################################################
00002       SUBROUTINE UPDATE_ESM_ISBA_n(HPROGRAM,KI,KSW,PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD)
00003 !     ##############################################################################################
00004 !
00005 !!****  *UPDATE_ESM_ISBA_n* - update ISBA radiative properties in Earth System Model 
00006 !!                            after the call to OASIS coupler in order 
00007 !!                            to close the energy budget between radiative scheme and surfex
00008 !!
00009 !!
00010 !!    PURPOSE
00011 !!    -------
00012 !!
00013 !!**  METHOD
00014 !!    ------
00015 !!
00016 !!    EXTERNAL
00017 !!    --------
00018 !!
00019 !!
00020 !!    IMPLICIT ARGUMENTS
00021 !!    ------------------
00022 !!
00023 !!    REFERENCE
00024 !!    ---------
00025 !!
00026 !!
00027 !!    AUTHOR
00028 !!    ------
00029 !!     B. Decharme 
00030 !!
00031 !!    MODIFICATIONS
00032 !!    -------------
00033 !!      Original    09/2009
00034 !-------------------------------------------------------------------------------
00035 !
00036 !*       0.    DECLARATIONS
00037 !              ------------
00038 !
00039 USE MODD_TYPE_SNOW
00040 USE MODD_SURF_PAR, ONLY : XUNDEF
00041 USE MODD_ISBA_n,   ONLY : NPATCH,XTG,TSNOW,XPSN,XVEG,XLAI,XZ0, &
00042                             XALBNIR,XALBVIS,XALBUV,XEMIS,XPATCH, &
00043                             LFLOOD,XFF,XEMISF,XEMIS_NAT,XTSRAD_NAT  
00044 !
00045 USE MODI_AVERAGE_RAD
00046 USE MODI_UPDATE_RAD_ISBA_n
00047 !
00048 !
00049 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00050 USE PARKIND1  ,ONLY : JPRB
00051 !
00052 IMPLICIT NONE
00053 !
00054 !*       0.1   Declarations of arguments
00055 !              -------------------------
00056 !
00057  CHARACTER(LEN=6),                   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00058 INTEGER,                            INTENT(IN)  :: KI        ! number of points
00059 INTEGER,                            INTENT(IN)  :: KSW       ! number of short-wave spectral bands
00060 !
00061 REAL,             DIMENSION(KI),    INTENT(IN)  :: PZENITH   ! solar zenithal angle
00062 REAL,             DIMENSION(KSW),   INTENT(IN)  :: PSW_BANDS ! short-wave spectral bands
00063 !
00064 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB  ! direct albedo for each band
00065 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo for each band
00066 REAL,             DIMENSION(KI),    INTENT(OUT) :: PEMIS     ! emissivity
00067 REAL,             DIMENSION(KI),    INTENT(OUT) :: PTSRAD    ! radiative temperature
00068 !
00069 !
00070 !*       0.2   Declarations of local variables
00071 !              -------------------------------
00072 !
00073 REAL, DIMENSION(KI,KSW,NPATCH) :: ZDIR_ALB_PATCH
00074 REAL, DIMENSION(KI,KSW,NPATCH) :: ZSCA_ALB_PATCH
00075 REAL, DIMENSION(KI,NPATCH)     :: ZEMIS_PATCH
00076 REAL, DIMENSION(KI,NPATCH)     :: ZTRAD_PATCH
00077 REAL, DIMENSION(KI)            :: ZEMIS     ! emissivity
00078 !
00079 INTEGER           :: JPATCH ! loop on patches
00080 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00081 !
00082 !-------------------------------------------------------------------------------
00083 !
00084 !*       1.     Defaults
00085 !               --------
00086 !
00087 IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_ISBA_N',0,ZHOOK_HANDLE)
00088 !
00089 ZDIR_ALB_PATCH = 0.0
00090 ZSCA_ALB_PATCH = 0.0
00091 ZEMIS_PATCH    = 0.0
00092 ZTRAD_PATCH    = 0.0
00093 !
00094 !*       2.     Update nature albedo and emissivity
00095 !               -----------------------------------
00096 !
00097  CALL UPDATE_RAD_ISBA_n(LFLOOD,TSNOW%SCHEME,PZENITH,PSW_BANDS,XVEG,XLAI,&
00098                          XZ0,XALBNIR,XALBVIS,XALBUV,XEMIS,             &
00099                          ZDIR_ALB_PATCH,ZSCA_ALB_PATCH,ZEMIS_PATCH     )  
00100 !
00101 !*       3.     radiative surface temperature
00102 !               -----------------------------
00103 !
00104 DO JPATCH=1,NPATCH
00105 !
00106    ZEMIS(:) = XEMIS(:,JPATCH)
00107 !   
00108    IF(LFLOOD.AND.(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO'))THEN
00109      WHERE(XPSN(:,JPATCH)<1.0.AND.XEMIS(:,JPATCH)/=XUNDEF)          
00110           ZEMIS(:) = ((1.-XFF(:,JPATCH)-XPSN(:,JPATCH))*XEMIS(:,JPATCH) + XFF(:,JPATCH)*XEMISF(:,JPATCH))/(1.-XPSN(:,JPATCH))
00111      ENDWHERE   
00112   ENDIF
00113 !
00114   IF (TSNOW%SCHEME=='D95' .OR. TSNOW%SCHEME=='EBA') THEN
00115     ZTRAD_PATCH(:,JPATCH) = XTG(:,1,JPATCH)
00116   ELSE IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
00117     WHERE (XEMIS(:,JPATCH)/=XUNDEF)
00118       ZTRAD_PATCH(:,JPATCH) =( ( (1.-XPSN(:,JPATCH))*ZEMIS     (:)       *XTG     (:,1,JPATCH)**4          &
00119                                   +    XPSN(:,JPATCH) *TSNOW%EMIS(:,JPATCH)*TSNOW%TS(:,JPATCH)**4 ) )**0.25  &
00120                                / ZEMIS_PATCH(:,JPATCH)**0.25  
00121     END WHERE
00122   END IF
00123 END DO
00124 !
00125 !
00126 !*       4.     averaged fields
00127 !               ---------------
00128 !
00129  CALL AVERAGE_RAD(XPATCH,                                                   &
00130                    ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, ZTRAD_PATCH, &
00131                    PDIR_ALB,       PSCA_ALB,       XEMIS_NAT,   XTSRAD_NAT   )  
00132 !
00133 PEMIS = XEMIS_NAT
00134 PTSRAD = XTSRAD_NAT
00135 !
00136 IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_ISBA_N',1,ZHOOK_HANDLE)
00137 !
00138 !-------------------------------------------------------------------------------
00139 !
00140 END SUBROUTINE UPDATE_ESM_ISBA_n