init_flaken.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #############################################################
SUBROUTINE init_flake_n ( DTCO, DGU, UG, U, FM,                 &
                          hprogram,hinit,                            &
                          ki,ksv,ksw,                                &
                          hsv,pco2,prhoa,                            &
                          pzenith,pazim,psw_bands,pdir_alb,psca_alb, &
                          pemis,ptsrad,ptsurf,                       &
                          kyear, kmonth,kday, ptime,                 &
                          hatmfile,hatmfiletype,                     &
                          htest                                     )   
!     #############################################################
!
!!****  *INIT_FLAKE_n* - routine to initialize FLAKE model
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003
!!      B. Decharme    07/11 : read pgd+prep
!!      Modified    04/2013, P. Le Moigne: FLake chemistry
!!      Modified    04/2013, P. Le Moigne: Coupling with AGCM
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_surfex_n, ONLY : flake_model_t
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
!
USE modd_csts,          ONLY : xtt, xpi, xomega 
!
USE modd_water_par,     ONLY : xalbwatice, xalbwatsnow
USE modd_snow_par,      ONLY : xansmin, xansmax
!
!
!
!
USE modd_chs_aerosol,    ONLY: lvarsigi, lvarsigj
USE modd_dst_surf,       ONLY: lvarsig_dst, ndstmde, ndst_mdebeg, lrgfix_dst
USE modd_slt_surf,       ONLY: lvarsig_slt, nsltmde, nslt_mdebeg, lrgfix_slt
!
USE modd_read_namelist,  ONLY : lnam_read
USE modd_surf_par,       ONLY : xundef, nundef
!
USE modi_init_io_surf_n
USE modi_default_ch_dep
USE modi_default_flake
USE modi_default_diag_flake 
USE modi_read_default_flake_n
USE modi_read_flake_conf_n
USE modi_read_flake_n
USE modi_read_pgd_flake_n
USE modi_diag_flake_init_n
USE modi_end_io_surf_n
USE modi_get_luout
USE modi_read_surf
USE modi_read_flake_date
USE modi_read_nam_prep_flake_n
USE modi_init_chemical_n
USE modi_prep_ctrl_flake
USE modi_update_rad_flake
USE modi_read_flake_sbl_n
!
USE modi_set_surfex_filein
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
USE modi_get_type_dim_n
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(flake_model_t), INTENT(INOUT) :: fm
!
 CHARACTER(LEN=6),                 INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=3),                 INTENT(IN)  :: hinit     ! choice of fields to initialize
INTEGER,                          INTENT(IN)  :: ki        ! number of points
INTEGER,                          INTENT(IN)  :: ksv       ! number of scalars
INTEGER,                          INTENT(IN)  :: ksw       ! number of short-wave spectral bands
 CHARACTER(LEN=6), DIMENSION(KI), INTENT(IN)  :: hsv       ! name of all scalar variables
REAL,             DIMENSION(KI),  INTENT(IN)  :: pco2      ! CO2 concentration (kg/m3)
REAL,             DIMENSION(KI),  INTENT(IN)  :: prhoa     ! air density
REAL,             DIMENSION(KI),  INTENT(IN)  :: pzenith   ! solar zenithal angle
REAL,             DIMENSION(KI),  INTENT(IN)  :: pazim     ! solar azimuthal angle (rad from N, clock)
REAL,             DIMENSION(KSW), INTENT(IN)  :: psw_bands ! middle wavelength of each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: pdir_alb  ! direct albedo for each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: psca_alb  ! diffuse albedo for each band
REAL,             DIMENSION(KI),  INTENT(OUT) :: pemis     ! emissivity
REAL,             DIMENSION(KI),  INTENT(OUT) :: ptsrad    ! radiative temperature
REAL,             DIMENSION(KI),  INTENT(OUT) :: ptsurf    ! surface effective temperature         (K)
INTEGER,                          INTENT(IN)  :: kyear     ! current year (UTC)
INTEGER,                          INTENT(IN)  :: kmonth    ! current month (UTC)
INTEGER,                          INTENT(IN)  :: kday      ! current day (UTC)
REAL,                             INTENT(IN)  :: ptime     ! current time since
                                                          !  midnight (UTC, s)
!
 CHARACTER(LEN=28),                INTENT(IN)  :: hatmfile    ! atmospheric file name
 CHARACTER(LEN=6),                 INTENT(IN)  :: hatmfiletype! atmospheric file type
 CHARACTER(LEN=2),                 INTENT(IN)  :: htest       ! must be equal to 'OK'
!
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
!
INTEGER           :: ilu    ! sizes of FLAKE arrays
INTEGER           :: iluout ! unit of output listing file
INTEGER           :: iresp  ! return code
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!

!         Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_FLAKE_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
IF (htest/='OK') THEN
  CALL abor1_sfx('INIT_FLAKEN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
ALLOCATE(fm%DGMF%XZWAT_PROFILE(100))
!
!         Others litlle things
!
pdir_alb = xundef
psca_alb = xundef
pemis    = xundef
ptsrad   = xundef
ptsurf   = xundef
!
IF (lnam_read) THEN
 !
 !*       0.     Defaults
 !               --------
 !
 !        0.1. Hard defaults
 !      
 CALL default_flake(fm%F%XTSTEP,fm%F%XOUT_TSTEP,fm%F%LSEDIMENTS,fm%F%CSNOW_FLK,fm%F%CFLK_FLUX,fm%F%CFLK_ALB,&
                    fm%F%LSKINTEMP)
 CALL default_ch_dep(fm%CHF%CCH_DRY_DEP)
 CALL default_diag_flake(fm%DGF%N2M,fm%DGF%LSURF_BUDGET,fm%DGF%L2M_MIN_ZS,fm%DGF%LRAD_BUDGET,&
                         fm%DGF%LCOEF,fm%DGF%LSURF_VARS, fm%DGMF%LWATER_PROFILE,fm%DGF%LSURF_BUDGETC,&
                         fm%DGF%LRESET_BUDGETC,fm%DGF%XDIAG_TSTEP,fm%DGMF%XZWAT_PROFILE      )  
 !
ENDIF
!
!        0.2. Defaults from file header
!    
 CALL read_default_flake_n(fm%CHF, fm%DGF, fm%DGMF, fm%F, &
                           hprogram)

!
!*       1.1    Reading of configuration:
!               -------------------------
!
 CALL read_flake_conf_n(fm%CHF, fm%DGF, fm%DGMF, fm%F, &
                        hprogram)
!
!-------------------------------------------------------------------------------
!
!*       1.     Cover fields and grid:
!               ---------------------
!* date
!
SELECT CASE (hinit)
  CASE ('PGD')
    fm%F%TTIME%TDATE%YEAR = nundef
    fm%F%TTIME%TDATE%MONTH= nundef
    fm%F%TTIME%TDATE%DAY  = nundef
    fm%F%TTIME%TIME       = xundef

  CASE ('PRE')
    CALL prep_ctrl_flake(fm%DGF%N2M,fm%DGF%LSURF_BUDGET,fm%DGF%L2M_MIN_ZS,fm%DGF%LRAD_BUDGET,&
                         fm%DGF%LCOEF,fm%DGF%LSURF_VARS,iluout,&
                         fm%DGMF%LWATER_PROFILE,fm%DGF%LSURF_BUDGETC) 
    IF (lnam_read) CALL read_nam_prep_flake_n(hprogram)                            
    CALL read_flake_date(&
                         hprogram,hinit,iluout,hatmfile,hatmfiletype,kyear,kmonth,kday,ptime,fm%F%TTIME)

  CASE default
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'WATER ','FLAKE ','READ ')
    CALL read_surf(&
                   hprogram,'DTCUR',fm%F%TTIME,iresp)
    CALL end_io_surf_n(hprogram)
END SELECT
!
!-----------------------------------------------------------------------------------------------------
! READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
!         Initialisation for IO
!
 CALL set_surfex_filein(hprogram,'PGD ') ! change input file name to pgd name
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'WATER ','FLAKE ','READ ')
!
!         Reading of the fields
!
 CALL read_pgd_flake_n(dtco, u, fm%FG, fm%F, &
                       hprogram)
!
 CALL end_io_surf_n(hprogram)
 CALL set_surfex_filein(hprogram,'PREP') ! restore input file name
!
!-----------------------------------------------------------------------------------------------------
! END READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
!* if only physiographic fields are to be initialized, stop here.
!
IF (hinit/='ALL') THEN
  IF (lhook) CALL dr_hook('INIT_FLAKE_N',1,zhook_handle)
  RETURN
END IF
!
!-------------------------------------------------------------------------------
!
!*       2.     Prognostic and cover fields:
!               ---------------------------
!
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'WATER ','FLAKE ','READ ')
!
 CALL read_flake_n(dtco, u, fm%F, &
                   hprogram)
!
ilu = SIZE(fm%F%XCOVER,1)
!
!-------------------------------------------------------------------------------
!
!*       3.     Specific fields 
!               ---------------
!
ALLOCATE(fm%F%XCORIO         (ilu))
ALLOCATE(fm%F%XICE_ALB       (ilu))
ALLOCATE(fm%F%XSNOW_ALB      (ilu))
ALLOCATE(fm%F%XEXTCOEF_ICE   (ilu))
ALLOCATE(fm%F%XEXTCOEF_SNOW  (ilu))
!
fm%F%XCORIO(:) = 2*xomega*sin(fm%FG%XLAT(:)*xpi/180.)
!
fm%F%XICE_ALB  = xalbwatice  ! constant, should be improved latter
fm%F%XSNOW_ALB = xalbwatsnow ! constant, should be improved latter
!
fm%F%XEXTCOEF_ICE  = xundef !not used
fm%F%XEXTCOEF_SNOW = xundef !not used
!-------------------------------------------------------------------------------
!
!*       4.     Albedo, emissivity and radiative fields on lake
!               -----------------------------------------------
!
ALLOCATE(fm%F%XDIR_ALB (ilu))
ALLOCATE(fm%F%XSCA_ALB (ilu))
ALLOCATE(fm%F%XEMIS    (ilu))
fm%F%XDIR_ALB = 0.0
fm%F%XSCA_ALB = 0.0
fm%F%XEMIS    = 0.0
!
 CALL update_rad_flake(fm%F%CFLK_ALB,fm%F%XTS,pzenith,fm%F%XH_ICE,fm%F%XH_SNOW,&
                       fm%F%XICE_ALB,fm%F%XSNOW_ALB,fm%F%XDIR_ALB,fm%F%XSCA_ALB,&
                       fm%F%XEMIS,pdir_alb,psca_alb,pemis,ptsrad  )
!
ptsurf(:) = fm%F%XTS(:)
!
!-------------------------------------------------------------------------------
!
!*       6.     SBL air fields:
!               --------------
!
 CALL read_flake_sbl_n(dtco, u, fm%F, fm%FSB, &
                       hprogram)
!
!-------------------------------------------------------------------------------
!
!*       6.     Chemistry / dust
!               ----------------
!
!
 CALL init_chemical_n(iluout, ksv, hsv, fm%CHF%SVF,    &      
                     fm%CHF%CCH_NAMES, fm%CHF%CAER_NAMES,      &
                     hdstnames=fm%CHF%CDSTNAMES, hsltnames=fm%CHF%CSLTNAMES  )
!
!* depositiion scheme
!
IF (fm%CHF%SVF%NBEQ>0 .AND. fm%CHF%CCH_DRY_DEP=='WES89') THEN
  ALLOCATE(fm%CHF%XDEP(ilu,fm%CHF%SVF%NBEQ))
ELSE
  ALLOCATE(fm%CHF%XDEP(0,0))
END IF
!
!-------------------------------------------------------------------------------
!
!*       7.     diagnostics initialization
!               --------------------------
!
 CALL diag_flake_init_n(dgu, fm%DGF, fm%DGMF, fm%F, &
                        hprogram,ilu,ksw)
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
!         End of IO
!
 CALL end_io_surf_n(hprogram)
IF (lhook) CALL dr_hook('INIT_FLAKE_N',1,zhook_handle)
!
END SUBROUTINE init_flake_n