SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################# 00002 SUBROUTINE INIT_FLAKE_n(HPROGRAM,HINIT, & 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_FLAKE_n* - routine to initialize FLAKE model 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 !! B. Decharme 07/11 : read pgd+prep 00039 !------------------------------------------------------------------------------- 00040 ! 00041 !* 0. DECLARATIONS 00042 ! ------------ 00043 ! 00044 USE MODD_CSTS, ONLY : XTT, XPI, XOMEGA 00045 USE MODD_WATER_PAR, ONLY : XALBWAT, XEMISWAT 00046 !?? USE MODD_SNOW_PAR, ONLY : XANSMAX, XEMISSN 00047 USE MODD_FLAKE_GRID_n, ONLY : XLAT 00048 USE MODD_FLAKE_n, ONLY : XCOVER , TTIME , XTSTEP , & 00049 XOUT_TSTEP , XEMIS , XWATER_DEPTH , & 00050 XWATER_FETCH , XT_BS , XDEPTH_BS , & 00051 XCORIO , XDIR_ALB , XSCA_ALB , & 00052 XICE_ALB , XSNOW_ALB , XEXTCOEF_WATER, & 00053 XEXTCOEF_ICE , XEXTCOEF_SNOW , XT_SNOW , & 00054 XT_ICE , XT_MNW , XT_WML , & 00055 XT_BOT , XT_B1 , XCT , & 00056 XH_SNOW , XH_ICE , XH_ML , & 00057 XH_B1 , XTS , LSEDIMENTS , & 00058 CSNOW_FLK , CFLK_FLUX , CFLK_ALB , & 00059 LSBL , XICHCE , LPRECIP , & 00060 LPWEBB 00061 00062 00063 00064 USE MODD_DIAG_FLAKE_n, ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET, XDIAG_TSTEP, & 00065 L2M_MIN_ZS, LCOEF, LSURF_VARS, LSURF_BUDGETC,& 00066 LRESET_BUDGETC 00067 USE MODD_DIAG_MISC_FLAKE_n, ONLY : LWATER_PROFILE , XZWAT_PROFILE, & 00068 XZW_PROFILE, XTW_PROFILE 00069 USE MODD_CH_WATFLUX_n, ONLY : XDEP, CCH_DRY_DEP, CSV, CCH_NAMES, & 00070 NBEQ, NSV_CHSBEG, NSV_CHSEND, & 00071 NAEREQ, NSV_AERBEG, NSV_AEREND, CAER_NAMES,& 00072 NSV_DSTBEG, NSV_DSTEND, NDSTEQ, CDSTNAMES, & 00073 NSV_SLTBEG, NSV_SLTEND, NSLTEQ, CSLTNAMES 00074 USE MODD_CHS_AEROSOL, ONLY: LVARSIGI, LVARSIGJ 00075 USE MODD_DST_SURF, ONLY: LVARSIG_DST, NDSTMDE, NDST_MDEBEG, LRGFIX_DST 00076 USE MODD_SLT_SURF, ONLY: LVARSIG_SLT, NSLTMDE, NSLT_MDEBEG, LRGFIX_SLT 00077 ! 00078 USE MODD_READ_NAMELIST, ONLY : LNAM_READ 00079 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00080 ! 00081 USE MODI_INIT_IO_SURF_n 00082 USE MODI_DEFAULT_CH_DEP 00083 USE MODI_DEFAULT_FLAKE 00084 USE MODI_DEFAULT_DIAG_FLAKE 00085 USE MODI_READ_DEFAULT_FLAKE_n 00086 USE MODI_READ_FLAKE_CONF_n 00087 USE MODI_READ_FLAKE_n 00088 USE MODI_READ_PGD_FLAKE_n 00089 USE MODI_DIAG_FLAKE_INIT_n 00090 USE MODI_END_IO_SURF_n 00091 USE MODI_GET_LUOUT 00092 USE MODI_READ_SURF 00093 USE MODI_READ_FLAKE_DATE 00094 USE MODI_READ_NAM_PREP_FLAKE_n 00095 USE MODI_INIT_CHEMICAL_n 00096 USE MODI_PREP_CTRL_FLAKE 00097 USE MODI_UPDATE_RAD_SEAWAT 00098 USE MODI_READ_FLAKE_SBL_n 00099 ! 00100 USE MODI_SET_SURFEX_FILEIN 00101 ! 00102 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00103 USE PARKIND1 ,ONLY : JPRB 00104 ! 00105 USE MODI_ABOR1_SFX 00106 ! 00107 USE MODI_GET_TYPE_DIM_n 00108 ! 00109 USE MODI_WRITE_COVER_TEX_WATER 00110 ! 00111 IMPLICIT NONE 00112 ! 00113 !* 0.1 Declarations of arguments 00114 ! ------------------------- 00115 ! 00116 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00117 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize 00118 INTEGER, INTENT(IN) :: KI ! number of points 00119 INTEGER, INTENT(IN) :: KSV ! number of scalars 00120 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00121 CHARACTER(LEN=6), DIMENSION(KI), INTENT(IN) :: HSV ! name of all scalar variables 00122 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3) 00123 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density 00124 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle 00125 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! solar azimuthal angle (rad from N, clock) 00126 REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band 00127 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band 00128 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band 00129 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity 00130 REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature 00131 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00132 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00133 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00134 REAL, INTENT(IN) :: PTIME ! current time since 00135 ! midnight (UTC, s) 00136 ! 00137 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name 00138 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type 00139 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00140 ! 00141 ! 00142 ! 00143 !* 0.2 Declarations of local variables 00144 ! ------------------------------- 00145 ! 00146 ! 00147 INTEGER :: ILU ! sizes of FLAKE arrays 00148 INTEGER :: ILUOUT ! unit of output listing file 00149 INTEGER :: IRESP ! return code 00150 ! 00151 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00152 ! 00153 !------------------------------------------------------------------------------- 00154 ! 00155 00156 ! Initialisation for IO 00157 ! 00158 IF (LHOOK) CALL DR_HOOK('INIT_FLAKE_N',0,ZHOOK_HANDLE) 00159 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00160 ! 00161 IF (HTEST/='OK') THEN 00162 CALL ABOR1_SFX('INIT_FLAKEN: FATAL ERROR DURING ARGUMENT TRANSFER') 00163 END IF 00164 ! 00165 ALLOCATE(XZWAT_PROFILE(100)) 00166 ! 00167 ! Others litlle things 00168 ! 00169 PDIR_ALB = XUNDEF 00170 PSCA_ALB = XUNDEF 00171 PEMIS = XUNDEF 00172 PTSRAD = XUNDEF 00173 ! 00174 IF (LNAM_READ) THEN 00175 ! 00176 !* 0. Defaults 00177 ! -------- 00178 ! 00179 ! 0.1. Hard defaults 00180 ! 00181 CALL DEFAULT_FLAKE(XTSTEP,XOUT_TSTEP,LSEDIMENTS,CSNOW_FLK,CFLK_FLUX,CFLK_ALB,& 00182 XICHCE,LPRECIP,LPWEBB) 00183 CALL DEFAULT_CH_DEP(CCH_DRY_DEP) 00184 CALL DEFAULT_DIAG_FLAKE(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS, & 00185 LWATER_PROFILE,LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP, & 00186 XZWAT_PROFILE ) 00187 ! 00188 ENDIF 00189 ! 00190 ! 0.2. Defaults from file header 00191 ! 00192 CALL READ_DEFAULT_FLAKE_n(HPROGRAM) 00193 00194 ! 00195 !* 1.1 Reading of configuration: 00196 ! ------------------------- 00197 ! 00198 CALL READ_FLAKE_CONF_n(HPROGRAM) 00199 ! 00200 IF (LWATER_PROFILE) THEN 00201 CALL GET_TYPE_DIM_n('WATER ',ILU) 00202 ALLOCATE (XZW_PROFILE(count (XZWAT_PROFILE /= XUNDEF))) 00203 ALLOCATE (XTW_PROFILE(count (XZWAT_PROFILE /= XUNDEF),ILU)) 00204 XZW_PROFILE=XZWAT_PROFILE(:count (XZWAT_PROFILE /= XUNDEF)) 00205 ELSE 00206 ALLOCATE (XZW_PROFILE(1)) 00207 ALLOCATE (XTW_PROFILE(1,1)) 00208 END IF 00209 00210 !------------------------------------------------------------------------------- 00211 ! 00212 !* 1. Cover fields and grid: 00213 ! --------------------- 00214 !* date 00215 ! 00216 SELECT CASE (HINIT) 00217 CASE ('PGD') 00218 TTIME%TDATE%YEAR = NUNDEF 00219 TTIME%TDATE%MONTH= NUNDEF 00220 TTIME%TDATE%DAY = NUNDEF 00221 TTIME%TIME = XUNDEF 00222 00223 CASE ('PRE') 00224 CALL PREP_CTRL_FLAKE(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,& 00225 ILUOUT,LWATER_PROFILE,LSURF_BUDGETC) 00226 IF (LNAM_READ) CALL READ_NAM_PREP_FLAKE_n(HPROGRAM) 00227 CALL READ_FLAKE_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,TTIME) 00228 00229 CASE DEFAULT 00230 CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE ','READ ') 00231 CALL READ_SURF(HPROGRAM,'DTCUR',TTIME,IRESP) 00232 CALL END_IO_SURF_n(HPROGRAM) 00233 END SELECT 00234 ! 00235 !----------------------------------------------------------------------------------------------------- 00236 ! READ PGD FILE 00237 !----------------------------------------------------------------------------------------------------- 00238 ! 00239 ! Initialisation for IO 00240 ! 00241 CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name 00242 CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE ','READ ') 00243 ! 00244 ! Reading of the fields 00245 ! 00246 CALL READ_PGD_FLAKE_n(HPROGRAM) 00247 ! 00248 CALL WRITE_COVER_TEX_WATER 00249 ! 00250 CALL END_IO_SURF_n(HPROGRAM) 00251 CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name 00252 ! 00253 !----------------------------------------------------------------------------------------------------- 00254 ! END READ PGD FILE 00255 !----------------------------------------------------------------------------------------------------- 00256 ! 00257 !* if only physiographic fields are to be initialized, stop here. 00258 ! 00259 IF (HINIT/='ALL') THEN 00260 IF (LHOOK) CALL DR_HOOK('INIT_FLAKE_N',1,ZHOOK_HANDLE) 00261 RETURN 00262 END IF 00263 ! 00264 !------------------------------------------------------------------------------- 00265 ! 00266 !* 2. Prognostic and cover fields: 00267 ! --------------------------- 00268 ! 00269 CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE ','READ ') 00270 ! 00271 CALL READ_FLAKE_n(HPROGRAM) 00272 ! 00273 ILU = SIZE(XCOVER,1) 00274 ! 00275 !------------------------------------------------------------------------------- 00276 ! 00277 !* 3. Specific fields 00278 ! --------------- 00279 ! 00280 ALLOCATE(XCORIO (ILU)) 00281 ALLOCATE(XICE_ALB (ILU)) 00282 ALLOCATE(XSNOW_ALB (ILU)) 00283 ALLOCATE(XEXTCOEF_ICE (ILU)) 00284 ALLOCATE(XEXTCOEF_SNOW (ILU)) 00285 ! 00286 XCORIO(:) = 2*XOMEGA*SIN(XLAT(:)*XPI/180.) 00287 ! 00288 XICE_ALB = XUNDEF 00289 XSNOW_ALB = XUNDEF 00290 XEXTCOEF_ICE = XUNDEF 00291 XEXTCOEF_SNOW = XUNDEF 00292 !------------------------------------------------------------------------------- 00293 ! 00294 !* 4. Albedo, emissivity and radiative fields on lake 00295 ! ----------------------------------------------- 00296 ! 00297 ALLOCATE(XDIR_ALB (ILU)) 00298 ALLOCATE(XSCA_ALB (ILU)) 00299 ALLOCATE(XEMIS (ILU)) 00300 XDIR_ALB = 0.0 00301 XSCA_ALB = 0.0 00302 XEMIS = 0.0 00303 ! 00304 CALL UPDATE_RAD_SEAWAT(CFLK_ALB,XTS,PZENITH,XTT,XEMIS,XDIR_ALB ,& 00305 XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD ) 00306 ! 00307 !------------------------------------------------------------------------------- 00308 ! 00309 !* 6. SBL air fields: 00310 ! -------------- 00311 ! 00312 CALL READ_FLAKE_SBL_n(HPROGRAM) 00313 ! 00314 !------------------------------------------------------------------------------- 00315 ! 00316 !* 6. Chemistry / dust 00317 ! ---------------- 00318 ! 00319 ! 00320 CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, NBEQ, CSV, NAEREQ, & 00321 NSV_CHSBEG, NSV_CHSEND, NSV_AERBEG, NSV_AEREND, & 00322 CCH_NAMES, CAER_NAMES, NDSTEQ, NSV_DSTBEG, & 00323 NSV_DSTEND, NSLTEQ, NSV_SLTBEG, NSV_SLTEND, & 00324 HDSTNAMES=CDSTNAMES, HSLTNAMES=CSLTNAMES ) 00325 ! 00326 !* depositiion scheme 00327 ! 00328 IF (NBEQ>0 .AND. CCH_DRY_DEP=='WES89') THEN 00329 ALLOCATE(XDEP(ILU,NBEQ)) 00330 ELSE 00331 ALLOCATE(XDEP(0,0)) 00332 END IF 00333 ! 00334 !------------------------------------------------------------------------------- 00335 ! 00336 !* 7. diagnostics initialization 00337 ! -------------------------- 00338 ! 00339 CALL DIAG_FLAKE_INIT_n(ILU,KSW) 00340 ! 00341 !------------------------------------------------------------------------------- 00342 !------------------------------------------------------------------------------- 00343 ! 00344 ! End of IO 00345 ! 00346 CALL END_IO_SURF_n(HPROGRAM) 00347 IF (LHOOK) CALL DR_HOOK('INIT_FLAKE_N',1,ZHOOK_HANDLE) 00348 ! 00349 END SUBROUTINE INIT_FLAKE_n