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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE AVERAGE_DIAG(K2M, OSURF_BUDGET, OSURF_BUDGETC, OCOEF, OSURF_VARS,&
00003                                 PFRAC_TILE,                                       &
00004                                 PRN_TILE, PH_TILE, PLE_TILE, PLEI_TILE ,          &
00005                                 PGFLUX_TILE, PRI_TILE, PCD_TILE, PCH_TILE,        &
00006                                 PCE_TILE, PT2M_TILE, PTS_TILE, PQ2M_TILE,         &
00007                                 PHU2M_TILE, PZON10M_TILE, PMER10M_TILE,           &
00008                                 PQS_TILE, PZ0_TILE, PZ0H_TILE,                    &
00009                                 PSWD_TILE, PSWU_TILE, PSWBD_TILE, PSWBU_TILE,     &
00010                                 PLWD_TILE, PLWU_TILE, PFMU_TILE, PFMV_TILE,       &
00011                                 PRNC_TILE, PHC_TILE, PLEC_TILE, PGFLUXC_TILE,     &
00012                                 PSWDC_TILE, PSWUC_TILE, PLWDC_TILE, PLWUC_TILE,   &
00013                                 PFMUC_TILE, PFMVC_TILE, PT2M_MIN_TILE,            &
00014                                 PT2M_MAX_TILE, PLEIC_TILE,                        &
00015                                 PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE,   &
00016                                 PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,         &
00017                                 PQS, PZ0, PZ0H, PUREF, PZREF,                     &
00018                                 PSWD, PSWU, PSWBD, PSWBU,PLWD, PLWU, PFMU, PFMV,  &
00019                                 PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC,    &
00020                                 PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC,   &
00021                                 PHU2M_MIN_TILE, PHU2M_MAX_TILE, PHU2M_MIN,        &
00022                                 PHU2M_MAX, PWIND10M_TILE, PWIND10M_MAX_TILE,      &
00023                                 PWIND10M, PWIND10M_MAX                            )  
00024 !     ######################################################################
00025 !
00026 !
00027 !!****  *AVERAGE_DIAG*  
00028 !!
00029 !!    PURPOSE
00030 !!    -------
00031 !      Average the fluxes from the land and water surfaces depending on the
00032 !      fraction of each surface cover type in the mesh area.
00033 !     
00034 !!**  METHOD
00035 !!    ------
00036 !
00037 !!    EXTERNAL
00038 !!    --------
00039 !!
00040 !!    IMPLICIT ARGUMENTS
00041 !!    ------------------ 
00042 !!
00043 !!      
00044 !!    REFERENCE
00045 !!    ---------
00046 !!      
00047 !!    AUTHOR
00048 !!    ------
00049 !!    V. Masson * Meteo-France-
00050 !!
00051 !!    MODIFICATIONS
00052 !!    -------------
00053 !!      Original    06/2003
00054 !!      Modified    08/2009 (B. Decharme) : new diag
00055 !     02/2010 - S. Riette - Security for wind average in case of XUNDEF values
00056 !-------------------------------------------------------------------------------
00057 !
00058 !*       0.     DECLARATIONS
00059 !               ------------
00060 !
00061 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00062 USE PARKIND1  ,ONLY : JPRB
00063 !
00064 IMPLICIT NONE
00065 !
00066 !*      0.1    declarations of arguments
00067 !
00068 INTEGER,              INTENT(IN) :: K2M          ! Flag for 2m and 10m diagnostics
00069 LOGICAL,              INTENT(IN) :: OSURF_BUDGET ! Flag for surface energy budget
00070 LOGICAL,              INTENT(IN) :: OSURF_BUDGETC! Flag for surface cumulated energy budget
00071 LOGICAL,              INTENT(IN) :: OCOEF        ! Flag for transfer coefficients
00072 LOGICAL,              INTENT(IN) :: OSURF_VARS
00073 REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_TILE   ! Fraction in a mesh-area of 
00074 !                                                ! a given surface
00075 !* fields for each tile
00076 REAL, DIMENSION(:,:), INTENT(IN) :: PRN_TILE      ! Net radiation       (W/m2)
00077 REAL, DIMENSION(:,:), INTENT(IN) :: PH_TILE       ! Sensible heat flux  (W/m2)
00078 REAL, DIMENSION(:,:), INTENT(IN) :: PLE_TILE      ! Total latent heat flux       (W/m2)
00079 REAL, DIMENSION(:,:), INTENT(IN) :: PLEI_TILE     ! Sublimation latent heat flux (W/m2)
00080 REAL, DIMENSION(:,:), INTENT(IN) :: PGFLUX_TILE   ! Storage flux        (W/m2)
00081 REAL, DIMENSION(:,:), INTENT(IN) :: PRI_TILE      ! Richardson number   (-)
00082 REAL, DIMENSION(:,:), INTENT(IN) :: PCD_TILE      ! drag coefficient for wind (W/s2)
00083 REAL, DIMENSION(:,:), INTENT(IN) :: PCH_TILE      ! drag coefficient for heat (W/s)
00084 REAL, DIMENSION(:,:), INTENT(IN) :: PCE_TILE      ! drag coefficient for evaporation (W/s/K)
00085 REAL, DIMENSION(:,:), INTENT(IN) :: PT2M_TILE     ! temperature at 2m   (K)
00086 REAL, DIMENSION(:,:), INTENT(IN) :: PTS_TILE      ! surface temperature         (K)
00087 REAL, DIMENSION(:,:), INTENT(IN) :: PT2M_MIN_TILE ! minimum temperature at 2m   (K)
00088 REAL, DIMENSION(:,:), INTENT(IN) :: PT2M_MAX_TILE ! maximum temperature at 2m   (K)
00089 REAL, DIMENSION(:,:), INTENT(IN) :: PQ2M_TILE     ! humidity at 2m      (kg/kg)
00090 REAL, DIMENSION(:,:), INTENT(IN) :: PHU2M_TILE    ! relative humidity at 2m (-)
00091 REAL, DIMENSION(:,:), INTENT(IN) :: PHU2M_MAX_TILE! maximum relative humidity at 2m (-)
00092 REAL, DIMENSION(:,:), INTENT(IN) :: PHU2M_MIN_TILE! minimum relative humidity at 2m (-)
00093 REAL, DIMENSION(:,:), INTENT(IN) :: PZON10M_TILE  ! zonal wind at 10m   (m/s)
00094 REAL, DIMENSION(:,:), INTENT(IN) :: PMER10M_TILE  ! meridian wind at 10m(m/s)
00095 REAL, DIMENSION(:,:), INTENT(IN) :: PWIND10M_TILE ! wind at 10m (m/s)
00096 REAL, DIMENSION(:,:), INTENT(IN) :: PWIND10M_MAX_TILE  ! maximum wind at 10m(m/s)
00097 REAL, DIMENSION(:,:), INTENT(IN) :: PQS_TILE
00098 REAL, DIMENSION(:,:), INTENT(IN) :: PZ0_TILE      ! roughness lenght for momentum (m)
00099 REAL, DIMENSION(:,:), INTENT(IN) :: PZ0H_TILE     ! roughness lenght for heat     (m)
00100 REAL, DIMENSION(:,:), INTENT(IN) :: PSWD_TILE     ! short wave incoming radiation (W/m2)
00101 REAL, DIMENSION(:,:), INTENT(IN) :: PSWU_TILE     ! short wave outgoing radiation (W/m2)
00102 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSWBD_TILE  ! short wave incoming radiation for each spectral band (W/m2)
00103 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSWBU_TILE  ! short wave outgoing radiation for each spectral band (W/m2)
00104 REAL, DIMENSION(:,:), INTENT(IN) :: PLWD_TILE     ! long wave incoming radiation (W/m2)
00105 REAL, DIMENSION(:,:), INTENT(IN) :: PLWU_TILE     ! long wave outgoing radiation (W/m2)
00106 REAL, DIMENSION(:,:), INTENT(IN) :: PFMU_TILE     ! zonal friction
00107 REAL, DIMENSION(:,:), INTENT(IN) :: PFMV_TILE     ! meridian friction
00108 REAL, DIMENSION(:,:), INTENT(IN) :: PRNC_TILE      ! Net radiation       (J/m2)
00109 REAL, DIMENSION(:,:), INTENT(IN) :: PHC_TILE       ! Sensible heat flux  (J/m2)
00110 REAL, DIMENSION(:,:), INTENT(IN) :: PLEC_TILE      ! Total latent heat flux    (J/m2)
00111 REAL, DIMENSION(:,:), INTENT(IN) :: PLEIC_TILE     ! Sublimation latent heat flux    (J/m2)
00112 REAL, DIMENSION(:,:), INTENT(IN) :: PGFLUXC_TILE   ! Storage flux        (J/m2)
00113 REAL, DIMENSION(:,:), INTENT(IN) :: PSWDC_TILE     ! short wave incoming radiation (J/m2)
00114 REAL, DIMENSION(:,:), INTENT(IN) :: PSWUC_TILE     ! short wave outgoing radiation (J/m2)
00115 REAL, DIMENSION(:,:), INTENT(IN) :: PLWDC_TILE     ! long wave incoming radiation (J/m2)
00116 REAL, DIMENSION(:,:), INTENT(IN) :: PLWUC_TILE     ! long wave outgoing radiation (J/m2)
00117 REAL, DIMENSION(:,:), INTENT(IN) :: PFMUC_TILE     ! zonal friction
00118 REAL, DIMENSION(:,:), INTENT(IN) :: PFMVC_TILE     ! meridian friction
00119 !
00120 REAL, DIMENSION(:), INTENT(IN) :: PUREF      ! reference height for wind  (m)
00121 REAL, DIMENSION(:), INTENT(IN) :: PZREF      ! reference height for T,q   (m)
00122 !
00123 !* aggregated fields
00124 REAL, DIMENSION(:), INTENT(OUT) :: PRN      ! Net radiation       (W/m2)
00125 REAL, DIMENSION(:), INTENT(OUT) :: PH       ! Sensible heat flux  (W/m2)
00126 REAL, DIMENSION(:), INTENT(OUT) :: PLE      ! Total latent heat flux    (W/m2)
00127 REAL, DIMENSION(:), INTENT(OUT) :: PLEI     ! Sublimation latent heat flux    (W/m2)
00128 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX   ! Storage flux        (W/m2)
00129 REAL, DIMENSION(:), INTENT(OUT) :: PRI      ! Richardson number   (-)
00130 REAL, DIMENSION(:), INTENT(OUT) :: PCD      ! drag coefficient for wind (W/s2)
00131 REAL, DIMENSION(:), INTENT(OUT) :: PCH      ! drag coefficient for heat (W/s)
00132 REAL, DIMENSION(:), INTENT(OUT) :: PCE      ! drag coefficient for evaporation (W/s/K)
00133 REAL, DIMENSION(:), INTENT(OUT) :: PT2M     ! temperature at 2m   (K)
00134 REAL, DIMENSION(:), INTENT(OUT) :: PTS      ! surface temperature (K)
00135 REAL, DIMENSION(:), INTENT(OUT) :: PQ2M     ! humidity at 2m      (kg/kg)
00136 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M    ! relative humidity at 2m (-)
00137 REAL, DIMENSION(:), INTENT(OUT) :: PZON10M  ! zonal wind at 10m   (m/s)
00138 REAL, DIMENSION(:), INTENT(OUT) :: PMER10M  ! meridian wind at 10m(m/s)
00139 REAL, DIMENSION(:), INTENT(OUT) :: PQS
00140 REAL, DIMENSION(:), INTENT(OUT) :: PZ0      ! roughness lenght for momentum (m)
00141 REAL, DIMENSION(:), INTENT(OUT) :: PZ0H     ! roughness lenght for heat     (m)
00142 REAL, DIMENSION(:), INTENT(OUT) :: PSWD     ! short wave incoming radiation (W/m2)
00143 REAL, DIMENSION(:), INTENT(OUT) :: PSWU     ! short wave outgoing radiation (W/m2)
00144 REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD  ! short wave incoming radiation for each spectral band (W/m2)
00145 REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU  ! short wave outgoing radiation for each spectral band (W/m2)
00146 REAL, DIMENSION(:), INTENT(OUT) :: PLWD     ! long wave incoming radiation (W/m2)
00147 REAL, DIMENSION(:), INTENT(OUT) :: PLWU     ! long wave outgoing radiation (W/m2)
00148 REAL, DIMENSION(:), INTENT(OUT) :: PFMU     ! zonal friction
00149 REAL, DIMENSION(:), INTENT(OUT) :: PFMV     ! meridian friction
00150 REAL, DIMENSION(:), INTENT(OUT) :: PRNC     ! Net radiation       (J/m2)
00151 REAL, DIMENSION(:), INTENT(OUT) :: PHC      ! Sensible heat flux  (J/m2)
00152 REAL, DIMENSION(:), INTENT(OUT) :: PLEC     ! Total latent heat flux    (J/m2)
00153 REAL, DIMENSION(:), INTENT(OUT) :: PLEIC    ! Sublimation latent heat flux    (J/m2)
00154 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC  ! Storage flux        (J/m2)
00155 REAL, DIMENSION(:), INTENT(OUT) :: PSWDC    ! incoming short wave radiation (J/m2)
00156 REAL, DIMENSION(:), INTENT(OUT) :: PSWUC    ! outgoing short wave radiation (J/m2)
00157 REAL, DIMENSION(:), INTENT(OUT) :: PLWDC    ! incoming long wave radiation (J/m2)
00158 REAL, DIMENSION(:), INTENT(OUT) :: PLWUC    ! outgoing long wave radiation (J/m2)
00159 REAL, DIMENSION(:), INTENT(OUT) :: PFMUC    ! zonal friction
00160 REAL, DIMENSION(:), INTENT(OUT) :: PFMVC    ! meridian friction
00161 !
00162 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
00163 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
00164 REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m   (K)
00165 REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m   (K)
00166 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m(m/s)
00167 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX ! Maximum wind at 10m(m/s)
00168 !
00169 !*      0.2    declarations of local variables
00170 !
00171 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00172 !-------------------------------------------------------------------------------
00173 !
00174 !       1.     Grid-Box average fluxes
00175 !              -----------------------
00176 !
00177 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG',0,ZHOOK_HANDLE)
00178 !
00179 IF (OSURF_BUDGET) THEN
00180 !
00181 ! Net radiation
00182 !
00183   CALL MAKE_AVERAGE(PFRAC_TILE,PRN_TILE,PRN)
00184 !
00185 ! Sensible heat flux
00186 !
00187   CALL MAKE_AVERAGE(PFRAC_TILE,PH_TILE,PH)
00188 !
00189 ! Total latent heat flux
00190 !
00191   CALL MAKE_AVERAGE(PFRAC_TILE,PLE_TILE,PLE)
00192 !
00193 ! Sublimation latent heat flux
00194 !
00195   CALL MAKE_AVERAGE(PFRAC_TILE,PLEI_TILE,PLEI)
00196 !
00197 ! Storage flux
00198 !
00199   CALL MAKE_AVERAGE(PFRAC_TILE,PGFLUX_TILE,PGFLUX)
00200 !
00201 ! Downwards short wave radiation
00202 !
00203   CALL MAKE_AVERAGE(PFRAC_TILE,PSWD_TILE,PSWD)
00204 !
00205 ! Upwards short wave radiation
00206 !
00207   CALL MAKE_AVERAGE(PFRAC_TILE,PSWU_TILE,PSWU)
00208 !
00209 ! Downwards long wave radiation
00210 !
00211   CALL MAKE_AVERAGE(PFRAC_TILE,PLWD_TILE,PLWD)
00212 !
00213 ! Upwards long wave radiation
00214 !
00215   CALL MAKE_AVERAGE(PFRAC_TILE,PLWU_TILE,PLWU)
00216 !
00217 ! Zonal wind stress
00218 !
00219   CALL MAKE_AVERAGE(PFRAC_TILE,PFMU_TILE,PFMU)
00220 !
00221 ! Meridian wind stress
00222 !
00223   CALL MAKE_AVERAGE(PFRAC_TILE,PFMV_TILE,PFMV)
00224 !
00225 ! Downwards short wave radiation for each spectral band
00226 !
00227   CALL MAKE_AVERAGE_2D(PFRAC_TILE,PSWBD_TILE,PSWBD)
00228 !
00229 ! Upwards short wave radiation for each spectral band
00230 !
00231   CALL MAKE_AVERAGE_2D(PFRAC_TILE,PSWBU_TILE,PSWBU)
00232 !
00233 END IF
00234 !
00235 IF (OSURF_BUDGETC) THEN
00236 !
00237 ! Net radiation
00238 !
00239   CALL MAKE_AVERAGE(PFRAC_TILE,PRNC_TILE,PRNC)
00240 !
00241 ! Sensible heat flux
00242 !
00243   CALL MAKE_AVERAGE(PFRAC_TILE,PHC_TILE,PHC)
00244 !
00245 ! Total latent heat flux
00246 !
00247   CALL MAKE_AVERAGE(PFRAC_TILE,PLEC_TILE,PLEC)
00248 !
00249 ! Sublimation latent heat flux
00250 !
00251   CALL MAKE_AVERAGE(PFRAC_TILE,PLEIC_TILE,PLEIC)
00252 !
00253 ! Storage flux
00254 !
00255   CALL MAKE_AVERAGE(PFRAC_TILE,PGFLUXC_TILE,PGFLUXC)
00256 !
00257 ! Downwards short wave radiation
00258 !
00259   CALL MAKE_AVERAGE(PFRAC_TILE,PSWDC_TILE,PSWDC)
00260 !
00261 ! Upwards short wave radiation
00262 !
00263   CALL MAKE_AVERAGE(PFRAC_TILE,PSWUC_TILE,PSWUC)
00264 !
00265 ! Downwards long wave radiation
00266 !
00267   CALL MAKE_AVERAGE(PFRAC_TILE,PLWDC_TILE,PLWDC)
00268 !
00269 ! Upwards long wave radiation
00270 !
00271   CALL MAKE_AVERAGE(PFRAC_TILE,PLWUC_TILE,PLWUC)
00272 !
00273 ! Zonal wind stress
00274 !
00275   CALL MAKE_AVERAGE(PFRAC_TILE,PFMUC_TILE,PFMUC)
00276 !
00277 ! Meridian wind stress
00278 !
00279   CALL MAKE_AVERAGE(PFRAC_TILE,PFMVC_TILE,PFMVC)
00280 !
00281 END IF
00282 !
00283 !-------------------------------------------------------------------------------
00284 !
00285 !       2.     Richardson number
00286 !              -----------------
00287 !
00288 IF (K2M>=1) THEN
00289   !
00290   CALL MAKE_AVERAGE(PFRAC_TILE,PRI_TILE,PRI)
00291   !
00292 !-------------------------------------------------------------------------------
00293 !
00294 !       3.     Operational parameters at surface, 2 and 10 meters
00295 !              --------------------------------------------------
00296 !
00297 !
00298 ! Surface temperature
00299 !
00300   CALL MAKE_AVERAGE(PFRAC_TILE,PTS_TILE,PTS)
00301 !
00302 ! Temperature at 2 meters
00303 !
00304   CALL MAKE_AVERAGE(PFRAC_TILE,PT2M_TILE,PT2M)
00305   CALL MAKE_AVERAGE(PFRAC_TILE,PT2M_MIN_TILE,PT2M_MIN)
00306   CALL MAKE_AVERAGE(PFRAC_TILE,PT2M_MAX_TILE,PT2M_MAX)
00307 !
00308 ! Relative humidity at 2 meters
00309 !
00310   CALL MAKE_AVERAGE(PFRAC_TILE,PHU2M_TILE,PHU2M)
00311   CALL MAKE_AVERAGE(PFRAC_TILE,PHU2M_MIN_TILE,PHU2M_MIN)
00312   CALL MAKE_AVERAGE(PFRAC_TILE,PHU2M_MAX_TILE,PHU2M_MAX)
00313 !
00314 ! Specific humidity at 2 meters
00315 !
00316   CALL MAKE_AVERAGE(PFRAC_TILE,PQ2M_TILE,PQ2M)
00317 !
00318 ! Wind at 10 meters
00319 !
00320   CALL MAKE_AVERAGE(PFRAC_TILE,PZON10M_TILE,PZON10M)
00321 !
00322   CALL MAKE_AVERAGE(PFRAC_TILE,PMER10M_TILE,PMER10M)
00323 !
00324   CALL MAKE_AVERAGE(PFRAC_TILE,PWIND10M_TILE,PWIND10M)
00325   CALL MAKE_AVERAGE(PFRAC_TILE,PWIND10M_MAX_TILE,PWIND10M_MAX)
00326 !
00327 END IF
00328 !-------------------------------------------------------------------------------
00329 !
00330 !       4.     Transfer coeffients and roughness lengths
00331 !              -----------------------------------------
00332 !
00333 IF (OCOEF) THEN
00334 !
00335   CALL MAKE_AVERAGE(PFRAC_TILE,PCD_TILE,PCD)
00336 !
00337   CALL MAKE_AVERAGE(PFRAC_TILE,PCH_TILE,PCH)
00338 !
00339   CALL MAKE_AVERAGE(PFRAC_TILE,PCE_TILE,PCE)
00340 !
00341   CALL MAKE_AVERAGE(PFRAC_TILE,PCE_TILE,PCE)
00342 !
00343   CALL MAKE_AVERAGE_Z0(PFRAC_TILE,PUREF,PZ0_TILE,PZ0)
00344 !
00345   CALL MAKE_AVERAGE_Z0(PFRAC_TILE,PZREF,PZ0H_TILE,PZ0H)
00346 !
00347 ENDIF
00348 !
00349 IF (OSURF_VARS) THEN
00350 !
00351   CALL MAKE_AVERAGE(PFRAC_TILE,PQS_TILE,PQS)
00352 !
00353 ENDIF
00354 !
00355 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG',1,ZHOOK_HANDLE)
00356 !
00357 CONTAINS
00358 !
00359 SUBROUTINE MAKE_AVERAGE(PFRAC,PFIELD_IN,PFIELD_OUT)
00360 !
00361 USE MODD_SURF_PAR, ONLY : XUNDEF
00362 !
00363 IMPLICIT NONE
00364 !
00365 REAL, DIMENSION(:,:),INTENT(IN)   :: PFRAC
00366 REAL, DIMENSION(:,:),INTENT(IN)   :: PFIELD_IN
00367 REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
00368 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
00369 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00370 INTEGER :: JT
00371 !
00372 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE',0,ZHOOK_HANDLE)
00373 !
00374 GMASK(:) = .TRUE.
00375 DO JT=1,SIZE(PFIELD_IN,2)
00376   WHERE (PFIELD_IN(:,JT)==XUNDEF .AND. PFRAC(:,JT)/=0.) GMASK(:) = .FALSE.
00377 END DO
00378 !
00379 PFIELD_OUT(:) = 0.
00380 DO JT=1,SIZE(PFIELD_IN,2)
00381   PFIELD_OUT(:) = PFIELD_OUT(:) + PFRAC(:,JT) * PFIELD_IN(:,JT)
00382 END DO
00383 WHERE(.NOT. GMASK(:)) PFIELD_OUT(:) = XUNDEF
00384 !
00385 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE',1,ZHOOK_HANDLE)
00386 !
00387 END SUBROUTINE MAKE_AVERAGE
00388 !
00389 SUBROUTINE MAKE_AVERAGE_2D(PFRAC,PFIELD_IN,PFIELD_OUT)
00390 !
00391 USE MODD_SURF_PAR, ONLY : XUNDEF
00392 !
00393 IMPLICIT NONE
00394 !
00395 REAL, DIMENSION(:,:),INTENT(IN)   :: PFRAC
00396 REAL, DIMENSION(:,:,:),INTENT(IN)   :: PFIELD_IN
00397 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD_OUT
00398 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
00399 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00400 INTEGER :: JT, JL
00401 !
00402 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_2D',0,ZHOOK_HANDLE)
00403 !
00404 DO JL=1,SIZE(PFIELD_IN,3)
00405   PFIELD_OUT(:,JL) = 0.
00406   GMASK(:) = .TRUE.
00407   DO JT=1,SIZE(PFIELD_IN,2)
00408     WHERE (PFIELD_IN(:,JT,JL)==XUNDEF .AND. PFRAC(:,JT)/=0.) GMASK(:) = .FALSE.
00409     PFIELD_OUT(:,JL) = PFIELD_OUT(:,JL) + PFRAC(:,JT) * PFIELD_IN(:,JT,JL)
00410   END DO
00411   WHERE(.NOT. GMASK(:)) PFIELD_OUT(:,JL) = XUNDEF
00412 END DO
00413 !
00414 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_2D',1,ZHOOK_HANDLE)
00415 !
00416 END SUBROUTINE MAKE_AVERAGE_2D
00417 !
00418 SUBROUTINE MAKE_AVERAGE_Z0(PFRAC,PREF,PFIELD_IN,PFIELD_OUT)
00419 !
00420 USE MODD_SURF_PAR, ONLY : XUNDEF
00421 !
00422 IMPLICIT NONE
00423 !
00424 REAL, DIMENSION(:,:),INTENT(IN)   :: PFRAC
00425 REAL, DIMENSION(:,:),INTENT(IN)   :: PFIELD_IN
00426 REAL, DIMENSION(:),INTENT(IN)   :: PREF
00427 REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
00428 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
00429 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00430 INTEGER :: JT, JL
00431 !
00432 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_Z0',0,ZHOOK_HANDLE)
00433 !
00434 GMASK(:) = .TRUE.
00435 DO JT=1,SIZE(PFIELD_IN,2)
00436   WHERE (PFIELD_IN(:,JT)==XUNDEF .AND. PFRAC(:,JT)/=0.) GMASK(:) = .FALSE.
00437 END DO
00438 !
00439 PFIELD_OUT(:) = 0.
00440 DO JT=1,SIZE(PFIELD_IN,2)
00441   PFIELD_OUT(:) = PFIELD_OUT(:) + PFRAC(:,JT) *  1./(LOG(PREF(:)/PFIELD_IN(:,JT)))**2
00442 END DO
00443 WHERE (PFIELD_OUT(:) == 0.)
00444   PFIELD_OUT(:) = XUNDEF
00445 ELSEWHERE
00446   PFIELD_OUT(:) = PREF(:) * EXP( - SQRT(1./PFIELD_OUT(:)) )
00447 ENDWHERE
00448 WHERE(.NOT. GMASK(:)) PFIELD_OUT(:) = XUNDEF
00449 !
00450 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_Z0',1,ZHOOK_HANDLE)
00451 !
00452 END SUBROUTINE MAKE_AVERAGE_Z0
00453 
00454 !-------------------------------------------------------------------------------
00455 !
00456 END SUBROUTINE AVERAGE_DIAG