SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/init_flaken.F90
Go to the documentation of this file.
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