alloc_diag_surf_atmn.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 alloc_diag_surf_atm_n (DGO, D, DC, ND, NDC, &
                       KSIZE_FULL, TPTIME, HPROGRAM,KSW)
!     #############################################################
!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      Modified    01/2006 : sea flux parameterization.
!!                  08/2009 : TIME_BUDGETC for all Tile
!       B. decharme 09/2012 : XQS_TILE not initialize
!       B. decharme 04/2013 : Add EVAP and SUBL diag
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_diag_n, ONLY : diag_t, diag_np_t, diag_options_t
!
USE modd_data_cover_par, ONLY : ntilesfc
USE modd_surf_par,       ONLY : xundef
!
USE modd_type_date_surf, ONLY : date_time
!
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_np_t), INTENT(INOUT) :: ND
TYPE(diag_np_t), INTENT(INOUT) :: NDC
!
INTEGER, INTENT(IN) :: KSIZE_FULL
TYPE(date_time), INTENT(IN) :: TPTIME
!
 CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM  ! program calling surf. schemes
INTEGER,                 INTENT(IN) :: KSW       ! number of short-wave spectral bands
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER :: JTILE
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('ALLOC_DIAG_SURF_ATM_N',0,zhook_handle)
!
! Initialization: Outputs to atmosphere over each tile:
!
DO jtile = 1,ntilesfc
  !
  CALL alloc_diag(nd%AL(jtile),.false.,ksize_full,ksw)
  CALL init_diag(nd%AL(jtile),.false.,xundef)
  !
ENDDO
!
! Initialization: aggregated fields
!
 CALL alloc_diag(d,.false.,ksize_full,ksw)
 CALL init_diag(d,.false.,xundef)
!
ALLOCATE(d%XSFCO2  (ksize_full))
!
ALLOCATE(d%XT2M_MIN_ZS    (ksize_full))
ALLOCATE(d%XQ2M_MIN_ZS    (ksize_full))
ALLOCATE(d%XHU2M_MIN_ZS   (ksize_full))
!
ALLOCATE(d%XPS            (ksize_full))
ALLOCATE(d%XRHOA          (ksize_full))
!
ALLOCATE(d%XSSO_FMU    (ksize_full))
ALLOCATE(d%XSSO_FMV    (ksize_full))
!
ALLOCATE(d%XUREF  (ksize_full))
ALLOCATE(d%XZREF  (ksize_full))
ALLOCATE(d%XTRAD  (ksize_full))
ALLOCATE(d%XEMIS  (ksize_full))
!
d%XSFCO2   = xundef
!
d%XT2M_MIN_ZS     = xundef
d%XQ2M_MIN_ZS     = xundef
d%XHU2M_MIN_ZS    = xundef
!
d%XPS                 = xundef
d%XRHOA               = xundef
!
d%XSSO_FMU     = xundef
d%XSSO_FMV     = xundef
!
d%XUREF   = xundef
d%XZREF   = xundef
d%XTRAD   = xundef
d%XEMIS   = xundef
!
IF (dgo%LSURF_BUDGETC) THEN
  !
  DO jtile = 1,ntilesfc
    !
    CALL alloc_diag(ndc%AL(jtile),.true.,ksize_full,0)
    CALL init_diag(ndc%AL(jtile),.true.,xundef)
    !
  ENDDO
  !
  CALL alloc_diag(dc,.true.,ksize_full,0)
  !
  yrec='BUDC'
  CALL read_surf(hprogram,yrec,dgo%LREAD_BUDGETC,iresp)
  !
  IF (.NOT. dgo%LREAD_BUDGETC .OR. (dgo%LREAD_BUDGETC.AND.dgo%LRESET_BUDGETC)) THEN
    !
    dgo%TIME_BUDGETC = tptime
    CALL init_diag(dc,.true.,0.0)  
    !
  ELSE
    !
    yrec='TBUDC'
    CALL read_surf(hprogram,yrec,dgo%TIME_BUDGETC,iresp)
    !
    yrec='RNC'
    CALL read_surf(hprogram,yrec,dc%XRN,iresp)
    yrec='HC'
    CALL read_surf(hprogram,yrec,dc%XH ,iresp)
    yrec='LEC'
    CALL read_surf(hprogram,yrec,dc%XLE,iresp)
    yrec='LEIC'
    CALL read_surf(hprogram,yrec,dc%XLEI,iresp)     
    yrec='GFLUXC'
    CALL read_surf(hprogram,yrec,dc%XGFLUX ,iresp)
    !
    yrec='SWDC'
    CALL read_surf(hprogram,yrec,dc%XSWD,iresp)
    yrec='SWUC'
    CALL read_surf(hprogram,yrec,dc%XSWU,iresp)
    yrec='LWDC'
    CALL read_surf(hprogram,yrec,dc%XLWD,iresp)
    yrec='LWUC'
    CALL read_surf(hprogram,yrec,dc%XLWU,iresp)
    !
    yrec='FMUC'
    CALL read_surf(hprogram,yrec,dc%XFMU,iresp)
    yrec='FMVC'
    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'
      CALL read_surf(hprogram,yrec,dc%XEVAP,iresp)
      yrec='SUBLC'
      CALL read_surf(hprogram,yrec,dc%XSUBL,iresp)              
    ENDIF
    !     
  ENDIF
  !
ELSE
  !
  DO jtile=1,ntilesfc
    CALL alloc_diag(ndc%AL(jtile),.true.,0,0)
  ENDDO
  !
  CALL alloc_diag(dc,.true.,0,0)
  !
ENDIF
IF (lhook) CALL dr_hook('ALLOC_DIAG_SURF_ATM_N',1,zhook_handle)
!
CONTAINS
!
SUBROUTINE alloc_diag(DA,OCUM,KSIZE1,KSIZE2)
!
TYPE(diag_t), INTENT(INOUT) :: DA
LOGICAL, INTENT(IN) :: OCUM
INTEGER, INTENT(IN) :: KSIZE1
INTEGER, INTENT(IN) :: KSIZE2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('ALLOC_DIAG_SURF_ATM_N:ALLOC_DIAG',0,zhook_handle)
!
IF (.NOT.ocum) THEN
  !
  ALLOCATE(da%XRI     (ksize1))
  ALLOCATE(da%XCD     (ksize1))
  ALLOCATE(da%XCH     (ksize1))
  ALLOCATE(da%XCE     (ksize1))
  !
  ALLOCATE(da%XT2M    (ksize1))
  ALLOCATE(da%XTS     (ksize1))
  ALLOCATE(da%XT2M_MIN(ksize1))
  ALLOCATE(da%XT2M_MAX(ksize1))
  ALLOCATE(da%XQ2M    (ksize1))
  ALLOCATE(da%XHU2M   (ksize1))
  ALLOCATE(da%XHU2M_MIN(ksize1))
  ALLOCATE(da%XHU2M_MAX(ksize1))
  ALLOCATE(da%XZON10M (ksize1))
  ALLOCATE(da%XMER10M (ksize1))
  !
  ALLOCATE(da%XSWBD   (ksize1,ksize2))
  ALLOCATE(da%XSWBU   (ksize1,ksize2))
  !
  ALLOCATE(da%XQS     (ksize1))
  ALLOCATE(da%XZ0     (ksize1))
  ALLOCATE(da%XZ0H    (ksize1))
  !
  ALLOCATE(da%XWIND10M(ksize1))
  ALLOCATE(da%XWIND10M_MAX(ksize1))
  !  
ELSE
  !
  ALLOCATE(da%XSWBD   (0,0))
  ALLOCATE(da%XSWBU   (0,0))
  !
ENDIF
!
ALLOCATE(da%XRN     (ksize1))
ALLOCATE(da%XH      (ksize1))
ALLOCATE(da%XLE     (ksize1))
ALLOCATE(da%XLEI    (ksize1))
ALLOCATE(da%XGFLUX  (ksize1))
ALLOCATE(da%XEVAP   (ksize1))
ALLOCATE(da%XSUBL   (ksize1))
!
ALLOCATE(da%XSWD    (ksize1))
ALLOCATE(da%XSWU    (ksize1))
!
ALLOCATE(da%XLWD    (ksize1))
ALLOCATE(da%XLWU    (ksize1))
ALLOCATE(da%XFMU    (ksize1))
ALLOCATE(da%XFMV    (ksize1))
!
IF (lhook) CALL dr_hook('ALLOC_DIAG_SURF_ATM_N:ALLOC_DIAG',1,zhook_handle)
!
END SUBROUTINE alloc_diag
!
SUBROUTINE init_diag(DA,OCUM,PVAL)
!
TYPE(diag_t), INTENT(INOUT) :: DA
LOGICAL, INTENT(IN) :: OCUM
REAL, INTENT(IN) :: PVAL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('ALLOC_DIAG_SURF_ATM_N:INIT_DIAG',0,zhook_handle)
!
IF (.NOT.ocum) THEN
  !
  da%XRI      = pval
  da%XCD      = pval
  da%XCH      = pval
  da%XCE      = pval
  !
  da%XT2M     = pval
  da%XTS      = pval
  da%XT2M_MIN = pval
  da%XT2M_MAX = pval
  da%XQ2M     = pval
  da%XHU2M    = pval
  da%XHU2M_MIN= pval
  da%XHU2M_MAX= pval
  da%XZON10M  = pval
  da%XMER10M  = pval
  !
  da%XSWBD    = pval
  da%XSWBU    = pval
  !
  da%XQS      = pval
  da%XZ0      = pval
  da%XZ0H     = pval
  !
  da%XWIND10M = pval
  da%XWIND10M_MAX = pval
  !  
ENDIF
!
da%XRN      = pval
da%XH       = pval
da%XLE      = pval
da%XLEI     = pval
da%XGFLUX   = pval
da%XEVAP    = pval
da%XSUBL    = pval
!
da%XSWD     = pval
da%XSWU     = pval
da%XLWD     = pval
da%XLWU     = pval
da%XFMU     = pval
da%XFMV     = pval
!
IF (lhook) CALL dr_hook('ALLOC_DIAG_SURF_ATM_N:INIT_DIAG',1,zhook_handle)
!
END SUBROUTINE init_diag
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE alloc_diag_surf_atm_n