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_mpi, ONLY : nrank
!
USE modd_surfex_n, ONLY : surfex_t
!
USE modn_prep_surf_atm,   ONLY : lwrite_extern
!
USE modd_surf_conf,       ONLY : cprogname
USE modd_surf_par,        ONLY : nversion, nbugfix
USE modd_write_surf_atm,  ONLY : lnowrite_canopy, lsplit_patch
!
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%U, hprogram,'FULL  ','SURF  ','WRITE')
!
lsave_select=ysc%DUO%LSELECT
ysc%DUO%LSELECT     =.false.
!
ycomment='(-)'
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'VERSION',nversion,iresp,ycomment)
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'BUG    ',nbugfix ,iresp,ycomment)
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'STORAGETYPE',hwrite,iresp,ycomment)
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'DIM_FULL  ',ysc%U%NDIM_FULL,iresp,hcomment=ycomment)
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'WRITE_EXT ',lwrite_extern,iresp,hcomment=ycomment)   
!
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'SPLIT_PATCH',lsplit_patch,iresp,hcomment=ycomment)  
!
ycomment='s'
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'DTCUR',ysc%U%TTIME,iresp,ycomment)
!
ysc%DUO%LSELECT=lsave_select
!
 CALL write_grid(ysc%DUO%CSELECT, hprogram,ysc%UG%G%CGRID,ysc%UG%G%XGRID_PAR,&
                 ysc%UG%G%XLAT,ysc%UG%G%XLON,ysc%UG%G%XMESH_SIZE,iresp)
!
 CALL writesurf_atm_conf_n(ysc%CHU, ysc%DUO, ysc%USS, hprogram)
!
IF (hwrite/='PRE') CALL writesurf_sso_canopy_n(ysc%DUO%CSELECT, ysc%SB, hprogram,&
                                (ysc%USS%CROUGH=='BE04' .AND. .NOT. lnowrite_canopy))
!
 CALL writesurf_cpl_gcm_n(ysc%DUO%CSELECT, ysc%U, hprogram)
!
ycomment='flag for accumulated variables'
 CALL write_surf(ysc%DUO%CSELECT, hprogram,'BUDC',ysc%DUO%LSURF_BUDGETC,iresp,hcomment=ycomment)
!
IF (ysc%DUO%LSURF_BUDGETC) THEN
   ycomment='time of beginning of accumulation'
   CALL write_surf(ysc%DUO%CSELECT, hprogram,'TBUDC',ysc%DUO%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%DUO%CSELECT,ysc%U,ysc%SM,hprogram,hwrite)
!
!
!*       4.     Inland water
!               ------------
!
IF (ysc%U%NDIM_WATER>0) CALL write_inland_water_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%U, &
                                                  ysc%WM, ysc%FM, hprogram,hwrite)
!
!
!*       5.     Vegetation scheme
!               -----------------
!
IF (ysc%U%NDIM_NATURE>0) CALL write_nature_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%DUO%LSNOWDIMNC, &
                                             ysc%U, ysc%IM, ysc%NDST, hprogram,hwrite,oland_use)
!
!
!*       6.     Urban scheme
!               ------------
!
IF (ysc%U%NDIM_TOWN>0) CALL write_town_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%DUO%LSNOWDIMNC, &
                                         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