writesurf_snapn.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 writesurf_snap_n (DGU, U, &
                                    chn, &
                                   hprogram)
!     #######################################################################
!
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_ch_snap_n, ONLY : ch_emis_snap_t
!
USE modi_get_luout
USE modi_write_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
TYPE(ch_emis_snap_t), INTENT(INOUT) :: chn
!
 CHARACTER(LEN=6) :: hprogram
!
!*       0.2   declarations of local variables
!
INTEGER             :: iresp    ! I/O error code
 CHARACTER (LEN=16)  :: yrecfm   ! article name
 CHARACTER (LEN=100) :: ycomment ! comment
INTEGER             :: iluout   ! Unit number for prints
INTEGER             :: jspec    ! Loop index for emission species
INTEGER             :: jsnap    ! Loop index for SNAP categories
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('WRITESURF_SNAP_n',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
!
ycomment = ""
!
yrecfm='EMISPEC_NBR'
 CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%NEMIS_NBR,iresp,ycomment)
yrecfm='SNAP_NBR'
 CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%NEMIS_SNAP,iresp,ycomment)
yrecfm='SNAP_TIME'
 CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%CSNAP_TIME_REF,iresp,ycomment)
!
IF (chn%CSNAP_TIME_REF=='LEGAL') THEN
  yrecfm='LEGALTIME'
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%XDELTA_LEGAL_TIME(:),iresp,ycomment)
END IF
!-------------------------------------------------------------------------------
!
DO jspec=1,chn%NEMIS_NBR
! Writes the name of species
  WRITE(yrecfm,'("EMISNAME",I3.3)') jspec
  ycomment = chn%CEMIS_COMMENT(jspec)
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%CEMIS_NAME(jspec),iresp,ycomment)
!
! Writes the temporal profiles of all snaps
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_M"
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%XSNAP_MONTHLY(:,:,jspec),iresp,ycomment,&
        hdir='-',hnam_dim="Nemis_snap      ")
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_D"
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%XSNAP_DAILY(:,:,jspec),iresp,ycomment,&
        hdir='-',hnam_dim="Nemis_snap        ")
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_H"
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%XSNAP_HOURLY(:,:,jspec),iresp,ycomment,&
        hdir='-',hnam_dim="Nemis_snap       ")
! Writes the potential emission of species for each snap
  DO jsnap=1,chn%NEMIS_SNAP
    WRITE(yrecfm,'("SNAP",I2.2,"_",A3)') jsnap,chn%CEMIS_NAME(jspec)
    CALL write_surf(dgu, u, &
                 hprogram,yrecfm,chn%XEMIS_FIELDS_SNAP(:,jsnap,jspec),iresp,ycomment)
  END DO
!
END DO
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('WRITESURF_SNAP_n',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE writesurf_snap_n