write_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 write_surf_atm_n (YSC, &
                                   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/2013, B.Decharme: WRITESURF_PRECIP becomes WRITESURF_CPL_GCM
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_surfex_n, ONLY : surfex_t
!
USE modd_surf_conf,       ONLY : cprogname
USE modd_surf_par,        ONLY : nversion, nbugfix
USE modd_write_surf_atm,  ONLY : lnowrite_canopy
!
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_cpl_gcm_n
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(surfex_t), INTENT(INOUT) :: ysc
!
 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(ysc%DTCO, ysc%DGU, ysc%U, &
                        hprogram,'FULL  ','SURF  ','WRITE')
!
lsave_select=ysc%DGU%LSELECT
ysc%DGU%LSELECT     =.false.
!
ycomment='(-)'
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'VERSION',nversion,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'BUG    ',nbugfix ,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'STORAGETYPE',hwrite,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DIM_FULL  ',ysc%U%NDIM_FULL,iresp,hcomment=ycomment)
!
ycomment='s'
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DTCUR',ysc%U%TTIME,iresp,ycomment)
!
ysc%DGU%LSELECT=lsave_select
!
 CALL write_grid(ysc%DGU, ysc%U, &
                 hprogram,ysc%UG%CGRID,ysc%UG%XGRID_PAR,ysc%UG%XLAT,ysc%UG%XLON,ysc%UG%XMESH_SIZE,iresp)
!
 CALL writesurf_atm_conf_n(ysc%CHU, ysc%DGU, ysc%USS, &
                           hprogram)
!
IF (hwrite/='PRE') CALL writesurf_sso_canopy_n(ysc%DGU, ysc%U, &
                                               ysc%SSCP, &
                                               hprogram,(ysc%USS%CROUGH=='BE04' .AND. .NOT. lnowrite_canopy))
!
 CALL writesurf_cpl_gcm_n(ysc%DGU, &
                          ysc%U, &
                          hprogram)
!
ycomment='flag for accumulated variables'
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'BUDC',ysc%DGU%LSURF_BUDGETC,iresp,hcomment=ycomment)
!
IF (ysc%DGU%LSURF_BUDGETC) THEN
   ycomment='time of beginning of accumulation'
   CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'TBUDC',ysc%DGU%TIME_BUDGETC,iresp,hcomment=ycomment)   
END IF
!  
!         End of IO
!
 CALL end_io_surf_n(hprogram)
!
!*       3.     Sea
!               ---
!
IF (ysc%U%NDIM_SEA>0) CALL write_sea_n(ysc%DTCO, ysc%DGU, ysc%U, ysc%SM, &
                                       hprogram,hwrite)
!
!
!*       4.     Inland water
!               ------------
!
IF (ysc%U%NDIM_WATER>0) CALL write_inland_water_n(ysc%DTCO, ysc%DGU, ysc%U, ysc%WM, ysc%FM,  &
                                                  hprogram,hwrite)
!
!
!*       5.     Vegetation scheme
!               -----------------
!
IF (ysc%U%NDIM_NATURE>0) CALL write_nature_n(ysc%DTCO, ysc%DGU, ysc%U, ysc%IM, ysc%DST, &
                                         hprogram,hwrite,oland_use)
!
!
!*       6.     Urban scheme
!               ------------
!
IF (ysc%U%NDIM_TOWN>0) CALL write_town_n(ysc%DTCO, ysc%DGU, ysc%U, ysc%TM, ysc%GDM, ysc%GRM, &
                                         hprogram,hwrite)
!
IF (lhook) CALL dr_hook('WRITE_SURF_ATM_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE write_surf_atm_n