init_seafluxn.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_seaflux_n (DTCO, DGU, UG, U, SM, &
                                 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_SEAFLUX_n* - routine to initialize SEAFLUX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003
!!      Modified    01/2006 : sea flux parameterization.
!!                  01/2008 : coupling with 1D ocean
!!      B. Decharme 08/2009 : specific treatment for sea/ice in the Earth System Model 
!!      B. Decharme 07/2011 : read pgd+prep 
!!      B. Decharme 04/2013 : new coupling variables
!!      S. Senesi   01/2014 : introduce sea-ice model 
!!      S. Belamari 03/2014 : add NZ0 (to choose PZ0SEA formulation)
!!      R. Séférian 01/2015 : introduce interactive ocean surface albedo
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_surfex_n, ONLY : seaflux_model_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_sfx_oasis,      ONLY : lcpl_sea, lcpl_seaice
!
USE modd_read_namelist,  ONLY : lnam_read
USE modd_csts,           ONLY : xtts
USE modd_snow_par,       ONLY : xz0hsn
USE modd_surf_par,       ONLY : xundef, nundef
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 modi_init_io_surf_n
USE modi_default_ch_dep
!
USE modi_default_seaflux
USE modi_default_diag_seaflux
USE modi_read_default_seaflux_n
USE modi_read_seaflux_conf_n
USE modi_read_seaflux_n
!
USE modi_read_ocean_n
!
USE modi_default_seaice
USE modi_read_seaice_n
!
USE modi_read_pgd_seaflux_n
USE modi_diag_seaflux_init_n
USE modi_end_io_surf_n
USE modi_get_luout
USE modi_read_surf
USE modi_read_seaflux_date
USE modi_read_nam_prep_seaflux_n
USE modi_init_chemical_n
USE modi_prep_ctrl_seaflux
USE modi_update_rad_sea
USE modi_read_seaflux_sbl_n
USE modi_abor1_sfx
!
USE modi_set_surfex_filein
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!
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(seaflux_model_t), INTENT(INOUT) :: sm
!
 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(KSV), 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 SEAFLUX 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_SEAFLUX_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
IF (htest/='OK') THEN
  CALL abor1_sfx('INIT_SEAFLUXN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
!
!         Others litlle things
!
pdir_alb = xundef
psca_alb = xundef
pemis    = xundef
ptsrad   = xundef
ptsurf   = xundef
!
sm%O%LMERCATOR = .false.
sm%O%LCURRENT  = .false.
!
IF (lnam_read) THEN
 !
 !*       0.     Defaults
 !               --------
 !
 !        0.1. Hard defaults
 !      
 
 CALL default_seaflux(sm%S%XTSTEP,sm%S%XOUT_TSTEP,sm%S%CSEA_ALB,sm%S%CSEA_FLUX,sm%S%LPWG, &
                      sm%S%LPRECIP,sm%S%LPWEBB,sm%S%NZ0,sm%S%NGRVWAVES,sm%O%LPROGSST,   &
                      sm%O%NTIME_COUPLING,sm%O%XOCEAN_TSTEP,sm%S%XICHCE,sm%S%CINTERPOL_SST,&
                      sm%S%CINTERPOL_SSS                            )
 CALL default_seaice(hprogram,                                   &
                     sm%S%CINTERPOL_SIC,sm%S%CINTERPOL_SIT, sm%S%XFREEZING_SST, &
                     sm%S%XSEAICE_TSTEP, sm%S%XSIC_EFOLDING_TIME,          &
                     sm%S%XSIT_EFOLDING_TIME, sm%S%XCD_ICE_CST, sm%S%XSI_FLX_DRV)     
 !                     
 CALL default_ch_dep(sm%CHS%CCH_DRY_DEP) 
 !            
 CALL default_diag_seaflux(sm%DGS%N2M,sm%DGS%LSURF_BUDGET,sm%DGS%L2M_MIN_ZS,&
                        sm%DGS%LRAD_BUDGET,sm%DGS%LCOEF,sm%DGS%LSURF_VARS,&
                           sm%DGO%LDIAG_OCEAN,sm%DGSI%LDIAG_SEAICE,sm%DGS%LSURF_BUDGETC,&
                          sm%DGS%LRESET_BUDGETC,sm%DGS%XDIAG_TSTEP )  

ENDIF
!
!
!        0.2. Defaults from file header
!    
 CALL read_default_seaflux_n(sm%CHS, sm%DGO, sm%DGS, sm%DGSI, sm%O, sm%S, &
                             hprogram)
!
!*       1.1    Reading of configuration:
!               -------------------------
!
 CALL read_seaflux_conf_n(sm%CHS, sm%DGO, sm%DGS, sm%DGSI, sm%O, sm%S, &
                          hprogram)
!
sm%S%LINTERPOL_SST=.false.
sm%S%LINTERPOL_SSS=.false.
sm%S%LINTERPOL_SIC=.false.
sm%S%LINTERPOL_SIT=.false.
IF(lcpl_sea)THEN 
  IF(sm%DGS%N2M<1)THEN
     CALL abor1_sfx('INIT_SEAFLUX_n: N2M must be set >0 in case of LCPL_SEA')
  ENDIF
! No STT / SSS interpolation in Earth System Model
  sm%S%CINTERPOL_SST='NONE  '
  sm%S%CINTERPOL_SSS='NONE  '
  sm%S%CINTERPOL_SIC='NONE  '
  sm%S%CINTERPOL_SIT='NONE  '
ELSE
   IF(trim(sm%S%CINTERPOL_SST)/='NONE')THEN
      sm%S%LINTERPOL_SST=.true.
   ENDIF
   IF(trim(sm%S%CINTERPOL_SSS)/='NONE')THEN
      sm%S%LINTERPOL_SSS=.true.
   ENDIF
   IF(trim(sm%S%CINTERPOL_SIC)/='NONE')THEN
      sm%S%LINTERPOL_SIC=.true.
   ENDIF
   IF(trim(sm%S%CINTERPOL_SIT)/='NONE')THEN
      sm%S%LINTERPOL_SIT=.true.
   ENDIF
ENDIF
!
!*       1.     Cover fields and grid:
!               ---------------------
!* date
!
SELECT CASE (hinit)
!
  CASE ('PGD')
!
    sm%S%TTIME%TDATE%YEAR = nundef
    sm%S%TTIME%TDATE%MONTH= nundef
    sm%S%TTIME%TDATE%DAY  = nundef
    sm%S%TTIME%TIME       = xundef
!
  CASE ('PRE')
!
    CALL prep_ctrl_seaflux(sm%DGS%N2M,sm%DGS%LSURF_BUDGET,sm%DGS%L2M_MIN_ZS,&
                                sm%DGS%LRAD_BUDGET,sm%DGS%LCOEF,sm%DGS%LSURF_VARS,&
                             sm%DGO%LDIAG_OCEAN,sm%DGSI%LDIAG_SEAICE,iluout,sm%DGS%LSURF_BUDGETC ) 
    IF (lnam_read) CALL read_nam_prep_seaflux_n(hprogram)      
    CALL read_seaflux_date(sm%O, &
                           hprogram,hinit,iluout,hatmfile,hatmfiletype,kyear,kmonth,kday,ptime,sm%S%TTIME)
!
  CASE default
!
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'SEA   ','SEAFLX','READ ')
    CALL read_surf(&
                   hprogram,'DTCUR',sm%S%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,'SEA   ','SEAFLX','READ ')
!
!         Reading of the fields
!
 CALL read_pgd_seaflux_n(dtco, sm%DTS, sm%SG, sm%S, u, &
                         hprogram)
!
 CALL end_io_surf_n(hprogram)
 CALL set_surfex_filein(hprogram,'PREP') ! restore input file name
!-------------------------------------------------------------------------------
!
!* if only physiographic fields are to be initialized, stop here.
!
IF (hinit/='ALL' .AND. hinit/='SOD') THEN
  IF (lhook) CALL dr_hook('INIT_SEAFLUX_N',1,zhook_handle)
  RETURN
END IF
!
!-------------------------------------------------------------------------------
!
!         Initialisation for IO
!
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'SEA   ','SEAFLX','READ ')
!
!*       2.     Prognostic fields:
!               ----------------
!
IF(sm%S%LINTERPOL_SST.OR.sm%S%LINTERPOL_SSS.OR.sm%S%LINTERPOL_SIC.OR.sm%S%LINTERPOL_SIT)THEN
!  Initialize current Month for SST interpolation
   sm%S%TZTIME%TDATE%YEAR  = sm%S%TTIME%TDATE%YEAR
   sm%S%TZTIME%TDATE%MONTH = sm%S%TTIME%TDATE%MONTH
   sm%S%TZTIME%TDATE%DAY   = sm%S%TTIME%TDATE%DAY
   sm%S%TZTIME%TIME        = sm%S%TTIME%TIME        
ENDIF
!
 CALL read_seaflux_n(dtco, sm%SG, sm%S, u, &
                     hprogram,iluout)
!
IF (hinit/='ALL') THEN
  CALL end_io_surf_n(hprogram)
  IF (lhook) CALL dr_hook('INIT_SEAFLUX_N',1,zhook_handle)
  RETURN
END IF
!-------------------------------------------------------------------------------
!
!*       2.1    Ocean fields:
!               -------------
!
 CALL read_ocean_n(dtco, sm%O, sm%OR, u, &
                   hprogram)
!
!-------------------------------------------------------------------------------
!
ilu = SIZE(sm%S%XCOVER,1)
!
ALLOCATE(sm%S%XSST_INI    (ilu))
sm%S%XSST_INI(:) = sm%S%XSST(:)
!
ALLOCATE(sm%S%XZ0H(ilu))
WHERE (sm%S%XSST(:)>=xtts)
  sm%S%XZ0H(:) = sm%S%XZ0(:)
ELSEWHERE
  sm%S%XZ0H(:) = xz0hsn
ENDWHERE
!
!-------------------------------------------------------------------------------
!
!*       3.     Specific fields when using earth system model or sea-ice scheme
!               (Sea current and Sea-ice temperature)
!               -----------------------------------------------------------------
!
IF(lcpl_sea.OR.sm%S%LHANDLE_SIC)THEN       
! 
  ALLOCATE(sm%S%XUMER   (ilu))
  ALLOCATE(sm%S%XVMER   (ilu))
!
  sm%S%XUMER   (:)=xundef
  sm%S%XVMER   (:)=xundef
!
ELSE
! 
  ALLOCATE(sm%S%XUMER   (0))
  ALLOCATE(sm%S%XVMER   (0))
!
ENDIF
!
IF(lcpl_seaice.OR.sm%S%LHANDLE_SIC)THEN       
  ALLOCATE(sm%S%XTICE   (ilu))
  ALLOCATE(sm%S%XICE_ALB(ilu))
  sm%S%XTICE   (:)=xundef
  sm%S%XICE_ALB(:)=xundef
ELSE
  ALLOCATE(sm%S%XTICE   (0))
  ALLOCATE(sm%S%XICE_ALB(0))
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       4.     Seaice prognostic variables and forcings :
!
 CALL read_seaice_n(&
                   sm%SG, sm%S, &
                   hprogram,ilu,iluout)
!
!-------------------------------------------------------------------------------
!
!*       5.     Albedo, emissivity and temperature fields on the mix (open sea + sea ice)
!               -----------------------------------------------------------------
!
ALLOCATE(sm%S%XEMIS    (ilu))
sm%S%XEMIS    = 0.0
!
 CALL update_rad_sea(sm%S%CSEA_ALB,sm%S%XSST,pzenith,xtts,sm%S%XEMIS,sm%S%XDIR_ALB,&
                    sm%S%XSCA_ALB,pdir_alb,psca_alb,pemis,ptsrad,  &
                    sm%S%LHANDLE_SIC,sm%S%XTICE,sm%S%XSIC,sm%S%XICE_ALB           )  
!
IF (sm%S%LHANDLE_SIC) THEN
   ptsurf(:) = sm%S%XSST(:) * ( 1 - sm%S%XSIC(:)) + sm%S%XTICE(:) * sm%S%XSIC(:)
ELSE
   ptsurf(:) = sm%S%XSST(:)
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       6.     SBL air fields:
!               --------------
!
 CALL read_seaflux_sbl_n(dtco, sm%S, sm%SSB, u, &
                         hprogram)
!
!-------------------------------------------------------------------------------
!
!*       7.     Chemistry /dust
!               ---------
!
 CALL init_chemical_n(iluout, ksv, hsv, sm%CHS%SVS,     &
                     sm%CHS%CCH_NAMES, sm%CHS%CAER_NAMES,     &
                     hdstnames=sm%CHS%CDSTNAMES, hsltnames=sm%CHS%CSLTNAMES        )
!
!* deposition scheme
!
IF (sm%CHS%SVS%NBEQ>0 .AND. sm%CHS%CCH_DRY_DEP=='WES89') THEN
  ALLOCATE(sm%CHS%XDEP(ilu,sm%CHS%SVS%NBEQ))
ELSE
  ALLOCATE(sm%CHS%XDEP(0,0))
END IF
!
!-------------------------------------------------------------------------------
!
!*       8.     diagnostics initialization
!               --------------------------
!
IF(.NOT.(sm%S%LHANDLE_SIC.OR.lcpl_seaice))THEN
  sm%DGSI%LDIAG_SEAICE=.false.
ENDIF
!
 CALL diag_seaflux_init_n(&
                         sm%DGO, sm%DGS, sm%DGSI, dgu, sm%S, &
                         hprogram,ilu,ksw)
!
!-------------------------------------------------------------------------------
!
!         End of IO
!
 CALL end_io_surf_n(hprogram)
IF (lhook) CALL dr_hook('INIT_SEAFLUX_N',1,zhook_handle)
!
!
END SUBROUTINE init_seaflux_n