diag_ideal_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_ideal_init_n (DGO, D, DC, HPROGRAM, OREAD_BUDGETC, KLU, KSW)
!     #####################
!
!!****  *DIAG_IDEAL_INIT_n* - routine to initialize IDEAL diagnostic variables
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      P. Le Moigne   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    04/2009 
!!      P. Le Moigne 03/2015: add diagnostics IDEAL case
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_diag
!
USE modd_diag_n, ONLY : diag_t, diag_options_t
!
USE modd_surf_par,   ONLY : xundef
!
USE modi_read_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(diag_options_t), INTENT(INOUT) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_t), INTENT(INOUT) :: DC
!
 CHARACTER(LEN=6), INTENT(IN):: HPROGRAM  ! program calling
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
!
INTEGER, INTENT(IN) :: KLU   ! size of arrays
INTEGER, INTENT(IN) :: KSW   ! spectral bands
!
!*       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_IDEAL_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))
  ALLOCATE(d%XALBT   (klu))
  ALLOCATE(d%XSWE    (klu))  
  !
  d%XEVAP    = xundef
  d%XSUBL    = xundef    
  d%XALBT    = xundef
  d%XSWE     = xundef 
  ! 
ELSE
  !
  ALLOCATE(d%XEVAP   (0))
  ALLOCATE(d%XSUBL   (0))   
  ALLOCATE(d%XALBT   (0))
  ALLOCATE(d%XSWE    (0)) 
  ! 
END IF
!
!* cumulative surface energy budget
!
IF (dgo%LSURF_BUDGETC) THEN
  !   
  CALL alloc_surf_bud(dc,0,klu,0)
  !
  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.
    dc%XSUBL = 0.
  ELSE
    CALL read_surf(hprogram,'VERSION',iversion,iresp)
    IF (iversion<8)THEN
      CALL init_surf_bud(dc,0.) 
      dc%XEVAP = 0.
      dc%XSUBL = 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)
      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 (lhook) CALL dr_hook('DIAG_IDEAL_INIT_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE diag_ideal_init_n