SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE AVERAGE_FLUX(PFRAC_TILE, & 00003 PSFTH_TILE, PSFTQ_TILE, & 00004 PSFTS_TILE, PSFCO2_TILE, & 00005 PSFU_TILE, PSFV_TILE, & 00006 PSFTH, PSFTQ, PSFTS, PSFCO2, & 00007 PSFU, PSFV ) 00008 ! ###################################################################### 00009 ! 00010 ! 00011 !!**** *AVERAGE_FLUX* 00012 !! 00013 !! PURPOSE 00014 !! ------- 00015 ! Average the fluxes from the land and water surfaces depending on the 00016 ! fraction of each surface cover type in the mesh area. 00017 ! 00018 !!** METHOD 00019 !! ------ 00020 ! 00021 !! EXTERNAL 00022 !! -------- 00023 !! 00024 !! IMPLICIT ARGUMENTS 00025 !! ------------------ 00026 !! 00027 !! 00028 !! REFERENCE 00029 !! --------- 00030 !! 00031 !! AUTHOR 00032 !! ------ 00033 !! S. Belair * Meteo-France * 00034 !! 00035 !! MODIFICATIONS 00036 !! ------------- 00037 !! Original 10/03/95 00038 !! V.Masson 20/03/96 remove abnormal averages and average TS**4 instead 00039 !! of TS 00040 !! (J.Stein) 27/03/96 use only H and LE in the soil scheme 00041 !! A. Boone 27/11/02 revised to output ALMA variables, and general applications 00042 !------------------------------------------------------------------------------- 00043 ! 00044 !* 0. DECLARATIONS 00045 ! ------------ 00046 ! 00047 ! 00048 USE MODD_SURF_PAR, ONLY : XUNDEF 00049 ! 00050 ! 00051 ! 00052 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00053 USE PARKIND1 ,ONLY : JPRB 00054 ! 00055 IMPLICIT NONE 00056 ! 00057 !* 0.1 declarations of arguments 00058 ! 00059 ! 00060 !* 0.1 declarations of arguments 00061 ! 00062 REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_TILE ! Fraction in a mesh-area of 00063 ! ! a given surface 00064 REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH_TILE ! pot. temp. flux (mK/s) 00065 REAL, DIMENSION(:,:), INTENT(IN) :: PSFTQ_TILE ! water vapor flux (m kg/kg/s) 00066 REAL, DIMENSION(:,:), INTENT(IN) :: PSFCO2_TILE! CO2 flux (m kg/kg/s) 00067 REAL, DIMENSION(:,:,:),INTENT(IN):: PSFTS_TILE ! scalar flux (m kg/kg/s) 00068 REAL, DIMENSION(:,:), INTENT(IN) :: PSFU_TILE ! zonal momentum flux (pa) 00069 REAL, DIMENSION(:,:), INTENT(IN) :: PSFV_TILE ! meridian momentum flux (pa) 00070 REAL, DIMENSION(:), INTENT(OUT):: PSFTH ! pot. temp. flux (mK/s) 00071 REAL, DIMENSION(:), INTENT(OUT):: PSFTQ ! water vapor flux (m kg/kg/s) 00072 REAL, DIMENSION(:,:), INTENT(OUT):: PSFTS ! scalar flux (m kg/kg/s) 00073 REAL, DIMENSION(:), INTENT(OUT):: PSFCO2 ! CO2 flux (m kg/kg/s) 00074 REAL, DIMENSION(:), INTENT(OUT):: PSFU ! zonal momentum flux (pa) 00075 REAL, DIMENSION(:), INTENT(OUT):: PSFV ! meridian momentum flux (pa) 00076 ! 00077 !* 0.2 declarations of local variables 00078 ! 00079 INTEGER :: JSV ! scalar loop counter 00080 INTEGER :: JTILE ! tile loop counter 00081 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00082 !------------------------------------------------------------------------------- 00083 ! 00084 ! 0. Initialization 00085 ! -------------- 00086 ! 00087 IF (LHOOK) CALL DR_HOOK('AVERAGE_FLUX',0,ZHOOK_HANDLE) 00088 PSFTH (:) = 0. 00089 PSFTQ (:) = 0. 00090 PSFCO2 (:) = 0. 00091 PSFU (:) = 0. 00092 PSFV (:) = 0. 00093 PSFTS (:,:) = 0. 00094 ! 00095 ! 1. Grid-Box average 1d fluxes 00096 ! -------------------------- 00097 ! 00098 ! 00099 DO JTILE = 1, SIZE(PSFTH_TILE,2) 00100 ! 00101 ! potential temperature flux: 00102 ! 00103 PSFTH(:) = PSFTH(:) + PFRAC_TILE(:,JTILE) * PSFTH_TILE(:,JTILE) 00104 ! 00105 ! water vapor flux: 00106 ! 00107 PSFTQ(:) = PSFTQ(:) + PFRAC_TILE(:,JTILE) * PSFTQ_TILE(:,JTILE) 00108 ! 00109 ! carbon flux: 00110 ! 00111 PSFCO2(:) = PSFCO2(:) + PFRAC_TILE(:,JTILE) * PSFCO2_TILE(:,JTILE) 00112 ! 00113 ! wind surface friction: 00114 ! 00115 PSFU(:) = PSFU(:) + PFRAC_TILE(:,JTILE) * PSFU_TILE(:,JTILE) 00116 PSFV(:) = PSFV(:) + PFRAC_TILE(:,JTILE) * PSFV_TILE(:,JTILE) 00117 ! 00118 END DO 00119 ! 00120 ! 00121 ! 00122 ! 2. Grid-Box average 2d fluxes 00123 ! -------------------------- 00124 ! 00125 DO JSV = 1, SIZE(PSFTS_TILE,2) 00126 ! 00127 DO JTILE = 1, SIZE(PSFTS_TILE,3) 00128 ! 00129 ! scalar flux 00130 ! 00131 PSFTS(:,JSV) = PSFTS(:,JSV) + PFRAC_TILE(:,JTILE) * PSFTS_TILE(:,JSV,JTILE) 00132 ! 00133 END DO 00134 ! 00135 END DO 00136 IF (LHOOK) CALL DR_HOOK('AVERAGE_FLUX',1,ZHOOK_HANDLE) 00137 00138 !------------------------------------------------------------------------------- 00139 ! 00140 END SUBROUTINE AVERAGE_FLUX