diag_flake_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_flake_init_n (OREAD_BUDGETC, DGO, D, DC, DMF, F, &
                                    HPROGRAM,KLU,KSW)
!     #####################
!
!!****  *DIAG_FLAKE_INIT_n* - routine to initialize FLAKE diagnostic variables
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004 
!!       V.Masson   10/2013 Adds min and max 2m parameters
!!      B. Decharme  04/2013 new diag
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_diag
!
USE modd_diag_n, ONLY : diag_t, diag_options_t
USE modd_diag_misc_flake_n, ONLY : diag_misc_flake_t
USE modd_flake_n, ONLY : flake_t
!
#ifdef SFX_OL
USE modn_io_offline,     ONLY : lrestart
#endif
USE modd_surf_par,       ONLY : xundef
USE modd_sfx_oasis,      ONLY : lcpl_lake
!
!
!
!
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
TYPE(diag_misc_flake_t), INTENT(INOUT) :: DMF
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(flake_t), INTENT(INOUT) :: F
!
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_FLAKE_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
!
#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,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
!
!* Flake temperature profile
!
IF (dmf%LWATER_PROFILE) THEN
   ALLOCATE (dmf%XZW_PROFILE(count(dmf%XZWAT_PROFILE/= xundef))) 
   ALLOCATE (dmf%XTW_PROFILE(count(dmf%XZWAT_PROFILE/= xundef),klu)) 
   dmf%XZW_PROFILE=dmf%XZWAT_PROFILE(:count(dmf%XZWAT_PROFILE /= xundef))
 ELSE
   ALLOCATE (dmf%XZW_PROFILE(0)) 
   ALLOCATE (dmf%XTW_PROFILE(0,0)) 
 END IF
!
!* Coupling field with earth systme model
!
IF(lcpl_lake)THEN
  !
  ALLOCATE(f%XCPL_FLAKE_EVAP(klu))
  ALLOCATE(f%XCPL_FLAKE_RAIN(klu))
  ALLOCATE(f%XCPL_FLAKE_SNOW(klu))
  f%XCPL_FLAKE_EVAP(:) = 0.0
  f%XCPL_FLAKE_RAIN(:) = 0.0
  f%XCPL_FLAKE_SNOW(:) = 0.0
  !
ELSE
  !
  ALLOCATE(f%XCPL_FLAKE_EVAP(0))
  ALLOCATE(f%XCPL_FLAKE_RAIN(0))
  ALLOCATE(f%XCPL_FLAKE_SNOW(0))
  !
ENDIF
!
IF (lhook) CALL dr_hook('DIAG_FLAKE_INIT_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE diag_flake_init_n