|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE AVERAGE_RAD(PFRAC_TILE, & 00003 PDIR_ALB_TILE, PSCA_ALB_TILE, PEMIS_TILE, PTRAD_TILE, & 00004 PDIR_ALB, PSCA_ALB, PEMIS, PTRAD ) 00005 ! ################################################################# 00006 ! 00007 ! 00008 !!**** *AVERAGE_RAD* 00009 !! 00010 !! PURPOSE 00011 !! ------- 00012 ! Average the radiative fluxes from the land and water surfaces depending on the 00013 ! fraction of each surface cover type in the mesh area. 00014 ! 00015 !!** METHOD 00016 !! ------ 00017 ! 00018 !! EXTERNAL 00019 !! -------- 00020 !! 00021 !! IMPLICIT ARGUMENTS 00022 !! ------------------ 00023 !! 00024 !! 00025 !! REFERENCE 00026 !! --------- 00027 !! 00028 !! AUTHOR 00029 !! ------ 00030 !! S. Belair * Meteo-France * 00031 !! 00032 !! MODIFICATIONS 00033 !! ------------- 00034 !! Original 10/03/95 00035 !! V.Masson 20/03/96 remove abnormal averages and average TS**4 instead 00036 !! of TS 00037 !! (J.Stein) 27/03/96 use only H and LE in the soil scheme 00038 !! A. Boone 27/11/02 revised to output ALMA variables, and general applications 00039 !------------------------------------------------------------------------------- 00040 ! 00041 !* 0. DECLARATIONS 00042 ! ------------ 00043 ! 00044 ! 00045 ! 00046 ! 00047 ! 00048 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00049 USE PARKIND1 ,ONLY : JPRB 00050 ! 00051 IMPLICIT NONE 00052 ! 00053 !* 0.1 declarations of arguments 00054 ! 00055 ! 00056 !* 0.1 declarations of arguments 00057 ! 00058 REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_TILE ! Fraction in a mesh-area of 00059 ! ! a given surface 00060 REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS_TILE ! emissivity 00061 REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIR_ALB_TILE ! direct albedo 00062 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSCA_ALB_TILE ! diffuse albedo 00063 REAL, DIMENSION(:,:), INTENT(IN) :: PTRAD_TILE ! surface radiative temp. 00064 REAL, DIMENSION(:), INTENT(OUT):: PEMIS ! emissivity 00065 REAL, DIMENSION(:,:), INTENT(OUT):: PDIR_ALB ! direct albedo 00066 REAL, DIMENSION(:,:), INTENT(OUT):: PSCA_ALB ! diffuse albedo 00067 REAL, DIMENSION(:), INTENT(OUT):: PTRAD ! surface radiative temp. 00068 ! 00069 ! 00070 !* 0.2 declarations of local variables 00071 ! 00072 INTEGER :: JSWB ! loop counter on number of SW spectral bands 00073 INTEGER :: JTILE! loop counter on tiles 00074 REAL, PARAMETER :: ZEPS = 1.E-10 00075 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00076 !------------------------------------------------------------------------------- 00077 ! 00078 ! 1. Grid-Box average surface temperatures, radiative properties 00079 ! ----------------------------------------------------------- 00080 ! 00081 ! albedo: 00082 ! 00083 IF (LHOOK) CALL DR_HOOK('AVERAGE_RAD',0,ZHOOK_HANDLE) 00084 PDIR_ALB (:,:) = 0. 00085 PSCA_ALB (:,:) = 0. 00086 ! 00087 DO JSWB = 1,SIZE(PDIR_ALB_TILE,2) 00088 DO JTILE = 1,SIZE(PDIR_ALB_TILE,3) 00089 PDIR_ALB(:,JSWB) = PDIR_ALB(:,JSWB) + PFRAC_TILE(:,JTILE) * PDIR_ALB_TILE(:,JSWB,JTILE) 00090 PSCA_ALB(:,JSWB) = PSCA_ALB(:,JSWB) + PFRAC_TILE(:,JTILE) * PSCA_ALB_TILE(:,JSWB,JTILE) 00091 END DO 00092 END DO 00093 ! 00094 ! emissivity 00095 ! 00096 PEMIS (:) = 0. 00097 ! 00098 DO JTILE = 1,SIZE(PEMIS_TILE,2) 00099 PEMIS(:) = PEMIS(:) + PFRAC_TILE(:,JTILE) * PEMIS_TILE(:,JTILE) 00100 END DO 00101 ! 00102 ! radiative surface temperature 00103 ! 00104 PTRAD (:) = 0. 00105 ! 00106 DO JTILE = 1, SIZE(PEMIS_TILE,2) 00107 ! 00108 PTRAD(:) = PTRAD(:) + (PTRAD_TILE(:,JTILE)**4)*PFRAC_TILE(:,JTILE)*PEMIS_TILE(:,JTILE) 00109 ! 00110 END DO 00111 00112 PTRAD(:) = ( PTRAD(:) / MAX(PEMIS(:),ZEPS) )**0.25 00113 IF (LHOOK) CALL DR_HOOK('AVERAGE_RAD',1,ZHOOK_HANDLE) 00114 ! 00115 !------------------------------------------------------------------------------- 00116 ! 00117 END SUBROUTINE AVERAGE_RAD
1.8.0
