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 (HSELECT, CHN, HPROGRAM)
!     #######################################################################
!
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
USE modd_ch_snap_n, ONLY : ch_emis_snap_t
!
USE modi_get_luout
USE modi_write_surf
USE modi_write_surf_field2d
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
TYPE(ch_emis_snap_t), INTENT(INOUT) :: CHN
!
 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
!
!*       0.2   declarations of local variables
!
 CHARACTER(LEN=16)  :: YRECFM   ! article name
 CHARACTER(LEN=100) :: YCOMMENT ! comment
 CHARACTER(LEN=100) :: YCOMMENTUNIT   ! Comment string : unit of the datas in the field to write
!
INTEGER             :: IRESP    ! I/O error code
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(hselect, &
                 hprogram,yrecfm,chn%NEMIS_NBR,iresp,ycomment)
yrecfm='SNAP_NBR'
 CALL write_surf(hselect, &
                 hprogram,yrecfm,chn%NEMIS_SNAP,iresp,ycomment)
yrecfm='SNAP_TIME'
 CALL write_surf(hselect, &
                 hprogram,yrecfm,chn%CSNAP_TIME_REF,iresp,ycomment)
!
IF (chn%CSNAP_TIME_REF=='LEGAL') THEN
  yrecfm='LEGALTIME'
  CALL write_surf(hselect, &
                 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(hselect, &
                 hprogram,yrecfm,chn%CEMIS_NAME(jspec),iresp,ycomment)
!
! Writes the temporal profiles of all snaps
  ycommentunit='-'
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_M"
  CALL write_surf_field2d(hselect, hprogram,chn%XSNAP_MONTHLY(:,:,jspec),yrecfm,&
                          ycomment,ycommentunit,hdir='-',hnam_dim="Nemis_snap      ")  
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_D"
  CALL write_surf_field2d(hselect, hprogram,chn%XSNAP_DAILY(:,:,jspec),yrecfm,&
                          ycomment,ycommentunit,hdir='-',hnam_dim="Nemis_snap      ")    
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_H"
  CALL write_surf_field2d(hselect, hprogram,chn%XSNAP_HOURLY(:,:,jspec),yrecfm,&
                          ycomment,ycommentunit,hdir='-',hnam_dim="Nemis_snap      ")    
! Writes the potential emission of species for each snap
  DO jsnap=1,chn%NEMIS_SNAP
    WRITE(yrecfm,'("SN",I2.2,"_",A7)') jsnap,chn%CEMIS_NAME(jspec)
    CALL write_surf(hselect, &
                 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