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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE UPDATE_RAD_ISBA_n(OFLOOD,HSNOW,PZENITH,PSW_BANDS,PVEG,PLAI,PZ0, &
00003                                PALBNIR,PALBVIS,PALBUV,PEMIS,               &
00004                                PDIR_ALB_WITH_SNOW,PSCA_ALB_WITH_SNOW,PEMIST)  
00005 !     ####################################################################
00006 !
00007 !!****  *UPDATE_RAD_ISBA_n * - Calculate snow/flood fraction, dir/dif albedo
00008 !!                             and emissivity at t+1 in order to close the 
00009 !!                             energy budget between the atmospheric model 
00010 !!                             and surfex  
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    REFERENCE
00019 !!    ---------
00020 !!      
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!     B. Decharme 
00025 !!
00026 !!    MODIFICATIONS
00027 !!    -------------
00028 !!      Original    09/2009
00029 !!------------------------------------------------------------------
00030 !
00031 USE MODD_TYPE_SNOW
00032 !
00033 USE MODD_ISBA_n,    ONLY : NSIZE_NATURE_P,NR_NATURE_P,      &
00034                              NPATCH,XTG,TSNOW,XPSNG,XPSNV_A,  &
00035                              XPSNV,XPSN,XFFLOOD,XFF,XFFG,XFFV,&
00036                              XALBF,XEMISF,XDIR_ALB_WITH_SNOW, &
00037                              XSCA_ALB_WITH_SNOW,XFFROZEN  
00038 !
00039 USE MODD_CSTS,      ONLY : XTT
00040 USE MODD_SURF_PAR,  ONLY : XUNDEF
00041 USE MODD_SNOW_PAR,  ONLY : XRHOSMIN_ES,XRHOSMAX_ES,XSNOWDMIN,XEMISSN
00042 USE MODD_WATER_PAR, ONLY : XALBSCA_WAT, XEMISWAT, XALBWATICE, XEMISWATICE 
00043 !
00044 USE MODE_SURF_FLOOD_FRAC
00045 USE MODE_SURF_SNOW_FRAC      
00046 !
00047 USE MODI_ALBEDO_TA96
00048 USE MODI_ALBEDO_FROM_NIR_VIS
00049 USE MODI_PACK_SAME_RANK
00050 USE MODI_UNPACK_SAME_RANK
00051 USE MODI_ISBA_SNOW_FRAC
00052 !
00053 !
00054 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00055 USE PARKIND1  ,ONLY : JPRB
00056 !
00057 IMPLICIT NONE
00058 !
00059 !*      0.1    declarations of arguments
00060 !
00061 LOGICAL,                INTENT(IN)   :: OFLOOD
00062  CHARACTER(LEN=*),       INTENT(IN)   :: HSNOW
00063 !
00064 REAL, DIMENSION(:),     INTENT(IN)   :: PZENITH   ! Zenithal angle at t+1
00065 REAL, DIMENSION(:),     INTENT(IN)   :: PSW_BANDS ! mean wavelength of each shortwave band (m)
00066 REAL, DIMENSION(:,:),   INTENT(IN)   :: PVEG      ! Vegetation fraction at t+1
00067 REAL, DIMENSION(:,:),   INTENT(IN)   :: PLAI      ! leaf area index at t+1
00068 REAL, DIMENSION(:,:),   INTENT(IN)   :: PZ0       ! roughness length at t+1
00069 REAL, DIMENSION(:,:),   INTENT(IN)   :: PALBNIR   ! near-infra-red albedo (soil+vegetation) at t+1
00070 REAL, DIMENSION(:,:),   INTENT(IN)   :: PALBVIS   ! visible albedo (soil+vegetation) at t+1
00071 REAL, DIMENSION(:,:),   INTENT(IN)   :: PALBUV    ! UV albedo (soil+vegetation) at t+1
00072 REAL, DIMENSION(:,:),   INTENT(IN)   :: PEMIS     ! emissivity (soil+vegetation) at t+1
00073 !
00074 REAL, DIMENSION(:,:,:), INTENT(OUT)  :: PDIR_ALB_WITH_SNOW ! Total direct albedo at t+1
00075 REAL, DIMENSION(:,:,:), INTENT(OUT)  :: PSCA_ALB_WITH_SNOW ! Total diffuse albedo at t+1
00076 REAL, DIMENSION(:,:),   INTENT(OUT)  :: PEMIST             ! Total emissivity at t+1
00077 !
00078 !*      0.2    declarations of local variables
00079 !
00080 INTEGER :: JPATCH, ISWB
00081 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00082 !
00083 !-------------------------------------------------------------------------------------
00084 ! Initialization
00085 !-------------------------------------------------------------------------------------
00086 
00087 IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N',0,ZHOOK_HANDLE)
00088 ISWB   = SIZE(PSW_BANDS)
00089 !
00090 !-------------------------------------------------------------------------------------
00091 !Patch loop
00092 !
00093 DO JPATCH=1,NPATCH
00094   !
00095   IF(NSIZE_NATURE_P(JPATCH)>0) CALL TREAT_NATURE(NSIZE_NATURE_P(JPATCH),JPATCH)
00096   !
00097 ENDDO
00098 !-------------------------------------------------------------------------------
00099 !
00100 !Update albedo with snow for the next time step
00101 !
00102 PDIR_ALB_WITH_SNOW(:,:,:)=XDIR_ALB_WITH_SNOW (:,:,:)
00103 PSCA_ALB_WITH_SNOW(:,:,:)=XSCA_ALB_WITH_SNOW (:,:,:)
00104 !
00105 IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N',1,ZHOOK_HANDLE)
00106 !
00107 CONTAINS
00108 !
00109 SUBROUTINE TREAT_NATURE(KSIZE,KPATCH)
00110 !
00111 IMPLICIT NONE
00112 !
00113 INTEGER, INTENT(IN) :: KSIZE
00114 INTEGER, INTENT(IN) :: KPATCH
00115 !
00116 INTEGER, DIMENSION(KSIZE) :: IMASK
00117 !
00118 REAL, DIMENSION(KSIZE,SIZE(TSNOW%WSNOW,2)) :: ZLAYERSWE
00119 REAL, DIMENSION(KSIZE,SIZE(TSNOW%WSNOW,2)) :: ZLAYERRHO
00120 !
00121 
00122 REAL, DIMENSION(KSIZE,ISWB) :: ZDIR_ALB_WITH_SNOW
00123 REAL, DIMENSION(KSIZE,ISWB) :: ZSCA_ALB_WITH_SNOW
00124 !
00125 REAL, DIMENSION(KSIZE) :: ZSNOWALB          
00126 REAL, DIMENSION(KSIZE) :: ZLAI             
00127 REAL, DIMENSION(KSIZE) :: ZZ0               
00128 REAL, DIMENSION(KSIZE) :: ZVEG
00129 REAL, DIMENSION(KSIZE) :: ZEMIS    
00130 REAL, DIMENSION(KSIZE) :: ZALBNIR           
00131 REAL, DIMENSION(KSIZE) :: ZALBVIS           
00132 REAL, DIMENSION(KSIZE) :: ZALBUV  
00133 !
00134 REAL, DIMENSION(KSIZE) :: ZPSN
00135 REAL, DIMENSION(KSIZE) :: ZPSNV_A
00136 REAL, DIMENSION(KSIZE) :: ZPSNG             
00137 REAL, DIMENSION(KSIZE) :: ZPSNV 
00138 !
00139 REAL, DIMENSION(KSIZE) :: ZALBF_DIR
00140 REAL, DIMENSION(KSIZE) :: ZALBF_SCA
00141 REAL, DIMENSION(KSIZE) :: ZEMISF   
00142 REAL, DIMENSION(KSIZE) :: ZFF   
00143 !
00144 REAL, DIMENSION(KSIZE) :: ZALBNIR_WITH_SNOW
00145 REAL, DIMENSION(KSIZE) :: ZALBVIS_WITH_SNOW
00146 REAL, DIMENSION(KSIZE) :: ZALBUV_WITH_SNOW
00147 !
00148 REAL, DIMENSION(KSIZE) :: ZEMIST    
00149 !
00150 REAL, PARAMETER :: ZPUT0 = 0.0
00151 INTEGER  :: JSWB
00152 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00153 !
00154 IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_NATURE',0,ZHOOK_HANDLE)
00155 !
00156 IMASK(:)=NR_NATURE_P(1:KSIZE,KPATCH)
00157 !
00158  CALL PACK_SAME_RANK(IMASK(:),TSNOW%WSNOW(:,:,KPATCH),ZLAYERSWE(:,:))
00159  CALL PACK_SAME_RANK(IMASK(:),TSNOW%RHO  (:,:,KPATCH),ZLAYERRHO(:,:))
00160 !  
00161  CALL PACK_SAME_RANK(IMASK(:),TSNOW%ALB  (:,KPATCH),ZSNOWALB(:))
00162  CALL PACK_SAME_RANK(IMASK(:),PLAI       (:,KPATCH),ZLAI    (:))
00163  CALL PACK_SAME_RANK(IMASK(:),PZ0        (:,KPATCH),ZZ0     (:))
00164  CALL PACK_SAME_RANK(IMASK(:),PVEG       (:,KPATCH),ZVEG    (:))
00165  CALL PACK_SAME_RANK(IMASK(:),PEMIS      (:,KPATCH),ZEMIS   (:))
00166  CALL PACK_SAME_RANK(IMASK(:),PALBNIR    (:,KPATCH),ZALBNIR (:))
00167  CALL PACK_SAME_RANK(IMASK(:),PALBVIS    (:,KPATCH),ZALBVIS (:))
00168  CALL PACK_SAME_RANK(IMASK(:),PALBUV     (:,KPATCH),ZALBUV  (:))
00169 !   
00170 !-------------------------------------------------------------------------------
00171 !
00172  CALL ISBA_SNOW_FRAC(HSNOW, ZLAYERSWE, ZLAYERRHO, ZSNOWALB,    &
00173          ZVEG, ZLAI, ZZ0,ZPSN(:), ZPSNV_A(:), ZPSNG(:), ZPSNV(:) )  
00174 IF ( HSNOW=='EBA' ) CALL UNPACK_SAME_RANK(IMASK(:),ZPSNV_A(:),XPSNV_A(:,KPATCH),ZPUT0) 
00175 !
00176 !-------------------------------------------------------------------------------
00177 !
00178 ! Flood fractions and properties
00179 !
00180 IF(OFLOOD)THEN   
00181   CALL TREAT_FLOOD(KSIZE,KPATCH,IMASK,ZPSNG,ZPSNV,ZLAI,ZVEG,&
00182                 ZALBF_DIR,ZALBF_SCA,ZEMISF,ZFF)
00183 ELSE
00184   ZALBF_DIR (:)=0.0
00185   ZALBF_SCA (:)=0.0
00186   ZEMISF    (:)=0.0
00187   ZFF       (:)=0.0
00188 ENDIF        
00189 !-------------------------------------------------------------------------------
00190 !
00191 !* albedo for near-infra-red and visible over snow-covered and snow-flood-free surface
00192 !
00193 ZALBNIR_WITH_SNOW(:) = ZALBNIR(:) * (1.-ZPSN(:)-ZFF(:)) + ZSNOWALB (:) * ZPSN(:)   
00194 ZALBVIS_WITH_SNOW(:) = ZALBVIS(:) * (1.-ZPSN(:)-ZFF(:)) + ZSNOWALB (:) * ZPSN(:)  
00195 ZALBUV_WITH_SNOW (:) = ZALBUV (:) * (1.-ZPSN(:)-ZFF(:)) + ZSNOWALB (:) * ZPSN(:)  
00196 !
00197 !* snow-flood-covered surface albedo for each wavelength (needed for outputs)
00198 !
00199  CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,                                              &
00200                          ZALBNIR_WITH_SNOW,  ZALBVIS_WITH_SNOW, ZALBUV_WITH_SNOW,&
00201                          ZDIR_ALB_WITH_SNOW, ZSCA_ALB_WITH_SNOW                  )  
00202 !
00203 DO JSWB=1,ISWB
00204   ZDIR_ALB_WITH_SNOW(:,JSWB)=ZDIR_ALB_WITH_SNOW(:,JSWB) + ZFF(:)*ZALBF_DIR(:)
00205   ZSCA_ALB_WITH_SNOW(:,JSWB)=ZSCA_ALB_WITH_SNOW(:,JSWB) + ZFF(:)*ZALBF_SCA(:)
00206 ENDDO
00207 !
00208 !-------------------------------------------------------------------------------
00209 !
00210 ! longwave computations for outputs (emissivity for radiative scheme)
00211 !
00212 ZEMIST(:) = (1.-ZPSN(:)-ZFF(:))*ZEMIS(:) + ZPSN(:) * XEMISSN + ZFF(:)*ZEMISF(:)
00213 !
00214 !-------------------------------------------------------------------------------
00215 !
00216 ! Unpack variable
00217 !
00218  CALL UNPACK_SAME_RANK(IMASK(:),ZPSNG (:),XPSNG  (:,KPATCH),ZPUT0)     
00219  CALL UNPACK_SAME_RANK(IMASK(:),ZPSNV (:),XPSNV  (:,KPATCH),ZPUT0)     
00220  CALL UNPACK_SAME_RANK(IMASK(:),ZPSN  (:),XPSN   (:,KPATCH),ZPUT0)  
00221  CALL UNPACK_SAME_RANK(IMASK(:),ZEMIST(:),PEMIST (:,KPATCH),ZPUT0)  
00222  CALL UNPACK_SAME_RANK(IMASK(:),ZDIR_ALB_WITH_SNOW (:,:),XDIR_ALB_WITH_SNOW (:,:,KPATCH),ZPUT0)  
00223  CALL UNPACK_SAME_RANK(IMASK(:),ZSCA_ALB_WITH_SNOW (:,:),XSCA_ALB_WITH_SNOW (:,:,KPATCH),ZPUT0)
00224 !
00225 !-------------------------------------------------------------------------------
00226 IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_NATURE',1,ZHOOK_HANDLE)
00227 !
00228 END SUBROUTINE TREAT_NATURE
00229 !
00230 SUBROUTINE TREAT_FLOOD(KSIZE,KPATCH,KMASK,PPSNG,PPSNV,PLAI,PVEG,&
00231                PALBF_DIR,PALBF_SCA,PEMISF,PFF)
00232 !
00233 IMPLICIT NONE
00234 !
00235 INTEGER, INTENT(IN) :: KSIZE
00236 INTEGER, INTENT(IN) :: KPATCH
00237 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00238 REAL, DIMENSION(:),  INTENT(IN) :: PPSNG             
00239 REAL, DIMENSION(:),  INTENT(IN) :: PPSNV 
00240 REAL, DIMENSION(:),  INTENT(IN) :: PLAI
00241 REAL, DIMENSION(:),  INTENT(IN) :: PVEG
00242 REAL, DIMENSION(:), INTENT(OUT) :: PALBF_DIR
00243 REAL, DIMENSION(:), INTENT(OUT) :: PALBF_SCA
00244 REAL, DIMENSION(:), INTENT(OUT) :: PEMISF   
00245 REAL, DIMENSION(:), INTENT(OUT) :: PFF  
00246 !
00247 REAL, DIMENSION(KSIZE) :: ZTG
00248 REAL, DIMENSION(KSIZE) :: ZZENITH
00249 REAL, DIMENSION(KSIZE) :: ZFFLOOD
00250 REAL, DIMENSION(KSIZE) :: ZFFG   
00251 REAL, DIMENSION(KSIZE) :: ZFFV
00252 REAL, DIMENSION(KSIZE) :: ZALBF
00253 REAL, DIMENSION(KSIZE) :: ZFFROZEN
00254 REAL, DIMENSION(KSIZE) :: ZALBEDO
00255 !
00256 REAL, PARAMETER :: ZPUT0 = 0.0
00257 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00258 !
00259 IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_FLOOD',0,ZHOOK_HANDLE)
00260 !
00261  CALL PACK_SAME_RANK(KMASK(:),XTG(:,1,KPATCH),ZTG(:))
00262 !
00263  CALL PACK_SAME_RANK(KMASK(:),PZENITH(:),ZZENITH (:))
00264  CALL PACK_SAME_RANK(KMASK(:),XFFLOOD(:),ZFFLOOD (:))
00265 !      
00266 ZFFG(:) = FLOOD_FRAC_GROUND(PPSNG,ZFFLOOD)
00267 ZFFV(:) = FLOOD_FRAC_VEG(PLAI,PPSNV,ZFFLOOD)
00268 PFF (:) = FLOOD_FRAC_NAT(PVEG,ZFFG,ZFFV,ZFFLOOD)
00269 !
00270 ZALBEDO(:) = ALBEDO_TA96(ZZENITH(:))
00271 WHERE(ZFFLOOD==0.0)
00272   PALBF_DIR (:) = XUNDEF
00273   PALBF_SCA (:) = XUNDEF
00274   ZALBF     (:) = XUNDEF
00275   PEMISF    (:) = XUNDEF
00276   ZFFROZEN  (:) = 0.0
00277 ELSEWHERE
00278   WHERE(ZTG(:)>=XTT)
00279     PALBF_DIR (:) = ZALBEDO(:)
00280     PALBF_SCA (:) = XALBSCA_WAT
00281     PEMISF    (:) = XEMISWAT
00282     ZFFROZEN  (:) = 0.0
00283   ELSEWHERE
00284     PALBF_DIR (:) = XALBWATICE
00285     PALBF_SCA (:) = XALBWATICE
00286     PEMISF    (:) = XEMISWATICE
00287     ZFFROZEN  (:) = 1.0
00288   END WHERE
00289   ZALBF(:)=0.5*(PALBF_DIR(:)+PALBF_SCA(:))
00290 ENDWHERE
00291 !
00292  CALL UNPACK_SAME_RANK(KMASK(:),ZFFG    (:),XFFG    (:,KPATCH),ZPUT0)     
00293  CALL UNPACK_SAME_RANK(KMASK(:),ZFFV    (:),XFFV    (:,KPATCH),ZPUT0)     
00294  CALL UNPACK_SAME_RANK(KMASK(:),ZFFROZEN(:),XFFROZEN(:,KPATCH),ZPUT0)     
00295  CALL UNPACK_SAME_RANK(KMASK(:),PFF     (:),XFF     (:,KPATCH),ZPUT0) 
00296  CALL UNPACK_SAME_RANK(KMASK(:),PEMISF  (:),XEMISF  (:,KPATCH),XUNDEF)
00297  CALL UNPACK_SAME_RANK(KMASK(:),ZALBF   (:),XALBF   (:,KPATCH),XUNDEF)     
00298 !
00299 IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_FLOOD',1,ZHOOK_HANDLE)
00300 !
00301 END SUBROUTINE TREAT_FLOOD
00302 !
00303 END SUBROUTINE UPDATE_RAD_ISBA_n