diag_seaflux_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_seaflux_init_n (DOC, DGO, D, DC, OREAD_BUDGETC, S, &
                                      HPROGRAM,KLU,KSW)
!     #####################
!
!!****  *DIAG_SEAFLUX_INIT_n* - routine to initialize SEAFLUX diagnostic variables
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004 
!!      Modified    01/2006 : sea flux parameterization.
!!      Modified    08/2009 : cumulative sea flux 
!!      B. decharme 04/2013 : Add EVAP and SUBL diag
!!      S.Senesi    01/2014 : introduce fractional seaice 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_diag
!
USE modd_diag_ocean_n, ONLY : diag_ocean_t
USE modd_diag_n, ONLY : diag_t, diag_options_t
USE modd_seaflux_n, ONLY : seaflux_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
!              -------------------------
!
TYPE(diag_ocean_t), INTENT(INOUT) :: DOC
TYPE(diag_options_t), INTENT(INOUT) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_t), INTENT(INOUT) :: DC
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(seaflux_t), INTENT(INOUT) :: S
!
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
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('DIAG_SEAFLUX_INIT_N',0,zhook_handle)
!
!* surface energy budget
!
 CALL alloc_bud(dgo,d,klu,ksw)
!
IF (dgo%LSURF_BUDGET.OR.dgo%LSURF_BUDGETC) THEN
  !
  ALLOCATE(d%XEVAP   (klu))
  ALLOCATE(d%XSUBL   (klu))
  ALLOCATE(d%XALBT   (klu))  
  !
  d%XEVAP    = xundef
  d%XSUBL    = xundef  
  d%XALBT    = xundef  
  !
ELSE
  !
  ALLOCATE(d%XEVAP   (0))
  ALLOCATE(d%XSUBL   (0))  
  ALLOCATE(d%XALBT   (0)) 
  ! 
ENDIF
!
ALLOCATE(d%XTSRAD(klu))
d%XTSRAD = xundef
!
!* 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
     CALL read_surf(hprogram,'VERSION',iversion,iresp)    
     yrec='RNC_SEA'
     CALL read_surf(hprogram,yrec,dc%XRN,iresp)
     yrec='HC_SEA'
     CALL read_surf(hprogram,yrec,dc%XH,iresp)
     yrec='LEC_SEA'
     CALL read_surf(hprogram,yrec,dc%XLE,iresp)
     yrec='LEIC_SEA'
     CALL read_surf(hprogram,yrec,dc%XLEI,iresp) 
     yrec='GFLUXC_SEA'
     CALL read_surf(hprogram,yrec,dc%XGFLUX,iresp)
     yrec='SWDC_SEA'
     CALL read_surf(hprogram,yrec,dc%XSWD,iresp)
     yrec='SWUC_SEA'
     CALL read_surf(hprogram,yrec,dc%XSWU,iresp)
     yrec='LWDC_SEA'
     CALL read_surf(hprogram,yrec,dc%XLWD,iresp)
     yrec='LWUC_SEA'
     CALL read_surf(hprogram,yrec,dc%XLWU,iresp)
     yrec='FMUC_SEA'
     CALL read_surf(hprogram,yrec,dc%XFMU,iresp)
     yrec='FMVC_SEA'
     CALL read_surf(hprogram,yrec,dc%XFMV,iresp)
     IF (iversion<8)THEN
       dc%XEVAP     = 0.0
       dc%XSUBL     = 0.0              
     ELSE
       !
       yrec='EVAPC_SEA'
       CALL read_surf(hprogram,yrec,dc%XEVAP,iresp)
       yrec='SUBLC_SEA'
       CALL read_surf(hprogram,yrec,dc%XSUBL,iresp)
     ENDIF
  ENDIF   
ELSE
  CALL alloc_surf_bud(dc,0,0,0)
ENDIF
!
!* ocean diag
!
IF (doc%LDIAG_OCEAN) THEN
  ALLOCATE(doc%XTOCMOY  (klu))
  ALLOCATE(doc%XSOCMOY  (klu))
  ALLOCATE(doc%XUOCMOY  (klu))
  ALLOCATE(doc%XVOCMOY  (klu))
  ALLOCATE(doc%XDOCMOY  (klu))
  !
  doc%XTOCMOY(:)=xundef
  doc%XSOCMOY(:)=xundef
  doc%XUOCMOY(:)=xundef
  doc%XVOCMOY(:)=xundef
  doc%XDOCMOY(:)=xundef
ELSE
  ALLOCATE(doc%XTOCMOY  (0))
  ALLOCATE(doc%XSOCMOY  (0))
  ALLOCATE(doc%XUOCMOY  (0))
  ALLOCATE(doc%XVOCMOY  (0))
  ALLOCATE(doc%XDOCMOY  (0))
ENDIF
!
!
!* Earth system model coupling variables
!
IF(lcpl_sea.OR.s%LHANDLE_SIC)THEN
!        
  ALLOCATE(s%XCPL_SEA_WIND(klu))
  ALLOCATE(s%XCPL_SEA_FWSU(klu))
  ALLOCATE(s%XCPL_SEA_FWSV(klu))
  ALLOCATE(s%XCPL_SEA_SNET(klu))
  ALLOCATE(s%XCPL_SEA_HEAT(klu))
  ALLOCATE(s%XCPL_SEA_EVAP(klu))
  ALLOCATE(s%XCPL_SEA_RAIN(klu))
  ALLOCATE(s%XCPL_SEA_SNOW(klu))
  ALLOCATE(s%XCPL_SEA_FWSM(klu))
  s%XCPL_SEA_WIND(:) = 0.0
  s%XCPL_SEA_FWSU(:) = 0.0
  s%XCPL_SEA_FWSV(:) = 0.0
  s%XCPL_SEA_SNET(:) = 0.0
  s%XCPL_SEA_HEAT(:) = 0.0
  s%XCPL_SEA_EVAP(:) = 0.0
  s%XCPL_SEA_RAIN(:) = 0.0
  s%XCPL_SEA_SNOW(:) = 0.0
  s%XCPL_SEA_FWSM(:) = 0.0
!
ELSE
  ALLOCATE(s%XCPL_SEA_WIND(0))
  ALLOCATE(s%XCPL_SEA_FWSU(0))
  ALLOCATE(s%XCPL_SEA_FWSV(0))
  ALLOCATE(s%XCPL_SEA_SNET(0))
  ALLOCATE(s%XCPL_SEA_HEAT(0))
  ALLOCATE(s%XCPL_SEA_EVAP(0))
  ALLOCATE(s%XCPL_SEA_RAIN(0))
  ALLOCATE(s%XCPL_SEA_SNOW(0))
  ALLOCATE(s%XCPL_SEA_FWSM(0))
ENDIF
!
IF (lhook) CALL dr_hook('DIAG_SEAFLUX_INIT_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE diag_seaflux_init_n