write_pgd_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_pgd_surf_atm_n (YSC, HPROGRAM)
!     ####################################
!
!!****  *WRITE_PGD_SURF_ATM_n* - routine to write pgd surface variables 
!!                               in their respective files or in file
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    05/2011 according to previous write_surf_atmn.f90
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_surfex_n, ONLY : surfex_t
!
USE modd_surf_conf,       ONLY : cprogname
USE modd_surf_par,        ONLY : nversion, nbugfix
USE modd_io_surf_fa,      ONLY : lfanocompact
!
USE modd_write_surf_atm, ONLY : lsplit_patch
!
USE modi_init_io_surf_n
USE modi_write_surf
USE modi_write_pgd_sea_n
USE modi_write_pgd_inland_water_n
USE modi_write_pgd_nature_n
USE modi_write_pgd_town_n
USE modi_end_io_surf_n
!
USE modi_flag_update
!
USE modi_writesurf_cover_n
USE modi_writesurf_sso_n
USE modi_writesurf_dummy_n
USE modi_writesurf_snap_n
USE modi_writesurf_ch_emis_n
USE modi_write_grid
!
USE modi_write_ecoclimap2_data
!
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
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=3)   :: YWRITE
 CHARACTER(LEN=100) :: YCOMMENT
INTEGER            :: IRESP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('WRITE_PGD_SURF_ATM_N',0,zhook_handle)
!
!*       0.     Initialize some options:
!               ------------------------
!
CPROGNAME = HPROGRAM
!
 CALL flag_update(ysc%IM%ID%O, ysc%DUO, .false.,.true.,.false.,.false.)
!
!*       1.     Configuration and cover fields:
!               ------------------------------
!
!
!         Initialisation for IO
!
 CALL init_io_surf_n(ysc%DTCO, ysc%U, hprogram,'FULL  ','SURF  ','WRITE')
!
ywrite='PGD'
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',ywrite,iresp,ycomment)
!
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'SPLIT_PATCH',lsplit_patch,iresp,ycomment)
!
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'SEA   ',ysc%U%CSEA   ,iresp,ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'WATER ',ysc%U%CWATER ,iresp,ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'NATURE',ysc%U%CNATURE,iresp,ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'TOWN  ',ysc%U%CTOWN  ,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,'DIM_SEA   ',ysc%U%NDIM_SEA,   iresp,hcomment=ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'DIM_NATURE',ysc%U%NDIM_NATURE,iresp,hcomment=ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'DIM_WATER ',ysc%U%NDIM_WATER, iresp,hcomment=ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'DIM_TOWN  ',ysc%U%NDIM_TOWN,  iresp,hcomment=ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'ECOCLIMAP ',ysc%U%LECOCLIMAP ,iresp,ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'ECOSG     ',ysc%U%LECOSG ,iresp,ycomment) 
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'WATER_TO_NAT',ysc%U%LWATER_TO_NATURE,iresp,ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'TOWN_TO_ROCK',ysc%U%LTOWN_TO_ROCK,iresp,ycomment)
 CALL write_surf( ysc%DUO%CSELECT, hprogram,'GARDEN',ysc%U%LGARDEN,iresp,ycomment)
IF (hprogram.NE.'BINARY' .AND. hprogram.NE.'TEXTE ') THEN
   CALL write_ecoclimap2_data( ysc%DUO%CSELECT,  hprogram)
ENDIF
!
 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_cover_n(ysc%DUO%CSELECT, ysc%U, hprogram)
 CALL writesurf_sso_n(ysc%DUO%CSELECT, ysc%USS, hprogram)
 CALL writesurf_dummy_n(ysc%DUO%CSELECT, ysc%DUU, hprogram)
!
ycomment='CH_EMIS'
 CALL write_surf( ysc%DUO%CSELECT,  &
                 hprogram,'CH_EMIS',ysc%CHU%LCH_EMIS,iresp,hcomment=ycomment)
!
IF (ysc%CHU%LCH_EMIS) THEN
  ycomment='CH_EMIS_OPT'
  CALL write_surf( ysc%DUO%CSELECT,  &
                 hprogram,'CH_EMIS_OPT',ysc%CHU%CCH_EMIS,iresp,hcomment=ycomment)
END IF
!
IF (ysc%CHU%LCH_EMIS) THEN
  IF (ysc%CHU%CCH_EMIS=='AGGR') THEN
    CALL writesurf_ch_emis_n(ysc%DUO%CSELECT, ysc%CHE, hprogram)
  ELSE IF (ysc%CHU%CCH_EMIS=='SNAP') THEN
    CALL writesurf_snap_n(ysc%DUO%CSELECT, ysc%CHN, hprogram)
  ENDIF
ENDIF
!
!         End of IO
!
 CALL end_io_surf_n(hprogram)
!
!
!*       2.     Sea
!               ---
!
IF (ysc%U%NDIM_SEA>0) CALL write_pgd_sea_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%U,  &
                                ysc%SM%DTS, ysc%SM%G, ysc%SM%S, hprogram)
!
!
!*       3.     Inland water
!               ------------
!
IF (ysc%U%NDIM_WATER>0) CALL write_pgd_inland_water_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%U, &
                                                      ysc%WM%G, ysc%WM%W, ysc%FM%G, ysc%FM%F, &
                                                      hprogram)
!
!
!*       4.     Vegetation scheme
!               -----------------
!
IF (ysc%U%NDIM_NATURE>0) CALL write_pgd_nature_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%U,  &
                                                 ysc%DTZ, ysc%IM, hprogram)
!
!
!*       5.     Urban scheme
!               ------------
!
IF (ysc%U%NDIM_TOWN>0) CALL write_pgd_town_n(ysc%DTCO, ysc%DUO%CSELECT, ysc%U, &
                                             ysc%TM, ysc%GDM, ysc%GRM, hprogram)
!
!
IF (lhook) CALL dr_hook('WRITE_PGD_SURF_ATM_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE write_pgd_surf_atm_n