|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE DIAG_SURF_ATM_n(HPROGRAM) 00003 ! ################################################################################# 00004 ! 00005 !!**** *DIAG_SURF_ATM_n * - Chooses the surface schemes for diagnostics 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! V. Masson 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 01/2004 00024 !! Modified 01/2006 : sea flux parameterization. 00025 !! Modified 08/2008 : cumulated fluxes 00026 !!------------------------------------------------------------------ 00027 ! 00028 00029 ! 00030 USE MODD_SURF_CONF, ONLY : CPROGNAME 00031 USE MODD_SURF_ATM_n, ONLY : XSEA, XTOWN, XNATURE, XWATER, TTIME, & 00032 NSIZE_SEA, NSIZE_TOWN, NSIZE_NATURE, NSIZE_WATER, & 00033 NDIM_SEA, NDIM_TOWN, NDIM_NATURE, NDIM_WATER, & 00034 NR_SEA, NR_TOWN, NR_NATURE, NR_WATER 00035 USE MODD_SURF_ATM_n, ONLY : XZS 00036 USE MODD_SURF_ATM_SSO_n, ONLY : XMIN_ZS 00037 USE MODD_DATA_COVER_PAR, ONLY : NTILESFC 00038 USE MODD_DIAG_SURF_ATM_n,ONLY : N2M, L2M_MIN_ZS, LSURF_BUDGET, LCOEF, LSURF_VARS,& 00039 XRN_TILE, XH_TILE, XLE_TILE, XGFLUX_TILE, & 00040 XRI_TILE, XCD_TILE, XCH_TILE, XCE_TILE, & 00041 XT2M_TILE, XTS_TILE, XQ2M_TILE, XHU2M_TILE, & 00042 XZON10M_TILE, XMER10M_TILE, XLEI_TILE, & 00043 XQS_TILE, XZ0_TILE, XZ0H_TILE, XT2M_MIN_TILE, & 00044 XT2M_MAX_TILE, & 00045 XSWD_TILE, XSWU_TILE, XLWD_TILE, XLWU_TILE, & 00046 XSWBD_TILE, XSWBU_TILE, XFMU_TILE, XFMV_TILE, & 00047 XAVG_RN, XAVG_H, XAVG_LE, XAVG_GFLUX, & 00048 XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE, & 00049 XAVG_T2M, XAVG_TS, XAVG_Q2M, XAVG_HU2M, & 00050 XAVG_T2M_MIN_ZS,XAVG_Q2M_MIN_ZS, & 00051 XAVG_HU2M_MIN_ZS, XAVG_ZON10M, XAVG_MER10M, & 00052 XAVG_QS, XAVG_Z0, XAVG_Z0H, XAVG_LEI, & 00053 XDIAG_UREF, XDIAG_ZREF, & 00054 XAVG_SWD, XAVG_SWU, XAVG_LWD, XAVG_LWU, & 00055 XAVG_SWBD, XAVG_SWBU, XAVG_FMU, XAVG_FMV, & 00056 XPS, XRHOA, LSURF_BUDGETC, & 00057 XRNC_TILE, XHC_TILE, XLEC_TILE, XGFLUXC_TILE, & 00058 XSWDC_TILE, XSWUC_TILE, XLWDC_TILE, XLWUC_TILE,& 00059 XFMUC_TILE, XFMVC_TILE, XLEIC_TILE, & 00060 XAVG_RNC, XAVG_HC, XAVG_LEC, XAVG_GFLUXC, & 00061 XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC, & 00062 XAVG_FMUC, XAVG_FMVC, XAVG_T2M_MIN, & 00063 XAVG_T2M_MAX, XAVG_LEIC, XHU2M_MIN_TILE, & 00064 XHU2M_MAX_TILE, XAVG_HU2M_MIN, XAVG_HU2M_MAX, & 00065 XWIND10M_TILE, XWIND10M_MAX_TILE, & 00066 XAVG_WIND10M, XAVG_WIND10M_MAX 00067 ! 00068 USE MODI_DIAG_NATURE_n 00069 USE MODI_DIAG_SEA_n 00070 USE MODI_DIAG_INLAND_WATER_n 00071 USE MODI_DIAG_TOWN_n 00072 USE MODI_AVERAGE_DIAG 00073 ! 00074 USE MODI_FORCING_VERT_SHIFT 00075 ! 00076 ! 00077 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00078 USE PARKIND1 ,ONLY : JPRB 00079 ! 00080 IMPLICIT NONE 00081 ! 00082 !* 0.1 declarations of arguments 00083 ! 00084 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00085 ! 00086 ! 00087 !* 0.2 declarations of local variables 00088 ! 00089 INTEGER :: JTILE ! loop on type of surface 00090 LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented 00091 INTEGER :: JSW ! number of spectral whort wave bands 00092 ! 00093 REAL, DIMENSION(SIZE(XSEA),NTILESFC) :: ZFRAC_TILE! fraction of each tile 00094 INTEGER, DIMENSION(5) :: IFACT 00095 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00096 !------------------------------------------------------------------------------------- 00097 ! Preliminaries: Tile related operations 00098 !------------------------------------------------------------------------------------- 00099 ! 00100 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_N',0,ZHOOK_HANDLE) 00101 CPROGNAME = HPROGRAM 00102 ! 00103 ! FLAGS for the various surfaces: 00104 ! 00105 GSEA = NDIM_SEA >0 00106 GWATER = NDIM_WATER >0 00107 GTOWN = NDIM_TOWN >0 00108 GNATURE = NDIM_NATURE >0 00109 ! 00110 ! Tile counter: 00111 ! 00112 JTILE = 0 00113 ! 00114 ! Fractions for each tile: 00115 ! 00116 ZFRAC_TILE(:,:) = 0.0 00117 ! 00118 ! Number of spectral short wave bands for detailed radiation budget 00119 JSW = SIZE(XSWBD_TILE,3) 00120 ! 00121 ! 00122 CALL GET_DIMS(IFACT) 00123 ! 00124 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00125 ! SEA Tile calculations: 00126 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00127 ! 00128 ! first, pack vector...then call ALMA routine 00129 ! 00130 JTILE = JTILE + 1 00131 ! 00132 IF(GSEA)THEN 00133 ! 00134 ZFRAC_TILE(:,JTILE) = XSEA(:) 00135 ! 00136 CALL TREAT_SURF(JTILE,NSIZE_SEA,NR_SEA,IFACT) 00137 ! 00138 ENDIF 00139 ! 00140 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00141 ! INLAND WATER Tile calculations: 00142 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00143 ! 00144 JTILE = JTILE + 1 00145 ! 00146 IF(GWATER)THEN 00147 ! 00148 ZFRAC_TILE(:,JTILE) = XWATER(:) 00149 ! 00150 CALL TREAT_SURF(JTILE,NSIZE_WATER,NR_WATER,IFACT) 00151 ! 00152 ENDIF 00153 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00154 ! NATURAL SURFACE Tile calculations: 00155 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00156 ! 00157 JTILE = JTILE + 1 00158 ! 00159 IF(GNATURE)THEN 00160 ! 00161 ZFRAC_TILE(:,JTILE) = XNATURE(:) 00162 ! 00163 CALL TREAT_SURF(JTILE,NSIZE_NATURE,NR_NATURE,IFACT) 00164 ! 00165 ENDIF 00166 ! 00167 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00168 ! URBAN Tile calculations: 00169 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00170 ! 00171 JTILE = JTILE + 1 00172 ! 00173 IF(GTOWN)THEN 00174 ! 00175 ZFRAC_TILE(:,JTILE) = XTOWN(:) 00176 ! 00177 CALL TREAT_SURF(JTILE,NSIZE_TOWN,NR_TOWN,IFACT) 00178 ! 00179 ENDIF 00180 ! 00181 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00182 ! Grid box average fluxes/properties: 00183 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00184 ! 00185 CALL AVERAGE_DIAG(N2M, LSURF_BUDGET, LSURF_BUDGETC, LCOEF, LSURF_VARS, & 00186 ZFRAC_TILE, XRN_TILE, XH_TILE, XLE_TILE, XLEI_TILE , & 00187 XGFLUX_TILE,XRI_TILE, XCD_TILE, XCH_TILE, XCE_TILE, & 00188 XT2M_TILE, XTS_TILE, XQ2M_TILE, XHU2M_TILE, & 00189 XZON10M_TILE, XMER10M_TILE, & 00190 XQS_TILE, XZ0_TILE, XZ0H_TILE, & 00191 XSWD_TILE, XSWU_TILE, XSWBD_TILE, XSWBU_TILE, & 00192 XLWD_TILE, XLWU_TILE, XFMU_TILE, XFMV_TILE, & 00193 XRNC_TILE, XHC_TILE, XLEC_TILE, XGFLUXC_TILE, & 00194 XSWDC_TILE, XSWUC_TILE, XLWDC_TILE, XLWUC_TILE, & 00195 XFMUC_TILE, XFMVC_TILE, XT2M_MIN_TILE, & 00196 XT2M_MAX_TILE, XLEIC_TILE, & 00197 XAVG_RN, XAVG_H, XAVG_LE, XAVG_LEI, XAVG_GFLUX, & 00198 XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE, & 00199 XAVG_T2M, XAVG_TS, XAVG_Q2M, XAVG_HU2M, & 00200 XAVG_ZON10M, XAVG_MER10M, & 00201 XAVG_QS, XAVG_Z0, XAVG_Z0H, & 00202 XDIAG_UREF, XDIAG_ZREF, & 00203 XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU, & 00204 XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV, & 00205 XAVG_RNC, XAVG_HC, XAVG_LEC, XAVG_GFLUXC, & 00206 XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC, & 00207 XAVG_FMUC, XAVG_FMVC, XAVG_T2M_MIN, & 00208 XAVG_T2M_MAX, XAVG_LEIC, & 00209 XHU2M_MIN_TILE, XHU2M_MAX_TILE, XAVG_HU2M_MIN, & 00210 XAVG_HU2M_MAX, XWIND10M_TILE, XWIND10M_MAX_TILE, & 00211 XAVG_WIND10M, XAVG_WIND10M_MAX ) 00212 ! 00213 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00214 ! Quantities at 2 meters above the minimum orography of the grid mesh 00215 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00216 ! 00217 IF (L2M_MIN_ZS) CALL GET_2M 00218 ! 00219 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_N',1,ZHOOK_HANDLE) 00220 CONTAINS 00221 !======================================================================================= 00222 SUBROUTINE GET_2M 00223 ! 00224 REAL, DIMENSION(SIZE(XSEA)) :: ZPS ! surface air pressure 00225 REAL, DIMENSION(SIZE(XSEA)) :: ZRHOA ! surface air density 00226 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00227 ! 00228 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_2M',0,ZHOOK_HANDLE) 00229 ! 00230 CALL FORCING_VERT_SHIFT(XZS,XMIN_ZS,XAVG_T2M,XAVG_Q2M,XPS,XRHOA, & 00231 XAVG_T2M_MIN_ZS,XAVG_Q2M_MIN_ZS,ZPS,ZRHOA) 00232 XAVG_HU2M_MIN_ZS = XAVG_HU2M 00233 ! 00234 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_2M',1,ZHOOK_HANDLE) 00235 ! 00236 END SUBROUTINE GET_2M 00237 ! 00238 !======================================================================================= 00239 ! 00240 SUBROUTINE GET_DIMS(KFACT) 00241 ! 00242 IMPLICIT NONE 00243 ! 00244 INTEGER, DIMENSION(5), INTENT(OUT) :: KFACT 00245 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00246 ! 00247 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_DIMS',0,ZHOOK_HANDLE) 00248 ! 00249 KFACT(:)=0 00250 ! 00251 IF (LSURF_BUDGET) KFACT(1)=1 00252 ! 00253 IF (LSURF_BUDGETC) KFACT(2)=1 00254 ! 00255 IF (N2M>=1) KFACT(3)=1 00256 ! 00257 IF (LCOEF) KFACT(4)=1 00258 ! 00259 IF (LSURF_VARS) KFACT(5)=1 00260 ! 00261 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_DIMS',1,ZHOOK_HANDLE) 00262 ! 00263 END SUBROUTINE GET_DIMS 00264 ! 00265 !======================================================================================= 00266 ! 00267 SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK,KFACT) 00268 ! 00269 IMPLICIT NONE 00270 ! 00271 INTEGER, INTENT(IN) :: KTILE 00272 INTEGER, INTENT(IN) :: KSIZE 00273 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK 00274 INTEGER, DIMENSION(5), INTENT(IN) :: KFACT 00275 ! 00276 REAL, DIMENSION(KSIZE) :: ZP_TS ! surface temperature (K) 00277 ! 00278 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_RN ! Net radiation (W/m2) 00279 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_H ! sensible heat flux (W/m2) 00280 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LE ! total latent heat flux (W/m2) 00281 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LEI ! sublimation latent heat flux (W/m2) 00282 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_GFLUX ! storage flux (W/m2) 00283 ! 00284 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_SWD ! short wave incoming radiation (W/m2) 00285 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_SWU ! short wave outgoing radiation (W/m2) 00286 REAL, DIMENSION(KSIZE*KFACT(1),JSW*KFACT(1)) :: ZP_SWBD ! short wave incoming radiation by spectral band (W/m2) 00287 REAL, DIMENSION(KSIZE*KFACT(1),JSW*KFACT(1)) :: ZP_SWBU ! short wave outgoing radiation by spectral band (W/m2) 00288 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LWD ! long wave incoming radiation (W/m2) 00289 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LWU ! long wave outgoing radiation (W/m2) 00290 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_FMU ! zonal friction 00291 REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_FMV ! meridian friction 00292 ! 00293 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_RNC ! Cumulated Net radiation (W/m2) 00294 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_HC ! Cumulated sensible heat flux (W/m2) 00295 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LEC ! Cumulated total latent heat flux (W/m2) 00296 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LEIC ! Cumulated sublimation latent heat flux (W/m2) 00297 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_GFLUXC ! Cumulated storage flux (W/m2) 00298 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_SWDC ! Cumulated short wave incoming radiation (W/m2) 00299 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_SWUC ! Cumulated short wave outgoing radiation (W/m2) 00300 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LWDC ! Cumulated long wave incoming radiation (W/m2) 00301 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LWUC ! Cumulated long wave outgoing radiation (W/m2) 00302 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_FMUC ! Cumulated zonal friction 00303 REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_FMVC ! Cumulated meridian friction 00304 ! 00305 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_RI ! Richardson number 00306 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_T2M ! air temperature at 2 meters (K) 00307 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_T2M_MIN ! Minimum air temperature at 2 meters (K) 00308 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_T2M_MAX ! Maximum air temperature at 2 meters (K) 00309 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_Q2M ! air humidity at 2 meters (kg/kg) 00310 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_HU2M ! air relative humidity at 2 meters (-) 00311 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_HU2M_MIN ! Minimum air relative humidity at 2 meters (-) 00312 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_HU2M_MAX ! Maximum air relative humidity at 2 meters (-) 00313 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_ZON10M ! zonal wind at 10 meters (m/s) 00314 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_MER10M ! meridian wind at 10 meters (m/s) 00315 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_WIND10M ! wind at 10 meters (m/s) 00316 REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_WIND10M_MAX ! Maximum wind at 10 meters (m/s) 00317 ! 00318 REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_CD ! drag coefficient for wind 00319 REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_CH ! drag coefficient for heat 00320 REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_CE ! drag coefficient for evaporation 00321 REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_Z0 ! roughness length for momentum 00322 REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_Z0H ! roughness length for heat 00323 ! 00324 REAL, DIMENSION(KSIZE*KFACT(5)) :: ZP_QS ! specific humidity 00325 ! 00326 INTEGER :: JJ, JJSW 00327 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00328 ! 00329 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:TREAT_SURF',0,ZHOOK_HANDLE) 00330 ! 00331 IF (KTILE==1) THEN 00332 ! 00333 CALL DIAG_SEA_n(HPROGRAM, & 00334 ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX, & 00335 ZP_RI, ZP_CD, ZP_CH, ZP_CE, & 00336 ZP_QS, ZP_Z0, ZP_Z0H, & 00337 ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, & 00338 ZP_ZON10M, ZP_MER10M, & 00339 ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, & 00340 ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, & 00341 ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, & 00342 ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, & 00343 ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, & 00344 ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, & 00345 ZP_HU2M_MAX, ZP_WIND10M, & 00346 ZP_WIND10M_MAX ) 00347 ! 00348 ELSEIF (KTILE==2) THEN 00349 ! 00350 CALL DIAG_INLAND_WATER_n(HPROGRAM, & 00351 ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX,& 00352 ZP_RI, ZP_CD, ZP_CH, ZP_CE, & 00353 ZP_QS, ZP_Z0, ZP_Z0H, & 00354 ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, & 00355 ZP_ZON10M, ZP_MER10M, & 00356 ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, & 00357 ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, & 00358 ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, & 00359 ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, & 00360 ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, & 00361 ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, & 00362 ZP_HU2M_MAX, ZP_WIND10M, & 00363 ZP_WIND10M_MAX ) 00364 ! 00365 ELSEIF (KTILE==3) THEN 00366 ! 00367 CALL DIAG_NATURE_n(HPROGRAM, & 00368 ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX,& 00369 ZP_RI, ZP_CD, ZP_CH, ZP_CE, & 00370 ZP_QS, ZP_Z0, ZP_Z0H, & 00371 ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, & 00372 ZP_ZON10M, ZP_MER10M, & 00373 ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, & 00374 ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, & 00375 ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, & 00376 ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, & 00377 ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, & 00378 ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, & 00379 ZP_HU2M_MAX, ZP_WIND10M, & 00380 ZP_WIND10M_MAX ) 00381 ! 00382 ELSEIF (KTILE==4) THEN 00383 ! 00384 CALL DIAG_TOWN_n(HPROGRAM, & 00385 ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX,& 00386 ZP_RI, ZP_CD, ZP_CH, ZP_CE, & 00387 ZP_QS, ZP_Z0, ZP_Z0H, & 00388 ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, & 00389 ZP_ZON10M, ZP_MER10M, & 00390 ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, & 00391 ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, & 00392 ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, & 00393 ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, & 00394 ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, & 00395 ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, & 00396 ZP_HU2M_MAX, ZP_WIND10M, & 00397 ZP_WIND10M_MAX ) 00398 ! 00399 ENDIF 00400 ! 00401 !---------------------------------------------------------------------- 00402 IF (LSURF_BUDGET) THEN 00403 DO JJ=1,KSIZE 00404 XRN_TILE (KMASK(JJ),KTILE) = ZP_RN (JJ) 00405 XH_TILE (KMASK(JJ),KTILE) = ZP_H (JJ) 00406 XLE_TILE (KMASK(JJ),KTILE) = ZP_LE (JJ) 00407 XLEI_TILE (KMASK(JJ),KTILE) = ZP_LEI (JJ) 00408 XGFLUX_TILE (KMASK(JJ),KTILE) = ZP_GFLUX (JJ) 00409 XSWD_TILE (KMASK(JJ),KTILE) = ZP_SWD (JJ) 00410 XSWU_TILE (KMASK(JJ),KTILE) = ZP_SWU (JJ) 00411 XLWD_TILE (KMASK(JJ),KTILE) = ZP_LWD (JJ) 00412 XLWU_TILE (KMASK(JJ),KTILE) = ZP_LWU (JJ) 00413 XFMU_TILE (KMASK(JJ),KTILE) = ZP_FMU (JJ) 00414 XFMV_TILE (KMASK(JJ),KTILE) = ZP_FMV (JJ) 00415 DO JJSW=1, SIZE(XSWBD_TILE,3) 00416 XSWBD_TILE (KMASK(JJ),KTILE,JJSW) = ZP_SWBD (JJ,JJSW) 00417 XSWBU_TILE (KMASK(JJ),KTILE,JJSW) = ZP_SWBU (JJ,JJSW) 00418 ENDDO 00419 ENDDO 00420 END IF 00421 ! 00422 IF (LSURF_BUDGETC) THEN 00423 DO JJ=1,KSIZE 00424 XRNC_TILE (KMASK(JJ),KTILE) = ZP_RNC (JJ) 00425 XHC_TILE (KMASK(JJ),KTILE) = ZP_HC (JJ) 00426 XLEC_TILE (KMASK(JJ),KTILE) = ZP_LEC (JJ) 00427 XLEIC_TILE (KMASK(JJ),KTILE) = ZP_LEIC (JJ) 00428 XGFLUXC_TILE (KMASK(JJ),KTILE) = ZP_GFLUXC (JJ) 00429 XSWDC_TILE (KMASK(JJ),KTILE) = ZP_SWDC (JJ) 00430 XSWUC_TILE (KMASK(JJ),KTILE) = ZP_SWUC (JJ) 00431 XLWDC_TILE (KMASK(JJ),KTILE) = ZP_LWDC (JJ) 00432 XLWUC_TILE (KMASK(JJ),KTILE) = ZP_LWUC (JJ) 00433 XFMUC_TILE (KMASK(JJ),KTILE) = ZP_FMUC (JJ) 00434 XFMVC_TILE (KMASK(JJ),KTILE) = ZP_FMVC (JJ) 00435 ENDDO 00436 END IF 00437 ! 00438 DO JJ=1,KSIZE 00439 XTS_TILE (KMASK(JJ),KTILE) = ZP_TS (JJ) 00440 ENDDO 00441 ! 00442 IF (N2M>=1) THEN 00443 DO JJ=1,KSIZE 00444 XRI_TILE (KMASK(JJ),KTILE) = ZP_RI (JJ) 00445 XT2M_TILE (KMASK(JJ),KTILE) = ZP_T2M (JJ) 00446 XT2M_MIN_TILE (KMASK(JJ),KTILE) = ZP_T2M_MIN (JJ) 00447 XT2M_MAX_TILE (KMASK(JJ),KTILE) = ZP_T2M_MAX (JJ) 00448 XQ2M_TILE (KMASK(JJ),KTILE) = ZP_Q2M (JJ) 00449 XHU2M_TILE (KMASK(JJ),KTILE) = ZP_HU2M (JJ) 00450 XHU2M_MIN_TILE(KMASK(JJ),KTILE) = ZP_HU2M_MIN (JJ) 00451 XHU2M_MAX_TILE(KMASK(JJ),KTILE) = ZP_HU2M_MAX (JJ) 00452 XZON10M_TILE (KMASK(JJ),KTILE) = ZP_ZON10M (JJ) 00453 XMER10M_TILE (KMASK(JJ),KTILE) = ZP_MER10M (JJ) 00454 XWIND10M_TILE (KMASK(JJ),KTILE) = ZP_WIND10M (JJ) 00455 XWIND10M_MAX_TILE (KMASK(JJ),KTILE) = ZP_WIND10M_MAX (JJ) 00456 ENDDO 00457 END IF 00458 ! 00459 IF (LCOEF) THEN 00460 DO JJ=1,KSIZE 00461 XCD_TILE (KMASK(JJ),KTILE) = ZP_CD (JJ) 00462 XCH_TILE (KMASK(JJ),KTILE) = ZP_CH (JJ) 00463 XCE_TILE (KMASK(JJ),KTILE) = ZP_CE (JJ) 00464 XQS_TILE (KMASK(JJ),KTILE) = ZP_QS (JJ) 00465 XZ0_TILE (KMASK(JJ),KTILE) = ZP_Z0 (JJ) 00466 XZ0H_TILE (KMASK(JJ),KTILE) = ZP_Z0H (JJ) 00467 ENDDO 00468 END IF 00469 !---------------------------------------------------------------------- 00470 IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:TREAT_SURF',1,ZHOOK_HANDLE) 00471 ! 00472 END SUBROUTINE TREAT_SURF 00473 !======================================================================================= 00474 END SUBROUTINE DIAG_SURF_ATM_n
1.8.0
