Skip to content
Snippets Groups Projects
Forked from Méso-NH / Méso-NH code
4059 commits behind the upstream repository.
write_surf_atmn.F90 5.37 KiB
!SURFEX_LIC Copyright 1994-2014 Meteo-France 
!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
!     ####################################
      SUBROUTINE WRITE_SURF_ATM_n(HPROGRAM,HWRITE,OLAND_USE)
!     ####################################
!
!!****  *WRITE_SURF_ATM_n* - routine to write surface variables 
!!                           in their respective files or in file
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!	V. Masson   *Meteo France*	
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003
!!      Modified    06/2007, P.LeMoigne: do not write pgd fields in
!!                                       historical files
!!      Modified    03/2009, B.Decharme: keys for arrange cover
!!      Modified    04/2009, B.Decharme: write precipitation forcing into the restart file for ARPEGE/ALADIN run
!       Modified    06/2009, B.Decharme: flag to desactivate writing of horizontal grid 
!       Modified    08/2009, B.Decharme: BUDGETC for all tiles
!       Modified    07/2011, B.Decharme: delete write pgd fields
!       Modified    07/2011, B.Decharme: land_use key for writing semi-prognostic variables
!       Modified    05/2012, B.Decharme: supress LPROVAR_TO_DIAG to write prognostic fields if user want
!       Modified    05/2016, M.Leriche & V.Masson suppress readwrite_ch_emis (only written in pgd step)
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_SURF_CONF,       ONLY : CPROGNAME
USE MODD_SURF_PAR,        ONLY : NVERSION, NBUGFIX
USE MODD_WRITE_SURF_ATM,  ONLY : LNOWRITE_CANOPY
USE MODD_SURF_ATM_n,      ONLY : NDIM_FULL, NDIM_SEA, NDIM_WATER, NDIM_TOWN, NDIM_NATURE, TTIME
USE MODD_SURF_ATM_SSO_n,  ONLY : CROUGH
USE MODD_DIAG_SURF_ATM_n, ONLY : TIME_BUDGETC,LSURF_BUDGETC,LSELECT  
USE MODD_CH_SURF_n,       ONLY : LCH_EMIS, CCH_EMIS
USE MODD_SURF_ATM_GRID_n, ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
USE MODI_WRITE_SEA_n
USE MODI_WRITE_INLAND_WATER_n
USE MODI_WRITE_NATURE_n
USE MODI_WRITE_TOWN_n
USE MODI_END_IO_SURF_n
USE MODI_WRITE_GRID
!
USE MODI_WRITESURF_ATM_CONF_n
USE MODI_WRITESURF_SSO_CANOPY_n
USE MODI_WRITESURF_PRECIP_n
USE MODI_WRITE_DIAG_CH_SNAP_n
!
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARKIND1  ,ONLY : JPRB
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
 CHARACTER(LEN=3),    INTENT(IN)  :: HWRITE    ! 'PREP' : does not write SBL XUNDEF fields
!                                             ! 'ALL' : all fields are written
LOGICAL,             INTENT(IN)  :: OLAND_USE !
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=100) :: YCOMMENT
INTEGER            :: IRESP
LOGICAL            :: LSAVE_SELECT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_SURF_ATM_N',0,ZHOOK_HANDLE)
CPROGNAME = HPROGRAM
!
!*       1.     Configuration and cover fields:
!               ------------------------------
!
!
!         Initialisation for IO
!
 CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
!
LSAVE_SELECT=LSELECT
LSELECT     =.FALSE.
!
YCOMMENT='(-)'
 CALL WRITE_SURF(HPROGRAM,'VERSION',NVERSION,IRESP,YCOMMENT)
 CALL WRITE_SURF(HPROGRAM,'BUG    ',NBUGFIX ,IRESP,YCOMMENT)
 CALL WRITE_SURF(HPROGRAM,'STORAGETYPE',HWRITE,IRESP,YCOMMENT)
 CALL WRITE_SURF(HPROGRAM,'DIM_FULL  ',NDIM_FULL,IRESP,HCOMMENT=YCOMMENT)
!
YCOMMENT='s'
 CALL WRITE_SURF(HPROGRAM,'DTCUR',TTIME,IRESP,YCOMMENT)
!
LSELECT=LSAVE_SELECT
!
 CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP)
!
 CALL WRITESURF_ATM_CONF_n(HPROGRAM)
!
 CALL WRITESURF_SSO_CANOPY_n(HPROGRAM,HWRITE,(CROUGH=='BE04' .AND. .NOT. LNOWRITE_CANOPY))
!
 CALL WRITESURF_PRECIP_n(HPROGRAM)
!
YCOMMENT='flag for accumulated variables'
 CALL WRITE_SURF(HPROGRAM,'BUDC',LSURF_BUDGETC,IRESP,HCOMMENT=YCOMMENT)
!
IF (LSURF_BUDGETC) THEN
   YCOMMENT='time of beginning of accumulation'
   CALL WRITE_SURF(HPROGRAM,'TBUDC',TIME_BUDGETC,IRESP,HCOMMENT=YCOMMENT)   
END IF
!  
!         End of IO
!
 CALL END_IO_SURF_n(HPROGRAM)
!
!
!*       2.     Chemistry
!               ---------
!
IF (LCH_EMIS) THEN
!  IF (CCH_EMIS=='AGGR') THEN 
! put here write diag for agg emission
  IF (CCH_EMIS=='SNAP') THEN
    CALL WRITE_DIAG_CH_SNAP_n(HPROGRAM)
  END IF
END IF
!
!
!*       3.     Sea
!               ---
!
IF (NDIM_SEA>0) CALL WRITE_SEA_n(HPROGRAM,HWRITE)
!
!
!*       4.     Inland water
!               ------------
!
IF (NDIM_WATER>0) CALL WRITE_INLAND_WATER_n(HPROGRAM,HWRITE)
!
!
!*       5.     Vegetation scheme
!               -----------------
!
IF (NDIM_NATURE>0) CALL WRITE_NATURE_n(HPROGRAM,HWRITE,OLAND_USE)
!
!
!*       6.     Urban scheme
!               ------------
!
IF (NDIM_TOWN>0) CALL WRITE_TOWN_n(HPROGRAM,HWRITE)
IF (LHOOK) CALL DR_HOOK('WRITE_SURF_ATM_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE WRITE_SURF_ATM_n