ch_init_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 ch_init_snap_n (&
                                  chn, sv, &
                                 hprogram,klu,hinit,kch,prhoa)
!     #######################################
!
!!****  *CH_INIT_EMIISION_TEMP_n* - routine to initialize chemical emissions data structure
!!
!!    PURPOSE
!!    -------
!       Allocates and initialize emission surface fields
!       by reading their value in initial file.
!
!!**  METHOD
!!    ------
!!    
!!    
!!    AUTHOR
!!    ------
!!      S.QUEGUINER 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original        11/2011
!!      J.Escobar       11/2013 : ajout use MODI_CH_OPEN_INPUTB
!!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
!
!
!
!
USE modd_ch_snap_n, ONLY : ch_emis_snap_t
USE modd_sv_n, ONLY : sv_t
!
USE modd_csts,       ONLY : xavogadro, xmd
USE modi_get_luout
USE modi_read_surf
USE modi_abor1_sfx
USE modi_ch_conversion_factor
USE modi_ch_open_inputb
USE modi_build_pronoslist_n
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!
IMPLICIT NONE
!
!*       0.1   declarations of arguments
!
!
!
!
TYPE(ch_emis_snap_t), INTENT(INOUT) :: chn
TYPE(sv_t), INTENT(INOUT) :: sv
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! Program name
INTEGER,           INTENT(IN)  :: klu      ! number of points
 CHARACTER(LEN=3),  INTENT(IN)  :: hinit    ! Flag to know if one initializes:
!                                          ! 'ALL' : all variables for a run
!                                          ! 'PRE' : only variables to build 
!                                          !         an initial file
INTEGER,           INTENT(IN)  :: kch      ! logical unit of input chemistry file
REAL, DIMENSION(:),INTENT(IN)  :: prhoa    ! air density
!
!*       0.2   declarations of local variables
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ztemp
INTEGER :: isnap
INTEGER             :: iresp                 !   File 
INTEGER             :: iluout                ! output listing logical unit
 CHARACTER (LEN=3)   :: yconversion
 CHARACTER (LEN=16)  :: yrecfm                ! management
 CHARACTER (LEN=100) :: ycomment              ! variables
INTEGER             :: jspec                 ! Loop index for chemical species
INTEGER             :: jsnap                 ! Loop index for SNAP categories
!
 CHARACTER(LEN=40)   :: yspec_name            ! species name
!
INTEGER             :: iversion       ! version of surfex file being read
INTEGER             :: ibug           ! version of SURFEX bugfix
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('CH_INIT_SNAP_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!* ascendant compatibility
yrecfm='VERSION'
 CALL read_surf(&
                hprogram,yrecfm,iversion,iresp)
yrecfm='BUG'
 CALL read_surf(&
                hprogram,yrecfm,ibug,iresp)
!
!*      1.     Chemical Emission snap configuration
!              ------------------------------------
!
! Read the number of emission species and snaps
IF (iversion>7 .OR. (iversion==7 .AND. ibug>=3) ) THEN
  CALL read_surf(&
                hprogram,'EMISPEC_NBR',chn%NEMIS_NBR,iresp)
  CALL read_surf(&
                hprogram,'SNAP_NBR',chn%NEMIS_SNAP,iresp)
  CALL read_surf(&
                hprogram,'SNAP_TIME',chn%CSNAP_TIME_REF,iresp)
ELSE
  CALL abor1_sfx('CH_INIT_SNAPN: NO SNAP EMISSIONS IN SURFEX FILE: FILE TOO OLD')
END IF
!
! Number of instants for each temporal profile.
! For the time being, they are constant (even for the diurnal cycle)
!
 chn%NSNAP_M=12 ! 12 months
 chn%NSNAP_D=7  !  7 day a week
 chn%NSNAP_H=24 ! 24 hours a day (=> temporal resolution = 1 hour)
!
!
!*      2.     Chemical Emission fields
!              ------------------------
!
ALLOCATE(chn%CEMIS_NAME       (               chn%NEMIS_NBR))
ALLOCATE(chn%CEMIS_COMMENT    (               chn%NEMIS_NBR))
ALLOCATE(chn%XEMIS_FIELDS_SNAP(klu,chn%NEMIS_SNAP,chn%NEMIS_NBR))
ALLOCATE(chn%XEMIS_FIELDS     (klu,           chn%NEMIS_NBR))
!
ALLOCATE(chn%XSNAP_MONTHLY(chn%NSNAP_M,chn%NEMIS_SNAP,chn%NEMIS_NBR))
ALLOCATE(chn%XSNAP_DAILY  (chn%NSNAP_D,chn%NEMIS_SNAP,chn%NEMIS_NBR))
ALLOCATE(chn%XSNAP_HOURLY (chn%NSNAP_H,chn%NEMIS_SNAP,chn%NEMIS_NBR))
!
IF (chn%CSNAP_TIME_REF=='LEGAL') THEN
  ALLOCATE(chn%XDELTA_LEGAL_TIME(klu))
  yrecfm='LEGALTIME'
  CALL read_surf(&
                hprogram,yrecfm,chn%XDELTA_LEGAL_TIME(:),iresp,ycomment)
END IF
!
IF (hprogram=="NC    ") THEN
  isnap = max(chn%NSNAP_M,chn%NSNAP_D,chn%NSNAP_H)
  ALLOCATE(ztemp(isnap,chn%NEMIS_SNAP))
ENDIF
!
DO jspec = 1,chn%NEMIS_NBR ! Loop on the number of species
!
! Read the species name
  WRITE(yrecfm,'("EMISNAME",I3.3)') jspec
  CALL read_surf(&
                hprogram,yrecfm,yspec_name,iresp,ycomment)
  chn%CEMIS_COMMENT(jspec)=ycomment
  IF (iresp/=0) THEN
    CALL abor1_sfx('CH_INIT_SNAPN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
  END IF
  WRITE(iluout,*) ' Emission ',jspec,' : ',trim(yspec_name)
  chn%CEMIS_NAME(jspec) = yspec_name(1:12)
! 
! Read  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 read_surf(&
                hprogram,yrecfm,chn%XEMIS_FIELDS_SNAP(:,jsnap,jspec),iresp,ycomment)
  END DO
!
! Read the temporal profiles of all snaps
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_M"
  IF (hprogram=="NC    ") THEN
    CALL read_surf(&
                hprogram,yrecfm,ztemp,iresp,ycomment,hdir='-')
    chn%XSNAP_MONTHLY(:,:,jspec) = ztemp(1:chn%NSNAP_M,:)
  ELSE
    CALL read_surf(&
                hprogram,yrecfm,chn%XSNAP_MONTHLY(:,:,jspec),iresp,ycomment,hdir='-')
  ENDIF
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_D"
  IF (hprogram=="NC    ") THEN
    CALL read_surf(&
                hprogram,yrecfm,ztemp,iresp,ycomment,hdir='-')
    chn%XSNAP_DAILY(:,:,jspec) = ztemp(1:chn%NSNAP_D,:)
  ELSE
    CALL read_surf(&
                hprogram,yrecfm,chn%XSNAP_DAILY(:,:,jspec),iresp,ycomment,hdir='-')
  ENDIF
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_H"
  IF (hprogram=="NC    ") THEN
    CALL read_surf(&
                hprogram,yrecfm,ztemp,iresp,ycomment,hdir='-')
    chn%XSNAP_HOURLY(:,:,jspec) = ztemp(1:chn%NSNAP_H,:)
  ELSE
    CALL read_surf(&
                hprogram,yrecfm,chn%XSNAP_HOURLY(:,:,jspec),iresp,ycomment,hdir='-')
  ENDIF
END DO
!
IF (hprogram=="NC    ") DEALLOCATE(ztemp)
!
!*      3.     Conversion factor
!              -----------------
!
IF (hinit=='ALL') THEN
!$OMP SINGLE        
  CALL ch_open_inputb("EMISUNIT", kch, iluout)
!
! read unit identifier
  READ(kch,'(A3)') yconversion
!$OMP END SINGLE COPYPRIVATE(YCONVERSION)
!
 chn%CCONVERSION = yconversion
!
  ALLOCATE (chn%XCONVERSION(klu))
! determine the conversion factor
  CALL ch_conversion_factor(chn, &
                            chn%CCONVERSION,prhoa)
!
!*      4.     List of emissions to be aggregated into atm. chemical species
!              -------------------------------------------------------------
!
  CALL build_pronoslist_n(sv, &
                          chn%NEMIS_NBR,chn%CEMIS_NAME,chn%TSPRONOSLIST,kch,iluout,6)
!
!-------------------------------------------------------------------------------
END IF
!
IF (lhook) CALL dr_hook('CH_INIT_SNAP_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE ch_init_snap_n