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

Go to the documentation of this file.
00001 !     #################################################################################
00002 SUBROUTINE UPDATE_ESM_SURF_ATM_n(HPROGRAM, KI, KSW, PZENITH, PSW_BANDS,   &
00003                                    PTRAD, PDIR_ALB, PSCA_ALB, PEMIS         )  
00004 !     #################################################################################
00005 !
00006 !!****  *UPDATE_ESM_SURF_ATM_n * - Routine to update radiative properties in Earth
00007 !!                                 System Model (SEA, WATER, NATURE, TOWN) after
00008 !!                                 the call to OASIS coupler in order to close the
00009 !!                                 energy budget between radiative scheme and surfex
00010 !!
00011 !!    PURPOSE
00012 !!    -------
00013 !
00014 !!**  METHOD
00015 !!    ------
00016 !!
00017 !!    REFERENCE
00018 !!    ---------
00019 !!      
00020 !!
00021 !!    AUTHOR
00022 !!    ------
00023 !!     B. Decharme 
00024 !!
00025 !!    MODIFICATIONS
00026 !!    -------------
00027 !!      Original    09/2009
00028 !!-------------------------------------------------------------
00029 !
00030 USE MODD_SURF_PAR,       ONLY : XUNDEF
00031 USE MODD_SURF_ATM_n,     ONLY : NSIZE_SEA, NSIZE_WATER, NSIZE_TOWN, NSIZE_NATURE, &
00032                                   NR_SEA,    NR_WATER,    NR_TOWN,    NR_NATURE,    &
00033                                   XSEA,      XWATER,      XTOWN,      XNATURE,      &
00034                                   CSEA,      CWATER,      CTOWN,      CNATURE  
00035 !
00036 USE MODD_ISBA_n,         ONLY : LFLOOD
00037 !
00038 USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
00039 !
00040 USE MODI_AVERAGE_RAD
00041 !
00042 !
00043 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00044 USE PARKIND1  ,ONLY : JPRB
00045 !
00046 USE MODI_ABOR1_SFX
00047 !
00048 USE MODI_UPDATE_ESM_ISBA_n
00049 !
00050 USE MODI_UPDATE_ESM_SEAFLUX_n
00051 !
00052 USE MODI_UPDATE_ESM_WATFLUX_n
00053 !
00054 IMPLICIT NONE
00055 !
00056 !*      0.1    declarations of arguments
00057 !
00058  CHARACTER(LEN=6),       INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00059 INTEGER,                INTENT(IN)  :: KI        ! number of points
00060 INTEGER,                INTENT(IN)  :: KSW       ! number of short-wave spectral bands
00061 REAL, DIMENSION(KI),     INTENT(IN) :: PZENITH   ! zenithal angle       (radian from the vertical)
00062 REAL, DIMENSION(KSW),    INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
00063 !
00064 REAL, DIMENSION(KI),    INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
00065 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB  ! direct albedo for each spectral band  (-)
00066 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo for each spectral band (-)
00067 REAL, DIMENSION(KI),    INTENT(OUT) :: PEMIS     ! emissivity                            (-)
00068 !
00069 !*      0.2    declarations of local variables
00070 !
00071 INTEGER :: JTILE                        ! loop on type of surface
00072 LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented
00073 !
00074 ! Tile outputs:
00075 !
00076 REAL, DIMENSION(KI,NTILESFC) :: ZTRAD_TILE     ! radiative surface temperature
00077 REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE     ! emissivity
00078 REAL, DIMENSION(KI,NTILESFC) :: ZFRAC_TILE     ! fraction of each surface type
00079 !
00080 REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo
00081 REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo
00082 !
00083 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00084 !-------------------------------------------------------------------------------------
00085 ! Preliminaries: Tile related operations
00086 !-------------------------------------------------------------------------------------
00087 ! FLAGS for the various surfaces:
00088 !
00089 IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N',0,ZHOOK_HANDLE)
00090 GSEA      = (NSIZE_SEA    >0 .AND. CSEA/='NONE')
00091 GWATER    = (NSIZE_WATER  >0 .AND. CWATER/='NONE')
00092 GNATURE   = (NSIZE_NATURE >0 .AND. CNATURE/='NONE')
00093 !
00094 GTOWN     = NSIZE_TOWN   >0
00095 IF(GTOWN)THEN
00096   CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TOWN SCHEME NOT YET AVAILABLE FOR EARTH SYSTEM MODEL')
00097 ENDIF
00098 !
00099 ! Tile counter:
00100 !
00101 JTILE     = 0 
00102 !
00103 ! Initialization: Outputs to atmosphere over each tile:
00104 !
00105 ZTRAD_TILE(:,:)       = XUNDEF
00106 ZDIR_ALB_TILE(:,:,:)  = XUNDEF
00107 ZSCA_ALB_TILE(:,:,:)  = XUNDEF
00108 ZEMIS_TILE(:,:)       = XUNDEF
00109 !
00110 ! Fractions for each tile:
00111 !
00112 ZFRAC_TILE(:,:)    = 0.0
00113 !
00114 !--------------------------------------------------------------------------------------
00115 ! Call arrange interfaces for sea, water, nature and town here...
00116 !--------------------------------------------------------------------------------------
00117 !
00118 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00119 ! SEA Tile calculations:
00120 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00121 !
00122 JTILE = JTILE + 1
00123 !
00124 IF(GSEA)THEN
00125 !
00126    ZFRAC_TILE(:,JTILE) = XSEA(:)
00127 !
00128    CALL TREAT_SURF(NSIZE_SEA,NR_SEA,JTILE)   ! pack variables which are arguments to this routine
00129 !
00130 ENDIF
00131 !
00132 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00133 ! INLAND WATER Tile calculations:
00134 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00135 !
00136 JTILE = JTILE + 1
00137 !
00138 IF(GWATER)THEN
00139 !
00140    ZFRAC_TILE(:,JTILE) = XWATER(:)
00141 !
00142    CALL TREAT_SURF(NSIZE_WATER,NR_WATER,JTILE)  
00143 !
00144 ENDIF 
00145 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00146 ! NATURAL SURFACE Tile calculations:
00147 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00148 !
00149 JTILE = JTILE + 1
00150 !
00151 IF(GNATURE)THEN
00152 !
00153    ZFRAC_TILE(:,JTILE) = XNATURE(:)
00154 !
00155    CALL TREAT_SURF(NSIZE_NATURE,NR_NATURE,JTILE)
00156 !   
00157 ENDIF 
00158 !
00159 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00160 ! URBAN Tile calculations:
00161 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00162 ! Not yet implemented
00163 !
00164 !JTILE = JTILE + 1
00165 !
00166 !IF(GTOWN)THEN
00167 !
00168 !   ZFRAC_TILE(:,JTILE) = XTOWN(:)
00169 !
00170 !   CALL TREAT_SURF(NSIZE_TOWN,NR_TOWN,JTILE)  
00171 !
00172 !ENDIF 
00173 !
00174 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00175 ! Grid box average radiative properties:
00176 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00177 !
00178  CALL AVERAGE_RAD(ZFRAC_TILE,                                           &
00179                    ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTRAD_TILE, &
00180                    PDIR_ALB,      PSCA_ALB,      PEMIS,      PTRAD       )  
00181 !
00182 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00183 !
00184 IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N',1,ZHOOK_HANDLE)
00185 CONTAINS
00186 !=======================================================================================
00187 SUBROUTINE TREAT_SURF(KSIZE,KMASK,KTILE)
00188 !
00189 INTEGER, INTENT(IN)               :: KSIZE
00190 INTEGER, INTENT(IN), DIMENSION(:) :: KMASK
00191 INTEGER, INTENT(IN)               :: KTILE
00192 !
00193 REAL, DIMENSION(KSIZE) :: ZP_ZENITH   ! zenithal angle       (radian from the vertical)
00194 !
00195 REAL, DIMENSION(KSIZE)     :: ZP_TRAD     ! radiative temperature                 (K)
00196 REAL, DIMENSION(KSIZE,KSW) :: ZP_DIR_ALB  ! direct albedo for each spectral band  (-)
00197 REAL, DIMENSION(KSIZE,KSW) :: ZP_SCA_ALB  ! diffuse albedo for each spectral band (-)
00198 REAL, DIMENSION(KSIZE)     :: ZP_EMIS     ! emissivity
00199 !
00200 INTEGER :: JJ
00201 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00202 !
00203 ! input arguments:
00204 !
00205 IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N:TREAT_SURF',0,ZHOOK_HANDLE)
00206 !
00207 ZP_TRAD    = XUNDEF
00208 ZP_DIR_ALB = XUNDEF
00209 ZP_SCA_ALB = XUNDEF
00210 ZP_EMIS    = XUNDEF
00211 !
00212 DO JJ=1,KSIZE
00213   ZP_ZENITH(JJ)     = PZENITH     (KMASK(JJ))
00214 ENDDO
00215 !
00216 !
00217 IF (KTILE==1) THEN
00218   !
00219   IF (CSEA=='SEAFLX') THEN
00220     CALL UPDATE_ESM_SEAFLUX_n(HPROGRAM,NSIZE_SEA,KSW,ZP_ZENITH,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TRAD)
00221   ELSE
00222     CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: SEA SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
00223   ENDIF
00224   !
00225 ELSEIF (KTILE==2) THEN
00226   !
00227   IF (CWATER=='WATFLX') THEN   
00228     CALL UPDATE_ESM_WATFLUX_n(HPROGRAM,NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TRAD)
00229   ELSEIF (CWATER=='FLAKE ') THEN
00230     CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: FLAKE SCHEME NOT YET AVAILABLE FOR EARTH SYSTEM MODEL')
00231   ELSE
00232     CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: SEA SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
00233   ENDIF
00234   !
00235 ELSEIF (KTILE==3) THEN
00236   !          
00237   IF (CNATURE=='ISBA') THEN   
00238     CALL UPDATE_ESM_ISBA_n(HPROGRAM,NSIZE_NATURE,KSW,ZP_ZENITH,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TRAD)
00239   ELSE
00240     CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: NATURE SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
00241   ENDIF
00242   !
00243 !ELSEIF (KTILE==4) THEN
00244 !  !
00245 !  IF (CTOWN=='TEB   ') THEN   
00246 !    CALL UPDATE_ESM_TEB_n(HPROGRAM,NSIZE_SEA,KSW,ZP_ZENITH,ZP_TRAD,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS)
00247 !  ELSE
00248 !    CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TEB SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
00249 !  ENDIF
00250 !  !        
00251 ENDIF
00252 !
00253 DO JJ=1,KSIZE
00254    ZTRAD_TILE      (KMASK(JJ),KTILE)  = ZP_TRAD      (JJ)
00255    ZDIR_ALB_TILE   (KMASK(JJ),:,KTILE)= ZP_DIR_ALB   (JJ,:)
00256    ZSCA_ALB_TILE   (KMASK(JJ),:,KTILE)= ZP_SCA_ALB   (JJ,:)
00257    ZEMIS_TILE      (KMASK(JJ),KTILE)  = ZP_EMIS      (JJ)
00258 ENDDO
00259 !
00260 IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N:TREAT_SURF',1,ZHOOK_HANDLE)
00261 !
00262 END SUBROUTINE TREAT_SURF
00263 !=======================================================================================
00264 !
00265 END SUBROUTINE UPDATE_ESM_SURF_ATM_n
00266 
00267