init_watfluxn.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_watflux_n (DTCO, OREAD_BUDGETC, UG, U, WM, &
                                 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_WATFLUX_n* - routine to initialize WATFLUX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003
!!      B. Decharme 08/2009 : specific treatment for water/ice in the Earth System Model 
!!      B. Decharme 07/2011 : read pgd+prep 
!!       B.Decharme 04/2013 new coupling variables
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surfex_n, ONLY : watflux_model_t
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_read_namelist,  ONLY : lnam_read
USE modd_sfx_oasis,      ONLY : lcpl_sea, lcpl_seaice
!
USE modd_csts,           ONLY : xtt
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_surf_par,       ONLY : xundef, nundef
!
USE modi_init_io_surf_n
USE modi_default_ch_dep
USE modi_default_watflux
USE modi_default_diag_watflux
USE modi_read_default_watflux_n
USE modi_read_watflux_conf_n
USE modi_read_watflux_n
USE modi_read_pgd_watflux_n
USE modi_diag_watflux_init_n
USE modi_end_io_surf_n
USE modi_get_luout
USE modi_read_surf
USE modi_read_watflux_date
USE modi_read_nam_prep_watflux_n
USE modi_init_chemical_n
USE modi_prep_ctrl
USE modi_update_rad_water
!
USE modi_read_sbl_n
USE modi_set_surfex_filein
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(watflux_model_t), INTENT(INOUT) :: WM
!
 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 WATFLUX 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_WATFLUX_N',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
IF (htest/='OK') THEN
  CALL abor1_sfx('INIT_WATFLUXN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
!         Other little 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_watflux(wm%W%XTSTEP,wm%W%XOUT_TSTEP,wm%W%CWAT_ALB,wm%W%CINTERPOL_TS)
 CALL default_ch_dep(wm%CHW%CCH_DRY_DEP)
 CALL default_diag_watflux(wm%DWO%N2M,wm%DWO%LSURF_BUDGET,wm%DWO%L2M_MIN_ZS,wm%DWO%LRAD_BUDGET,&
                           wm%DWO%LCOEF,wm%DWO%LSURF_VARS, &
                           wm%DWO%LSURF_BUDGETC,wm%DWO%LRESET_BUDGETC,wm%DWO%XDIAG_TSTEP        )  
 !
ENDIF
!
!        0.2. Defaults from file header
!    
 CALL read_default_watflux_n(wm%CHW, wm%DWO, wm%W, hprogram)
!
!*       1.1    Reading of configuration:
!               -------------------------
!
!
 CALL read_watflux_conf_n(wm%CHW, wm%DWO, wm%W, hprogram)
!
wm%W%LINTERPOL_TS=.false.
IF(lcpl_sea)THEN       
! No TS water interpolation in Earth System Model
  wm%W%CINTERPOL_TS='NONE  '
  wm%W%LINTERPOL_TS=.false.
ELSEIF(wm%W%CINTERPOL_TS/='NONE  ')THEN
  wm%W%LINTERPOL_TS=.true.
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       1.     Cover fields and grid:
!               ---------------------
!* date
!
SELECT CASE (hinit)
  CASE ('PGD')
    wm%W%TTIME%TDATE%YEAR = nundef
    wm%W%TTIME%TDATE%MONTH= nundef
    wm%W%TTIME%TDATE%DAY  = nundef
    wm%W%TTIME%TIME       = xundef

  CASE ('PRE')
    CALL prep_ctrl(wm%DWO,iluout )  
    IF (lnam_read) CALL read_nam_prep_watflux_n(hprogram)                 
    CALL read_watflux_date(hprogram,hinit,iluout,hatmfile,hatmfiletype,kyear,kmonth,kday,ptime,wm%W%TTIME)

  CASE DEFAULT
 CALL init_io_surf_n(dtco, u, hprogram,'FULL  ','SURF  ','READ ')
    CALL read_surf(hprogram,'DTCUR',wm%W%TTIME,iresp)
    CALL end_io_surf_n(hprogram)
END SELECT
!
!-----------------------------------------------------------------------------------------------------
! READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
!        1.3. Schemes used
!
!         Initialisation for IO
!
 CALL set_surfex_filein(hprogram,'PGD ') ! change input file name to pgd name
 CALL init_io_surf_n(dtco, u, hprogram,'WATER ','WATFLX','READ ')
!
!         Reading of the fields
!
 CALL read_pgd_watflux_n(dtco, u, ug, wm%G, wm%W, hprogram)
!
!-------------------------------------------------------------------------------
!
!* if only physiographic fields are to be initialized, stop here.
!
!         End of IO
!
 CALL end_io_surf_n(hprogram)
 CALL set_surfex_filein(hprogram,'PREP') ! restore input file name
!
!-----------------------------------------------------------------------------------------------------
! END READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
IF (hinit/='ALL' .AND. hinit/='SOD') THEN
  IF (lhook) CALL dr_hook('INIT_WATFLUX_N',1,zhook_handle)
  RETURN
END IF
!
!-------------------------------------------------------------------------------
!
!         Initialisation for IO
!
 CALL init_io_surf_n(dtco, u, hprogram,'WATER ','WATFLX','READ ')
!
!
!*       2.     Prognostic and cover fields:
!               ---------------------------
!
 CALL read_watflux_n(dtco, u, wm%W, hprogram)
!
IF (hinit/='ALL') THEN
  CALL end_io_surf_n(hprogram)
  IF (lhook) CALL dr_hook('INIT_WATFLUX_N',1,zhook_handle)
  RETURN
END IF
!
ilu = SIZE(wm%W%XCOVER,1)
!
!
!*       3.     Specific fields when using earth system model (Ice temperature)
!               ---------------------------------------------------------------
!
IF(lcpl_seaice)THEN
  ALLOCATE(wm%W%XTICE   (ilu))
  ALLOCATE(wm%W%XICE_ALB(ilu))
  wm%W%XTICE   (:)=xundef
  wm%W%XICE_ALB(:)=xundef
ELSE
  ALLOCATE(wm%W%XTICE   (0))
  ALLOCATE(wm%W%XICE_ALB(0))
ENDIF
!
!*       4.     Albedo, emissivity and temperature fields on open water and ice
!               ---------------------------------------------------------------
!
ALLOCATE(wm%W%XDIR_ALB (ilu))
ALLOCATE(wm%W%XSCA_ALB (ilu))
ALLOCATE(wm%W%XEMIS    (ilu))
wm%W%XDIR_ALB = 0.0
wm%W%XSCA_ALB = 0.0
wm%W%XEMIS    = 0.0
!
 CALL update_rad_water(wm%W,pzenith,xtt,pdir_alb,psca_alb,pemis,ptsrad )  
!
ptsurf(:) = wm%W%XTS(:)
!
!-------------------------------------------------------------------------------
!
!*       5.     SBL air fields:
!               --------------
!
 CALL read_sbl_n(dtco, u, wm%SB, wm%W%LSBL, hprogram, "WATER ")
!
!-------------------------------------------------------------------------------
!
!*       6.     Chemistry / dust
!               ----------------
!
 CALL init_chemical_n(iluout, ksv, hsv, wm%CHW%SVW,         &
                     wm%CHW%CCH_NAMES, wm%CHW%CAER_NAMES,      &
                     hdstnames=wm%CHW%CDSTNAMES, hsltnames=wm%CHW%CSLTNAMES        )
!
!* depositiion scheme
!

IF (wm%CHW%SVW%NBEQ>0 .AND. wm%CHW%CCH_DRY_DEP=='WES89') THEN
  ALLOCATE(wm%CHW%XDEP(ilu,wm%CHW%SVW%NBEQ))
ELSE
  ALLOCATE(wm%CHW%XDEP(0,0))
END IF
!
!-------------------------------------------------------------------------------
!
!*       7.     diagnostics initialization
!               --------------------------
!
 CALL diag_watflux_init_n(oread_budgetc, wm%DWO, wm%DW, wm%DWC, wm%W, &
                          hprogram,ilu,ksw)
!
!-------------------------------------------------------------------------------
!
!         End of IO
!
 CALL end_io_surf_n(hprogram)
IF (lhook) CALL dr_hook('INIT_WATFLUX_N',1,zhook_handle)
!
END SUBROUTINE init_watflux_n