pgd_chemistry_snap.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 pgd_chemistry_snap (CHN, DTCO, UG, U, USS, &
                                     hprogram,och_emis)
!     ##############################################################
!
!!**** *PGD_CHEMISTRY_SNAP* monitor for averaging and interpolations of physiographic fields
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    S; Queguiner        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    09/2011
!!
!!      M.Leriche 04/2014  change length of CHARACTER for emission 6->12
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
!
USE modd_ch_snap_n, ONLY : ch_emis_snap_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
!
USE modd_pgdwork,            ONLY : catype
USE modd_surf_par,           ONLY : xundef
USE modd_pgd_grid,           ONLY : nl
USE modd_ch_surf,            ONLY : jpemismax_s, jpsnapmax
USE modi_get_luout
USE modi_open_namelist
USE modi_close_namelist
!
USE mode_pos_surf
USE modi_pgd_field
USE modi_pgd_snap_temp_profile
USE modi_get_luout
USE modi_abor1_sfx
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(ch_emis_snap_t), INTENT(INOUT) :: chn
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
!
 CHARACTER(LEN=6),    INTENT(IN)    :: hprogram     ! Type of program
LOGICAL,             INTENT(OUT)   :: och_emis     ! emission flag
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER                           :: iluout    ! output listing logical unit
INTEGER                           :: ilunam    ! namelist file logical unit
LOGICAL                           :: gfound    ! flag when namelist is present
INTEGER                           :: jspec     ! loop counter on emission species
INTEGER                           :: jsnap     ! loop counter on SNAP categories
 CHARACTER(LEN=5)                  :: ysnap_time_ref ! to check if all snaps use
!                                                   ! the same time  reference
!
!*    0.3    Declaration of namelists
!            ------------------------
!
REAL(KIND=JPRB) :: zhook_handle
 CHARACTER(LEN=12),  DIMENSION(JPEMISMAX_S):: cemis_name
 CHARACTER(LEN=40), DIMENSION(JPEMISMAX_S):: cemis_comment
 CHARACTER(LEN=28), DIMENSION(JPEMISMAX_S):: csnap_monthly_file
 CHARACTER(LEN=28), DIMENSION(JPEMISMAX_S):: csnap_daily_file
 CHARACTER(LEN=28), DIMENSION(JPEMISMAX_S):: csnap_hourly_file
 CHARACTER(LEN=50), DIMENSION(JPEMISMAX_S,JPSNAPMAX):: csnap_potential_file
 CHARACTER(LEN=6),  DIMENSION(JPEMISMAX_S)          :: csnap_potential_filetype
REAL,              DIMENSION(JPEMISMAX_S,JPSNAPMAX):: xunif_snap
 CHARACTER(LEN=50)                                :: cdelta_legal_time_file
 CHARACTER(LEN=6)                                 :: cdelta_legal_time_filetype
REAL                                             :: xunif_delta_legal_time
INTEGER :: nemis_nbr
INTEGER :: nemis_snap
!
!
namelist/nam_ch_snap_emis_pgd/ nemis_nbr, nemis_snap, cemis_name,&
                               cemis_comment,                    &
                               csnap_monthly_file,               &
                               csnap_daily_file,                 &
                               csnap_hourly_file,                &
                               csnap_potential_file,             &
                               csnap_potential_filetype,         &
                               xunif_snap,                       &
                               xunif_delta_legal_time,           &
                               cdelta_legal_time_file,           &
                               cdelta_legal_time_filetype
 !-------------------------------------------------------------------------------
!
!*    1.      Initializations of defaults
!             ---------------------------
!
!
IF (lhook) CALL dr_hook('PGD_CHEMISTRY_SNAP',0,zhook_handle)
nemis_nbr  = 0
 cemis_name(:)              = '                           '
 cemis_comment(:)           = ''
!
nemis_snap = 0
 chn%NSNAP_M   = 12
 chn%NSNAP_D   = 7
 chn%NSNAP_H   = 24
xunif_snap             = xundef
xunif_delta_legal_time = xundef
 csnap_monthly_file(:)      = '                           '
 csnap_daily_file(:)        = '                           '
 csnap_hourly_file(:)       = '                           '
 csnap_potential_filetype(:)= '      '
 csnap_potential_file(:,:)  = '                           '
 cdelta_legal_time_filetype = '      '
 cdelta_legal_time_file     = '                           '
!
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
!
!*    2.      Reading of namelist
!             -------------------
!
!
 CALL open_namelist(hprogram,ilunam)
!
 CALL posnam(ilunam,'NAM_CH_SNAP_EMIS_PGD',gfound,iluout)
IF (gfound) READ(unit=ilunam,nml=nam_ch_snap_emis_pgd)
!
 CALL close_namelist(hprogram,ilunam)
!
!-------------------------------------------------------------------------------
!
!*    3.      Allocation
!             ----------
!
 chn%NEMIS_NBR  = nemis_nbr
 chn%NEMIS_SNAP = nemis_snap
!
ALLOCATE(chn%CEMIS_NAME(nemis_nbr))
ALLOCATE(chn%CEMIS_COMMENT(nemis_nbr))
!
ALLOCATE(chn%XSNAP_MONTHLY (chn%NSNAP_M,nemis_snap,nemis_nbr))
ALLOCATE(chn%XSNAP_DAILY   (chn%NSNAP_D,nemis_snap,nemis_nbr))
ALLOCATE(chn%XSNAP_HOURLY  (chn%NSNAP_H,nemis_snap,nemis_nbr))
!
 chn%CEMIS_NAME         (:) = cemis_name(1:nemis_nbr)
 chn%CEMIS_COMMENT      (:) = cemis_comment(1:nemis_nbr)
!
ALLOCATE(chn%XEMIS_FIELDS_SNAP(nl,nemis_snap,nemis_nbr))
!
!-------------------------------------------------------------------------------
och_emis = nemis_nbr > 0
!-------------------------------------------------------------------------------
!
!*    4.      Computes Potential maps for each snap and reads temporal profiles
!             -----------------------------------------------------------------
!
ysnap_time_ref = '     '
!
DO jspec=1,nemis_nbr

  CALL pgd_snap_temp_profile('ASCII  ',csnap_monthly_file(jspec),chn%XSNAP_MONTHLY(:,:,jspec),nemis_snap,chn%NSNAP_M)
  CALL pgd_snap_temp_profile('ASCII  ',csnap_daily_file(jspec),  chn%XSNAP_DAILY(:,:,jspec),nemis_snap,chn%NSNAP_D)
  CALL pgd_snap_temp_profile('ASCII  ',csnap_hourly_file(jspec), chn%XSNAP_HOURLY(:,:,jspec), &
                             nemis_snap,chn%NSNAP_H,chn%CSNAP_TIME_REF)

  IF (jspec==1) ysnap_time_ref = chn%CSNAP_TIME_REF
  IF (ysnap_time_ref/=chn%CSNAP_TIME_REF) THEN
    CALL abor1_sfx('ALL SNAP HOURLY PROFILES MUST HAVE THE SAME TIME REFERENCE')
  END IF

  DO jsnap=1,nemis_snap
    catype = 'ARI'
    CALL pgd_field(dtco, ug, u, uss, &
                   hprogram,'SNAP','ALL',csnap_potential_file(jspec,jsnap), &
                   csnap_potential_filetype(jspec),xunif_snap(jspec,jsnap), &
                   chn%XEMIS_FIELDS_SNAP(:,jsnap,jspec)                         )
  ENDDO
ENDDO
!
!-------------------------------------------------------------------------------
!
!*    5.      Computes legal time map if legal time option is used
!             ----------------------------------------------------
!
IF (chn%CSNAP_TIME_REF=='LEGAL') THEN
  ALLOCATE(chn%XDELTA_LEGAL_TIME(nl))
  CALL pgd_field(dtco, ug, u, uss, &
                   hprogram,'LEGAL_TIME','ALL', cdelta_legal_time_file, &
                 cdelta_legal_time_filetype,xunif_delta_legal_time,   &
                 chn%XDELTA_LEGAL_TIME(:)                                 )
  !* conversion from seconds to hours
  !  Beware: 
  !  one uses the fact here that no legal hour increment is less more than 24h. 
  !  Legal hour is either zero (in which case division has no effect) 
  !  or specified unit is second
  WHERE(abs(chn%XDELTA_LEGAL_TIME(:))>=24.) &
  chn%XDELTA_LEGAL_TIME(:) = chn%XDELTA_LEGAL_TIME(:) / 3600.
END IF
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PGD_CHEMISTRY_SNAP',1,zhook_handle)
!
END SUBROUTINE pgd_chemistry_snap