diag_watflux_initn.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 diag_watflux_init_n (OREAD_BUDGETC, DGO, D, DC, W, HPROGRAM,KLU,KSW)
!     #####################
!
!!****  *DIAG_WATFLUX_INIT_n* - routine to initialize WATFLUX diagnostic variables
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004 
!       B. decharme 04/2013 : Add EVAP and SUBL diag
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_diag
!
USE modd_diag_n, ONLY : diag_t, diag_options_t
USE modd_watflux_n, ONLY : watflux_t
!
#ifdef SFX_OL
USE modn_io_offline,     ONLY : lrestart
#endif
USE modd_surf_par,       ONLY : xundef
USE modd_sfx_oasis,      ONLY : lcpl_sea, lcpl_seaice
!
!
USE modi_read_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
!
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(diag_options_t), INTENT(INOUT) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_t), INTENT(INOUT) :: DC
TYPE(watflux_t), INTENT(INOUT) :: W
!
INTEGER, INTENT(IN) :: KLU   ! size of arrays
INTEGER, INTENT(IN) :: KSW   ! number of SW spectral bands
 CHARACTER(LEN=6), INTENT(IN):: HPROGRAM  ! program calling
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: IVERSION
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=12) :: YREC           ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!* surface energy budget
!
IF (lhook) CALL dr_hook('DIAG_WATFLUX_INIT_N',0,zhook_handle)
!
 CALL alloc_bud(dgo,d,klu,ksw)
!
IF (dgo%LSURF_BUDGET.OR.dgo%LSURF_BUDGETC) THEN
  !
  ALLOCATE(d%XEVAP   (klu))
  ALLOCATE(d%XSUBL   (klu))
  d%XEVAP    = xundef
  d%XSUBL    = xundef 
  ! 
ELSE
  !
  ALLOCATE(d%XEVAP   (0))
  ALLOCATE(d%XSUBL   (0))  
  !
END IF
!
!* cumulative surface energy budget
!
#ifdef SFX_OL
IF (dgo%LSURF_BUDGETC .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC)) THEN
#else
IF (dgo%LSURF_BUDGETC .OR. .NOT.dgo%LRESET_BUDGETC) THEN
#endif
  !
  CALL alloc_surf_bud(dc,klu,klu,ksw)
  ALLOCATE(dc%XEVAP (klu))
  ALLOCATE(dc%XSUBL (klu))  
  !
  IF (.NOT. oread_budgetc .OR. oread_budgetc.AND.dgo%LRESET_BUDGETC) THEN 
    CALL init_surf_bud(dc,0.)       
    dc%XEVAP = 0.0
    dc%XSUBL = 0.0
  ELSE
    yrec='RNC_WAT'
    CALL read_surf(hprogram,yrec,dc%XRN,iresp)
    yrec='HC_WAT'
    CALL read_surf(hprogram,yrec,dc%XH,iresp)
    yrec='LEC_WAT'
    CALL read_surf(hprogram,yrec,dc%XLE,iresp)
    yrec='LEIC_WAT'
    CALL read_surf(hprogram,yrec,dc%XLEI,iresp)     
    yrec='GFLUXC_WAT'
    CALL read_surf(hprogram,yrec,dc%XGFLUX,iresp)
    yrec='SWDC_WAT'
    CALL read_surf(hprogram,yrec,dc%XSWD,iresp)
    yrec='SWUC_WAT'
    CALL read_surf(hprogram,yrec,dc%XSWU,iresp)
    yrec='LWDC_WAT'
    CALL read_surf(hprogram,yrec,dc%XLWD,iresp)
    yrec='LWUC_WAT'
    CALL read_surf(hprogram,yrec,dc%XLWU,iresp)
    yrec='FMUC_WAT'
    CALL read_surf(hprogram,yrec,dc%XFMU,iresp)
    yrec='FMVC_WAT'
    CALL read_surf(hprogram,yrec,dc%XFMV,iresp)
!
    CALL read_surf(hprogram,'VERSION',iversion,iresp)
    IF (iversion<8)THEN
      dc%XEVAP = 0.0
      dc%XSUBL = 0.0              
    ELSE
      yrec='EVAPC_WAT'
      CALL read_surf(hprogram,yrec,dc%XEVAP,iresp)
      yrec='SUBLC_WAT'
      CALL read_surf(hprogram,yrec,dc%XSUBL,iresp)              
    ENDIF
    !
  ENDIF
  !
ELSE
  CALL alloc_surf_bud(dc,0,0,0)
  ALLOCATE(dc%XEVAP (0))
  ALLOCATE(dc%XSUBL (0)) 
ENDIF
!
IF(lcpl_sea)THEN
!        
  ALLOCATE(w%XCPL_WATER_WIND(klu))
  ALLOCATE(w%XCPL_WATER_FWSU(klu))
  ALLOCATE(w%XCPL_WATER_FWSV(klu))
  ALLOCATE(w%XCPL_WATER_SNET(klu))
  ALLOCATE(w%XCPL_WATER_HEAT(klu))
  ALLOCATE(w%XCPL_WATER_EVAP(klu))
  ALLOCATE(w%XCPL_WATER_RAIN(klu))
  ALLOCATE(w%XCPL_WATER_SNOW(klu))
  ALLOCATE(w%XCPL_WATER_FWSM(klu))
  w%XCPL_WATER_WIND(:) = 0.0
  w%XCPL_WATER_FWSU(:) = 0.0
  w%XCPL_WATER_FWSV(:) = 0.0
  w%XCPL_WATER_SNET(:) = 0.0
  w%XCPL_WATER_HEAT(:) = 0.0
  w%XCPL_WATER_EVAP(:) = 0.0
  w%XCPL_WATER_RAIN(:) = 0.0
  w%XCPL_WATER_SNOW(:) = 0.0        
  w%XCPL_WATER_FWSM(:) = 0.0
!
ELSE
  ALLOCATE(w%XCPL_WATER_WIND(0))
  ALLOCATE(w%XCPL_WATER_FWSU(0))
  ALLOCATE(w%XCPL_WATER_FWSV(0))
  ALLOCATE(w%XCPL_WATER_SNET(0))
  ALLOCATE(w%XCPL_WATER_HEAT(0))
  ALLOCATE(w%XCPL_WATER_EVAP(0))
  ALLOCATE(w%XCPL_WATER_RAIN(0))
  ALLOCATE(w%XCPL_WATER_SNOW(0))
  ALLOCATE(w%XCPL_WATER_FWSM(0))
ENDIF
!
IF(lcpl_seaice)THEN
  ALLOCATE(w%XCPL_WATERICE_SNET(klu))
  ALLOCATE(w%XCPL_WATERICE_HEAT(klu))
  ALLOCATE(w%XCPL_WATERICE_EVAP(klu))
  w%XCPL_WATERICE_SNET(:) = 0.0
  w%XCPL_WATERICE_HEAT(:) = 0.0
  w%XCPL_WATERICE_EVAP(:) = 0.0
ELSE
  ALLOCATE(w%XCPL_WATERICE_SNET(0))
  ALLOCATE(w%XCPL_WATERICE_HEAT(0))
  ALLOCATE(w%XCPL_WATERICE_EVAP(0))
ENDIF
IF (lhook) CALL dr_hook('DIAG_WATFLUX_INIT_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE diag_watflux_init_n