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 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%DGI, ysc%DGU, &
                  .false.,.true.,.false.,.false.)
!
!*       1.     Configuration and cover fields:
!               ------------------------------
!
!
!         Initialisation for IO
!
 CALL init_io_surf_n(ysc%DTCO, ysc%DGU, ysc%U, &
                     hprogram,'FULL  ','SURF  ','WRITE')
!
ywrite='PGD'
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',ywrite,iresp,ycomment)
!
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'SEA   ',ysc%U%CSEA   ,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'WATER ',ysc%U%CWATER ,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'NATURE',ysc%U%CNATURE,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'TOWN  ',ysc%U%CTOWN  ,iresp,ycomment)
!
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DIM_FULL  ',ysc%U%NDIM_FULL,  iresp,hcomment=ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DIM_SEA   ',ysc%U%NDIM_SEA,   iresp,hcomment=ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DIM_NATURE',ysc%U%NDIM_NATURE,iresp,hcomment=ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DIM_WATER ',ysc%U%NDIM_WATER, iresp,hcomment=ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'DIM_TOWN  ',ysc%U%NDIM_TOWN,  iresp,hcomment=ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'ECOCLIMAP ',ysc%U%LECOCLIMAP ,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'WATER_TO_NAT',ysc%U%LWATER_TO_NATURE,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'TOWN_TO_ROCK',ysc%U%LTOWN_TO_ROCK,iresp,ycomment)
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'GARDEN',ysc%U%LGARDEN,iresp,ycomment)
IF (hprogram.NE.'BINARY' .AND. hprogram.NE.'TEXTE ') THEN
   CALL write_ecoclimap2_data(ysc%DGU, ysc%U, &
                              hprogram)
ENDIF
!
 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,ysc%USS%XZ0EFFJPDIR)
!
 CALL writesurf_cover_n(ysc%DGU, &
                        ysc%U, &
                        hprogram)
 CALL writesurf_sso_n(ysc%DGU, ysc%U, &
                      ysc%USS, &
                      hprogram)
 CALL writesurf_dummy_n(ysc%DGU, ysc%U, &
                        ysc%DUU, &
                        hprogram)
!
ycomment='CH_EMIS'
 CALL write_surf(ysc%DGU, ysc%U, &
                 hprogram,'CH_EMIS',ysc%CHU%LCH_EMIS,iresp,hcomment=ycomment)
!
IF (ysc%CHU%LCH_EMIS) THEN
  ycomment='CH_EMIS_OPT'
  CALL write_surf(ysc%DGU, ysc%U, &
                 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%DGU, ysc%U, &
                             ysc%CHE, &
                             hprogram)
  ELSE IF (ysc%CHU%CCH_EMIS=='SNAP') THEN
    CALL writesurf_snap_n(ysc%DGU, ysc%U, &
                          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%DGU, ysc%U, &
                                ysc%SM%DTS, ysc%SM%SG, ysc%SM%S, &
                                           hprogram)
!
!
!*       3.     Inland water
!               ------------
!
IF (ysc%U%NDIM_WATER>0) CALL write_pgd_inland_water_n(ysc%DTCO, ysc%DGU, ysc%U, &
                                                      ysc%WM%WG, ysc%WM%W, ysc%FM%FG, ysc%FM%F, &
                                                      hprogram)
!
!
!*       4.     Vegetation scheme
!               -----------------
!
IF (ysc%U%NDIM_NATURE>0) CALL write_pgd_nature_n(ysc%DTCO, ysc%DGU, ysc%U, &
                                                ysc%IM%DTI, ysc%DTZ, ysc%IM%IG, ysc%IM%I, &
                                                 hprogram)
!
!
!*       5.     Urban scheme
!               ------------
!
IF (ysc%U%NDIM_TOWN>0) CALL write_pgd_town_n(ysc%DTCO, ysc%DGU, 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