|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !############################################################# 00002 SUBROUTINE INIT_SURF_ATM_n(HPROGRAM,HINIT, OLAND_USE, & 00003 KI,KSV,KSW, & 00004 HSV,PCO2,PRHOA, & 00005 PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, & 00006 PEMIS,PTSRAD, & 00007 KYEAR, KMONTH,KDAY, PTIME, & 00008 HATMFILE,HATMFILETYPE, & 00009 HTEST ) 00010 !############################################################# 00011 ! 00012 !!**** *INIT_SURF_ATM_n* - routine to initialize GROUND 00013 !! 00014 !! PURPOSE 00015 !! ------- 00016 !! 00017 !!** METHOD 00018 !! ------ 00019 !! 00020 !! EXTERNAL 00021 !! -------- 00022 !! 00023 !! 00024 !! IMPLICIT ARGUMENTS 00025 !! ------------------ 00026 !! 00027 !! REFERENCE 00028 !! --------- 00029 !! 00030 !! 00031 !! AUTHOR 00032 !! ------ 00033 !! V. Masson *Meteo France* 00034 !! 00035 !! MODIFICATIONS 00036 !! ------------- 00037 !! Original 01/2003 00038 ! (P.Tulet ) 01/11/03 initialisation of the surface chemistry! 00039 !! (D.Gazen) 01/12/03 change emissions handling for surf. externalization 00040 !! (P.LeMoigne) 18/07/05 get 1d mask only if associated tile exists 00041 !! (B.Decharme) 03/2009 New keys read for arrange cover by user 00042 !! (B.Decharme) 04/2009 Read precipitation forcing from the restart file for ARPEGE/ALADIN run 00043 !! (A. Lemonsu) 2009 New key read for urban green areas 00044 !! (B.Decharme) 07/2011 Read pgd+prep 00045 !! (S. Queguiner) 2011 Modif chemistry (2.4) 00046 !------------------------------------------------------------------------------- 00047 ! 00048 !* 0. DECLARATIONS 00049 ! ------------ 00050 ! 00051 USE MODD_READ_NAMELIST, ONLY : LNAM_READ 00052 USE MODD_SURF_CONF, ONLY : CPROGNAME 00053 USE MODD_SURF_ATM, ONLY : XCISMIN, XVMODMIN, LALDTHRES, & 00054 LDRAG_COEF_ARP, LALDZ0H, LNOSOF, & 00055 LRW_PRECIP, XEDB, XEDC, XEDD, XEDK, & 00056 XUSURIC, XUSURID, XUSURICL, & 00057 XVCHRNK, XVZ0CM, XDELTA_MAX, XRIMAX, & 00058 XWINDMIN, LVZIUSTAR0_ARP, & 00059 XRZHZ0M, XVZIUSTAR0, LRRGUST_ARP, & 00060 XRRSCALE, XRRGAMMA, XUTILGUST, LCPL_ARP, & 00061 LQVNPLUS, LVERTSHIFT 00062 USE MODD_SURF_ATM_n, ONLY : CSEA, CWATER, CTOWN, CNATURE, & 00063 XSEA, XWATER, XTOWN, XNATURE, & 00064 NSIZE_SEA, NSIZE_WATER, NSIZE_TOWN, NSIZE_NATURE, & 00065 NR_SEA, NR_WATER, NR_TOWN, NR_NATURE, & 00066 XCOVER, XOUT_TSTEP, TTIME, & 00067 NDIM_FULL, NSIZE_FULL, & 00068 NDIM_NATURE, NDIM_SEA, NDIM_WATER, NDIM_TOWN, & 00069 LECOCLIMAP, LWATER_TO_NATURE, LTOWN_TO_ROCK, & 00070 LGARDEN 00071 USE MODD_SURF_ATM_SSO_n, ONLY : CROUGH, XAOSIP, XAOSIM, XAOSJP, XAOSJM, & 00072 XHO2IP, XHO2IM, XHO2JP, XHO2JM, & 00073 XZ0EFFIP, XZ0EFFIM, XZ0EFFJP, XZ0EFFJM, & 00074 XZ0REL, XZ0EFFJPDIR, XFRACZ0, XCOEFBE 00075 USE MODD_CH_SURF_n, ONLY : CCH_NAMES, LCH_EMIS, LRW_CH_EMIS, & 00076 LCH_SURF_EMIS, CCHEM_SURF_FILE, CAER_NAMES,& 00077 CCH_EMIS 00078 USE MODD_SV_n, ONLY : NBEQ, CSV, NSV_CHSBEG, NSV_CHSEND, & 00079 NSV_DSTBEG, NSV_DSTEND, NDSTEQ, & 00080 NSV_SLTBEG, NSV_SLTEND, NSLTEQ, & 00081 NAEREQ, NSV_AERBEG, NSV_AEREND 00082 USE MODD_DST_SURF, ONLY : NDSTMDE, NDST_MDEBEG, LVARSIG_DST, LRGFIX_DST 00083 USE MODD_SLT_SURF, ONLY : NSLTMDE, NSLT_MDEBEG, LVARSIG_SLT, LRGFIX_SLT 00084 USE MODD_SURF_ATM_GRID_n,ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR, & 00085 NGRID_PAR, XGRID_FULL_PAR 00086 00087 USE MODD_DIAG_SURF_ATM_n,ONLY : N2M, L2M_MIN_ZS, LSURF_BUDGET, & 00088 LRAD_BUDGET, LCOEF, XDIAG_TSTEP, & 00089 LFRAC, LSURF_VARS, LDIAG_GRID, & 00090 LSURF_BUDGETC, LRESET_BUDGETC, & 00091 LPROVAR_TO_DIAG, LSELECT, CSELECT 00092 USE MODD_DATA_COVER_PAR, ONLY : NTILESFC 00093 USE MODD_DATA_COVER, ONLY : LCLIM_LAI, NYEAR, XDATA_LAI_ALL_YEARS, XDATA_LAI, & 00094 NECO2_START_YEAR, NECO2_END_YEAR 00095 ! 00096 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00097 USE MODD_CHS_AEROSOL, ONLY : LVARSIGI, LVARSIGJ 00098 USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE 00099 ! 00100 USE MODD_SURFEX_MPI, ONLY : XTIME_INIT_SEA, XTIME_INIT_WATER, XTIME_INIT_NATURE, XTIME_INIT_TOWN, & 00101 NRANK, NPIO, NWG_LAYER_TOT 00102 USE MODD_SURFEX_OMP, ONLY : NINDX2, NWORK, XWORK, XWORK2 00103 ! 00104 USE MODI_INIT_IO_SURF_n 00105 USE MODI_DEFAULT_SSO 00106 USE MODI_DEFAULT_CH_SURF_ATM 00107 USE MODI_DEFAULT_DIAG_SURF_ATM 00108 USE MODI_READ_DEFAULT_SURF_ATM_n 00109 USE MODI_READ_SURF_ATM_CONF_n 00110 USE MODI_READ_SURF_ATM_DATE 00111 USE MODI_READ_NAM_PREP_SURF_n 00112 USE MODI_READ_SURF 00113 USE MODI_GET_SIZE_FULL_n 00114 USE MODI_READ_COVER_n 00115 USE MODI_READ_SSO_n 00116 USE MODI_SUBSCALE_Z0EFF 00117 USE MODI_READ_SSO_CANOPY_n 00118 USE MODI_READ_DUMMY_n 00119 USE MODI_READ_GRID 00120 USE MODI_READ_GRIDTYPE 00121 USE MODI_END_IO_SURF_n 00122 USE MODI_PREP_CTRL_SURF_ATM 00123 USE MODI_AVERAGE_RAD 00124 USE MODI_WRITE_COVER_TEX_START 00125 USE MODI_WRITE_COVER_TEX_END 00126 USE MODI_INIT_CHEMICAL_n 00127 USE MODI_CH_INIT_DEPCONST 00128 USE MODI_CH_INIT_EMISSION_n 00129 USE MODI_CH_INIT_SNAP_n 00130 USE MODI_OPEN_NAMELIST 00131 USE MODI_CLOSE_NAMELIST 00132 USE MODI_READ_PRECIP_n 00133 USE MODI_ABOR1_SFX 00134 USE MODI_ALLOC_DIAG_SURF_ATM_n 00135 USE MODI_GET_1D_MASK 00136 USE MODI_INI_DATA_COVER 00137 USE MODI_INIT_INLAND_WATER_n 00138 USE MODI_INIT_NATURE_n 00139 USE MODI_INIT_SEA_n 00140 USE MODI_INIT_TOWN_n 00141 USE MODI_READ_ARRANGE_COVER 00142 USE MODI_READ_COVER_GARDEN 00143 USE MODI_READ_ECO2_IRRIG 00144 USE MODI_READ_LCLIM_LAI 00145 USE MODI_READ_LECOCLIMAP 00146 USE MODI_SURF_VERSION 00147 USE MODI_WRITE_COVER_TEX_COVER 00148 USE MODI_GET_LUOUT 00149 USE MODI_SET_SURFEX_FILEIN 00150 ! 00151 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00152 USE PARKIND1 ,ONLY : JPRB 00153 ! 00154 IMPLICIT NONE 00155 ! 00156 #ifndef NOMPI 00157 INCLUDE 'mpif.h' 00158 #endif 00159 ! 00160 !* 0.1 Declarations of arguments 00161 ! ------------------------- 00162 ! 00163 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00164 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize 00165 LOGICAL, INTENT(IN) :: OLAND_USE ! 00166 INTEGER, INTENT(IN) :: KI ! number of points 00167 INTEGER, INTENT(IN) :: KSV ! number of scalars 00168 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00169 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables 00170 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3) 00171 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density 00172 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle 00173 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! solar azimuthal angle (rad from N, clock) 00174 REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band 00175 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band 00176 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band 00177 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity 00178 REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature 00179 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00180 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00181 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00182 REAL, INTENT(IN) :: PTIME ! current time since 00183 ! midnight (UTC, s) 00184 ! 00185 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name 00186 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type 00187 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00188 ! 00189 !* 0.2 Declarations of local variables 00190 ! ------------------------------- 00191 ! 00192 INTEGER :: ISWB ! number of shortwave bands 00193 INTEGER :: JTILE ! loop counter on tiles 00194 INTEGER :: IRESP ! error return code 00195 INTEGER :: ILUOUT ! unit of output listing file 00196 INTEGER :: ICH ! unit of input chemical file 00197 INTEGER :: IVERSION, IBUGFIX ! surface version 00198 ! 00199 REAL, DIMENSION(:,:), ALLOCATABLE :: ZFRAC_TILE ! fraction of each surface type 00200 REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo 00201 REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo 00202 REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE ! emissivity 00203 REAL, DIMENSION(KI,NTILESFC) :: ZTSRAD_TILE ! radiative temperature 00204 ! 00205 REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle 00206 REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle 00207 REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration 00208 REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density 00209 REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo 00210 REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo 00211 REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity 00212 REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative temperature 00213 ! 00214 DOUBLE PRECISION :: XTIME0 00215 ! 00216 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00217 !------------------------------------------------------------------------------- 00218 ! 00219 IF (LHOOK) CALL DR_HOOK('INIT_SURF_ATM_N',0,ZHOOK_HANDLE) 00220 ! 00221 ! 00222 CPROGNAME=HPROGRAM 00223 ! 00224 IF (HTEST/='OK') THEN 00225 CALL ABOR1_SFX('INIT_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER') 00226 END IF 00227 ! 00228 !------------------------------------------------------------------------------- 00229 ! 00230 CALL SURF_VERSION 00231 ! 00232 !------------------------------------------------------------------------------- 00233 ! 00234 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00235 ! 00236 IF (LNAM_READ) THEN 00237 ! 00238 !* 0. Defaults 00239 ! -------- 00240 ! 00241 ! 0.1. Hard defaults 00242 ! 00243 CALL DEFAULT_SSO(CROUGH,XFRACZ0,XCOEFBE) 00244 CALL DEFAULT_CH_SURF_ATM(CCHEM_SURF_FILE,LCH_SURF_EMIS) 00245 CALL DEFAULT_DIAG_SURF_ATM(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET, & 00246 LCOEF,LSURF_VARS,LSURF_BUDGETC, & 00247 LRESET_BUDGETC,LSELECT, LPROVAR_TO_DIAG, & 00248 LDIAG_GRID, LFRAC, XDIAG_TSTEP ) 00249 ! 00250 ENDIF 00251 ! 00252 ! 0.2. Defaults from file header 00253 ! 00254 CALL READ_DEFAULT_SURF_ATM_n(HPROGRAM) 00255 ! 00256 !* 1. Reading of configuration 00257 ! ------------------------ 00258 ! 00259 ! 1.1. general options (diagnostics, etc...) 00260 ! 00261 CALL READ_SURF_ATM_CONF_n(HPROGRAM) 00262 ! 00263 CALL WRITE_COVER_TEX_START(HPROGRAM) 00264 CALL WRITE_COVER_TEX_COVER 00265 ! 00266 ! 1.2. Date 00267 ! 00268 SELECT CASE (HINIT) 00269 CASE ('PGD') 00270 TTIME%TDATE%YEAR = NUNDEF 00271 TTIME%TDATE%MONTH= NUNDEF 00272 TTIME%TDATE%DAY = NUNDEF 00273 TTIME%TIME = XUNDEF 00274 00275 CASE ('PRE') 00276 ! check that diagnostics are off if hinit=='pre' 00277 CALL PREP_CTRL_SURF_ATM(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS, & 00278 LSURF_BUDGETC,LRESET_BUDGETC,LNOWRITE_TEXFILE,LSELECT,ILUOUT,& 00279 LPROVAR_TO_DIAG) 00280 ! preparation of fields (date not present in PGD file) 00281 IF (LNAM_READ) CALL READ_NAM_PREP_SURF_n(HPROGRAM) 00282 CALL READ_SURF_ATM_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,TTIME) 00283 00284 CASE DEFAULT 00285 CALL INIT_IO_SURF_n(HPROGRAM,'FULL ','SURF ','READ ') 00286 CALL READ_SURF(HPROGRAM,'DTCUR',TTIME,IRESP) 00287 CALL END_IO_SURF_n(HPROGRAM) 00288 00289 END SELECT 00290 ! 00291 !----------------------------------------------------------------------------------------------------- 00292 ! READ PGD FILE 00293 !----------------------------------------------------------------------------------------------------- 00294 ! 00295 ! 1.3. Schemes used 00296 ! 00297 ! Initialisation for IO 00298 ! 00299 CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name 00300 CALL INIT_IO_SURF_n(HPROGRAM,'FULL ','SURF ','READ ') 00301 ! 00302 CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP) 00303 CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP) 00304 ! 00305 ! reading 00306 ! 00307 CALL READ_SURF(HPROGRAM,'SEA ',CSEA ,IRESP) 00308 CALL READ_SURF(HPROGRAM,'WATER ',CWATER ,IRESP) 00309 CALL READ_SURF(HPROGRAM,'NATURE',CNATURE,IRESP) 00310 CALL READ_SURF(HPROGRAM,'TOWN ',CTOWN ,IRESP) 00311 ! 00312 CALL READ_SURF(HPROGRAM,'DIM_FULL ',NDIM_FULL, IRESP) 00313 IF (HINIT=='PRE') THEN 00314 NINDX2 = NDIM_FULL 00315 ALLOCATE(NWORK(NDIM_FULL)) 00316 ALLOCATE(XWORK(NDIM_FULL)) 00317 ALLOCATE(XWORK2(NDIM_FULL,2)) 00318 ENDIF 00319 CALL READ_SURF(HPROGRAM,'DIM_SEA ',NDIM_SEA, IRESP) 00320 CALL READ_SURF(HPROGRAM,'DIM_NATURE',NDIM_NATURE,IRESP) 00321 CALL READ_SURF(HPROGRAM,'DIM_WATER ',NDIM_WATER, IRESP) 00322 CALL READ_SURF(HPROGRAM,'DIM_TOWN ',NDIM_TOWN, IRESP) 00323 CALL READ_LECOCLIMAP(HPROGRAM,LECOCLIMAP) 00324 CALL READ_ARRANGE_COVER(HPROGRAM,LWATER_TO_NATURE,LTOWN_TO_ROCK) 00325 CALL READ_COVER_GARDEN(HPROGRAM,LGARDEN) 00326 ! 00327 !* reads if climatological LAI is used or not for ecoclimap2. If not, looks for year to be used. 00328 CALL READ_LCLIM_LAI(HPROGRAM,LCLIM_LAI) 00329 IF (.NOT. LCLIM_LAI .AND. TTIME%TDATE%YEAR >= NECO2_START_YEAR & 00330 .AND. TTIME%TDATE%YEAR <= NECO2_END_YEAR ) NYEAR=TTIME%TDATE%YEAR 00331 CALL INI_DATA_COVER 00332 CALL READ_ECO2_IRRIG(HPROGRAM) 00333 ! 00334 ! 00335 !* 2. Cover fields and grid: 00336 ! --------------------- 00337 ! 00338 ! 2.0. Get number of points on this proc 00339 ! 00340 CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_FULL) 00341 ! 00342 ! 2.1. Read cover 00343 ! 00344 CALL READ_COVER_n(HPROGRAM) 00345 ! 00346 ! 2.2. Read grid 00347 ! 00348 ALLOCATE(XLAT (NSIZE_FULL)) 00349 ALLOCATE(XLON (NSIZE_FULL)) 00350 ALLOCATE(XMESH_SIZE (NSIZE_FULL)) 00351 ALLOCATE(XZ0EFFJPDIR(NSIZE_FULL)) 00352 CALL READ_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP,XZ0EFFJPDIR) 00353 NGRID_PAR=SIZE(XGRID_PAR) 00354 ! 00355 IF (NRANK==NPIO) THEN 00356 ! 00357 IF (.NOT.ASSOCIATED(XGRID_FULL_PAR)) THEN 00358 CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NDIM_FULL,.FALSE.,HDIR='A') 00359 ALLOCATE(XGRID_FULL_PAR(NGRID_PAR)) 00360 CALL READ_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,NDIM_FULL,.TRUE.,& 00361 XGRID_FULL_PAR,IRESP,HDIR='A') 00362 ENDIF 00363 ! 00364 ENDIF 00365 ! 00366 !* 2.4 Allocation of chemical species name, chemical index of HSV array 00367 ! 00368 CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, NBEQ, CSV, NAEREQ, & 00369 NSV_CHSBEG, NSV_CHSEND, NSV_AERBEG, NSV_AEREND, & 00370 CCH_NAMES, CAER_NAMES, NDSTEQ, NSV_DSTBEG, & 00371 NSV_DSTEND, NSLTEQ, NSV_SLTBEG, NSV_SLTEND ) 00372 ! 00373 ! 2.4 Initialize Chemical Emissions 00374 ! 00375 CALL READ_SURF(HPROGRAM,'CH_EMIS',LCH_EMIS,IRESP) 00376 ! 00377 IF (LCH_EMIS) THEN 00378 ! 00379 IF ( IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3 ) THEN 00380 CCH_EMIS='AGGR' 00381 ELSE 00382 CALL READ_SURF(HPROGRAM,'CH_EMIS_OPT',CCH_EMIS,IRESP) 00383 END IF 00384 ! 00385 IF (CCH_EMIS=='AGGR') LRW_CH_EMIS = .TRUE. 00386 ! 00387 IF (NBEQ > 0) THEN 00388 ! 00389 CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=CCHEM_SURF_FILE) 00390 ! 00391 IF (LCH_SURF_EMIS) THEN 00392 IF (CCH_EMIS=='AGGR') THEN 00393 CALL CH_INIT_EMISSION_n(HPROGRAM,NSIZE_FULL,ICH,PRHOA) 00394 ELSE 00395 CALL CH_INIT_SNAP_n(HPROGRAM,NSIZE_FULL,HINIT,ICH,PRHOA) 00396 END IF 00397 ENDIF 00398 ! 00399 !* 2.5 Initialization of dry deposition scheme (chemistry) 00400 ! 00401 IF (HINIT=='ALL') CALL CH_INIT_DEPCONST(ICH,ILUOUT,CSV(NSV_CHSBEG:NSV_CHSEND)) 00402 ! 00403 CALL CLOSE_NAMELIST(HPROGRAM,ICH) 00404 ! 00405 ENDIF 00406 ! 00407 END IF 00408 ! 00409 !* 2.5 Subgrid orography 00410 ! 00411 CALL READ_SSO_n(HPROGRAM) 00412 ! 00413 !* 2.6 Orographic roughness length 00414 ! 00415 ALLOCATE(XZ0EFFIP(NSIZE_FULL)) 00416 ALLOCATE(XZ0EFFIM(NSIZE_FULL)) 00417 ALLOCATE(XZ0EFFJP(NSIZE_FULL)) 00418 ALLOCATE(XZ0EFFJM(NSIZE_FULL)) 00419 ALLOCATE(XZ0REL (NSIZE_FULL)) 00420 ! 00421 CALL SUBSCALE_Z0EFF(XAOSIP,XAOSIM,XAOSJP,XAOSJM, & 00422 XHO2IP,XHO2IM,XHO2JP,XHO2JM,0., & 00423 XZ0EFFIP,XZ0EFFIM,XZ0EFFJP,XZ0EFFJM, & 00424 XZ0REL ) 00425 ! 00426 !* 2.7 Dummy fields 00427 ! 00428 CALL READ_DUMMY_n(HPROGRAM) 00429 ! 00430 ! End of IO 00431 ! 00432 CALL END_IO_SURF_n(HPROGRAM) 00433 CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name 00434 ! 00435 !----------------------------------------------------------------------------------------------------- 00436 ! END READ PGD FILE 00437 !----------------------------------------------------------------------------------------------------- 00438 ! 00439 ! 00440 ! Initialisation for IO 00441 ! 00442 CALL INIT_IO_SURF_n(HPROGRAM,'FULL ','SURF ','READ ') 00443 ! 00444 !* 2.8 Allocations and Initialization of diagnostics 00445 ! 00446 IF (HINIT=='ALL') CALL ALLOC_DIAG_SURF_ATM_n(HPROGRAM,KSW) 00447 ! 00448 ! 00449 !* Canopy fields if Beljaars et al 2004 parameterization is used 00450 ! 00451 IF (CROUGH=='BE04') CALL READ_SSO_CANOPY_n(HPROGRAM,HINIT) 00452 ! 00453 !* Precip fields (for ARPEGE/ALADIN run) 00454 ! 00455 CALL READ_PRECIP_n(HPROGRAM,HINIT) 00456 ! 00457 ! End of IO 00458 ! 00459 CALL END_IO_SURF_n(HPROGRAM) 00460 ! 00461 !----------------------------------------------------------------------------------------------------- 00462 ! 00463 !* 4. Initialization of masks for each surface 00464 ! ---------------------------------------- 00465 ! 00466 !* number of geographical points 00467 NSIZE_NATURE = COUNT(XNATURE(:) > 0.0) 00468 NSIZE_TOWN = COUNT(XTOWN(:) > 0.0) 00469 NSIZE_WATER = COUNT(XWATER(:) > 0.0) 00470 NSIZE_SEA = COUNT(XSEA(:) > 0.0) 00471 ! 00472 ALLOCATE(NR_NATURE (NSIZE_NATURE)) 00473 ALLOCATE(NR_TOWN (NSIZE_TOWN )) 00474 ALLOCATE(NR_WATER (NSIZE_WATER )) 00475 ALLOCATE(NR_SEA (NSIZE_SEA )) 00476 ! 00477 IF (NSIZE_SEA >0)CALL GET_1D_MASK( NSIZE_SEA, NSIZE_FULL, XSEA , NR_SEA ) 00478 IF (NSIZE_WATER >0)CALL GET_1D_MASK( NSIZE_WATER, NSIZE_FULL, XWATER , NR_WATER ) 00479 IF (NSIZE_TOWN >0)CALL GET_1D_MASK( NSIZE_TOWN, NSIZE_FULL, XTOWN , NR_TOWN ) 00480 IF (NSIZE_NATURE>0)CALL GET_1D_MASK( NSIZE_NATURE, NSIZE_FULL, XNATURE, NR_NATURE) 00481 ! 00482 !* number of shortwave spectral bands 00483 ISWB=SIZE(PSW_BANDS) 00484 ! 00485 !* tile number 00486 ALLOCATE(ZFRAC_TILE(NSIZE_FULL,NTILESFC)) 00487 JTILE = 0 00488 ! 00489 ! 00490 !* 5. Default values 00491 ! -------------- 00492 ! 00493 ZDIR_ALB_TILE = XUNDEF 00494 ZSCA_ALB_TILE = XUNDEF 00495 ZEMIS_TILE = XUNDEF 00496 ZTSRAD_TILE = XUNDEF 00497 ! 00498 #ifndef NOMPI 00499 XTIME0 = MPI_WTIME() 00500 #endif 00501 ! 00502 !* 6. Initialization of sea 00503 ! --------------------- 00504 ! 00505 JTILE = JTILE + 1 00506 ZFRAC_TILE(:,JTILE) = XSEA(:) 00507 ! 00508 ! pack variables which are arguments to this routine 00509 CALL PACK_SURF_INIT_ARG(NSIZE_SEA,NR_SEA) 00510 ! 00511 ! initialization 00512 IF (NDIM_SEA>0) & 00513 CALL INIT_SEA_n(HPROGRAM,HINIT,NSIZE_SEA,KSV,KSW, & 00514 HSV,ZP_CO2,ZP_RHOA, & 00515 ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & 00516 ZP_EMIS,ZP_TSRAD, & 00517 KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & 00518 'OK' ) 00519 ! 00520 ! 00521 CALL UNPACK_SURF_INIT_ARG(JTILE,NSIZE_SEA,NR_SEA) 00522 ! 00523 #ifndef NOMPI 00524 XTIME_INIT_SEA = XTIME_INIT_SEA + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_SEA) 00525 XTIME0 = MPI_WTIME() 00526 #endif 00527 ! 00528 !* 7. Initialization of lakes 00529 ! ----------------------- 00530 ! 00531 ! 00532 JTILE = JTILE + 1 00533 ZFRAC_TILE(:,JTILE) = XWATER(:) 00534 ! 00535 ! pack variables which are arguments to this routine 00536 CALL PACK_SURF_INIT_ARG(NSIZE_WATER,NR_WATER) 00537 ! 00538 ! initialization 00539 IF (NDIM_WATER>0) & 00540 CALL INIT_INLAND_WATER_n(HPROGRAM,HINIT,NSIZE_WATER,KSV,KSW, & 00541 HSV,ZP_CO2,ZP_RHOA, & 00542 ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & 00543 ZP_EMIS,ZP_TSRAD, & 00544 KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & 00545 'OK' ) 00546 ! 00547 CALL UNPACK_SURF_INIT_ARG(JTILE,NSIZE_WATER,NR_WATER) 00548 ! 00549 #ifndef NOMPI 00550 XTIME_INIT_WATER = XTIME_INIT_WATER + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_WATER) 00551 XTIME0 = MPI_WTIME() 00552 #endif 00553 ! 00554 !* 8. Initialization of vegetation scheme 00555 ! ----------------------------------- 00556 ! 00557 ! 00558 JTILE = JTILE + 1 00559 ZFRAC_TILE(:,JTILE) = XNATURE(:) 00560 ! 00561 ! pack variables which are arguments to this routine 00562 CALL PACK_SURF_INIT_ARG(NSIZE_NATURE,NR_NATURE) 00563 ! 00564 !$OMP SINGLE 00565 ALLOCATE(NWG_LAYER_TOT(NDIM_FULL,1)) 00566 !$OMP END SINGLE 00567 ! 00568 ! initialization 00569 IF (NDIM_NATURE>0) & 00570 CALL INIT_NATURE_n(HPROGRAM,HINIT,OLAND_USE,NSIZE_NATURE,KSV,KSW, & 00571 HSV,ZP_CO2,ZP_RHOA, & 00572 ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & 00573 ZP_EMIS,ZP_TSRAD, & 00574 KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & 00575 'OK' ) 00576 ! 00577 ! 00578 CALL UNPACK_SURF_INIT_ARG(JTILE,NSIZE_NATURE,NR_NATURE) 00579 ! 00580 #ifndef NOMPI 00581 XTIME_INIT_NATURE = XTIME_INIT_NATURE + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_NATURE) 00582 XTIME0 = MPI_WTIME() 00583 #endif 00584 ! 00585 !* 9. Initialization of urban scheme 00586 ! ------------------------------ 00587 ! 00588 ! 00589 JTILE = JTILE + 1 00590 ZFRAC_TILE(:,JTILE) = XTOWN(:) 00591 ! 00592 ! pack variables which are arguments to this routine 00593 CALL PACK_SURF_INIT_ARG(NSIZE_TOWN,NR_TOWN) 00594 ! 00595 ! initialization 00596 IF (NDIM_TOWN>0) & 00597 CALL INIT_TOWN_n(HPROGRAM,HINIT,NSIZE_TOWN,KSV,KSW, & 00598 HSV,ZP_CO2,ZP_RHOA, & 00599 ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & 00600 ZP_EMIS,ZP_TSRAD, & 00601 KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & 00602 'OK' ) 00603 ! 00604 ! 00605 CALL UNPACK_SURF_INIT_ARG(JTILE,NSIZE_TOWN,NR_TOWN) 00606 ! 00607 #ifndef NOMPI 00608 XTIME_INIT_TOWN = XTIME_INIT_TOWN + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_TOWN) 00609 #endif 00610 ! 00611 ! 00612 !* 10. Output radiative fields 00613 ! ----------------------- 00614 ! 00615 IF (SIZE(PDIR_ALB)>0) & 00616 CALL AVERAGE_RAD(ZFRAC_TILE, & 00617 ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTSRAD_TILE, & 00618 PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) 00619 00620 DEALLOCATE(ZFRAC_TILE) 00621 ! 00622 ! 00623 ! 00624 !* 11. check diagnostics flag 00625 ! ----------------------- 00626 ! 00627 IF(LPROVAR_TO_DIAG)THEN 00628 IF (NDIM_WATER>0.AND.CWATER=='FLAKE ') THEN 00629 CALL ABOR1_SFX('For the moment LPROVAR_TO_DIAG can not be activated with CWATER=FLAKE') 00630 ENDIF 00631 IF (NDIM_TOWN>0.AND.CTOWN=='TEB') THEN 00632 CALL ABOR1_SFX('For the moment LPROVAR_TO_DIAG can not be activated with CTOWN=TEB') 00633 ENDIF 00634 ENDIF 00635 ! 00636 !------------------------------------------------------------------------------- 00637 CALL WRITE_COVER_TEX_END(HPROGRAM) 00638 !------------------------------------------------------------------------------- 00639 !============================================================================== 00640 IF (LHOOK) CALL DR_HOOK('INIT_SURF_ATM_N',1,ZHOOK_HANDLE) 00641 CONTAINS 00642 !============================================================================== 00643 SUBROUTINE PACK_SURF_INIT_ARG(KSIZE,KMASK) 00644 ! 00645 INTEGER, INTENT(IN) :: KSIZE 00646 INTEGER, INTENT(IN), DIMENSION(:) :: KMASK 00647 INTEGER :: JJ 00648 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00649 ! 00650 ! input arguments: 00651 ! 00652 IF (LHOOK) CALL DR_HOOK('PACK_SURF_INIT_ARG',0,ZHOOK_HANDLE) 00653 ALLOCATE(ZP_CO2 (KSIZE)) 00654 ALLOCATE(ZP_RHOA (KSIZE)) 00655 ALLOCATE(ZP_ZENITH (KSIZE)) 00656 ALLOCATE(ZP_AZIM (KSIZE)) 00657 ! 00658 ! 00659 ! output arguments: 00660 ! 00661 ALLOCATE(ZP_DIR_ALB(KSIZE,ISWB)) 00662 ALLOCATE(ZP_SCA_ALB(KSIZE,ISWB)) 00663 ALLOCATE(ZP_EMIS (KSIZE)) 00664 ALLOCATE(ZP_TSRAD (KSIZE)) 00665 ! 00666 IF (KSIZE>0) THEN 00667 ZP_CO2 = 6.E-4 00668 ZP_RHOA = 1.2 00669 ZP_ZENITH = 0. 00670 ZP_AZIM = 0. 00671 ZP_DIR_ALB = XUNDEF 00672 ZP_SCA_ALB = XUNDEF 00673 ZP_EMIS = XUNDEF 00674 ZP_TSRAD = XUNDEF 00675 END IF 00676 ! 00677 DO JJ=1,KSIZE 00678 IF (SIZE(PCO2)>0) & 00679 ZP_CO2 (JJ) = PCO2 (KMASK(JJ)) 00680 IF (SIZE(PRHOA)>0) & 00681 ZP_RHOA (JJ) = PRHOA (KMASK(JJ)) 00682 IF (SIZE(PZENITH)>0) & 00683 ZP_ZENITH(JJ) = PZENITH (KMASK(JJ)) 00684 IF (SIZE(PAZIM )>0) & 00685 ZP_AZIM (JJ) = PAZIM (KMASK(JJ)) 00686 ENDDO 00687 IF (LHOOK) CALL DR_HOOK('PACK_SURF_INIT_ARG',1,ZHOOK_HANDLE) 00688 ! 00689 END SUBROUTINE PACK_SURF_INIT_ARG 00690 !============================================================================== 00691 SUBROUTINE UNPACK_SURF_INIT_ARG(KTILE,KSIZE,KMASK) 00692 ! 00693 INTEGER, INTENT(IN) :: KTILE, KSIZE 00694 ! 00695 INTEGER, INTENT(IN), DIMENSION(:) :: KMASK 00696 ! 00697 INTEGER :: JJ ! loop counter 00698 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00699 ! 00700 ! 00701 IF (LHOOK) CALL DR_HOOK('UNPACK_SURF_INIT_ARG',0,ZHOOK_HANDLE) 00702 DO JJ=1,KSIZE 00703 IF (SIZE(ZTSRAD_TILE)>0) & 00704 ZTSRAD_TILE (KMASK(JJ),KTILE) = ZP_TSRAD (JJ) 00705 IF (SIZE(ZDIR_ALB_TILE)>0) & 00706 ZDIR_ALB_TILE(KMASK(JJ),:,KTILE)= ZP_DIR_ALB (JJ,:) 00707 IF (SIZE(ZSCA_ALB_TILE)>0) & 00708 ZSCA_ALB_TILE(KMASK(JJ),:,KTILE)= ZP_SCA_ALB (JJ,:) 00709 IF (SIZE(ZEMIS_TILE)>0) & 00710 ZEMIS_TILE (KMASK(JJ),KTILE) = ZP_EMIS (JJ) 00711 ENDDO 00712 ! 00713 DEALLOCATE(ZP_CO2 ) 00714 DEALLOCATE(ZP_RHOA ) 00715 DEALLOCATE(ZP_ZENITH ) 00716 DEALLOCATE(ZP_AZIM ) 00717 DEALLOCATE(ZP_DIR_ALB) 00718 DEALLOCATE(ZP_SCA_ALB) 00719 DEALLOCATE(ZP_EMIS ) 00720 DEALLOCATE(ZP_TSRAD ) 00721 IF (LHOOK) CALL DR_HOOK('UNPACK_SURF_INIT_ARG',1,ZHOOK_HANDLE) 00722 ! 00723 END SUBROUTINE UNPACK_SURF_INIT_ARG 00724 !============================================================================== 00725 ! 00726 END SUBROUTINE INIT_SURF_ATM_n
1.8.0
