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, HSV, HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
!     #######################################
!
!!****  *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
!!        M.Moge    01/2016  using READ_SURF_FIELD2D for 2D surfex fields reads
!!      M.Leriche & V. Masson 05/16 move open namelist for reading ascii chemi.file
!!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
USE modd_ch_snap_n, ONLY : ch_emis_snap_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 modi_read_surf_field2d
USE modi_open_namelist
USE modi_close_namelist
!
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
 CHARACTER(LEN=*), DIMENSION(:), POINTER :: HSV
!
 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
REAL, DIMENSION(:),INTENT(IN)  :: PRHOA    ! air density
 CHARACTER(LEN=28), INTENT(IN)  :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
!
!*       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
INTEGER           :: ICH      ! unit of input chemical file
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,'("SN",I2.2,"_",A7)') 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_field2d(hprogram,ztemp,yrecfm,ycomment,hdir='-')          
    chn%XSNAP_MONTHLY(:,:,jspec) = ztemp(1:chn%NSNAP_M,:)
  ELSE
    CALL read_surf_field2d(hprogram,chn%XSNAP_MONTHLY(:,:,jspec),yrecfm,ycomment,hdir='-')          
  ENDIF
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_D"
  IF (hprogram=="NC    ") THEN
    CALL read_surf_field2d(hprogram,ztemp,yrecfm,ycomment,hdir='-')
    chn%XSNAP_DAILY(:,:,jspec) = ztemp(1:chn%NSNAP_D,:)
  ELSE
    CALL read_surf_field2d(hprogram,chn%XSNAP_DAILY(:,:,jspec),yrecfm,ycomment,hdir='-')
  ENDIF
  yrecfm = "E_"//trim(chn%CEMIS_NAME(jspec))//"_H"
  IF (hprogram=="NC    ") THEN
    CALL read_surf_field2d(hprogram,ztemp,yrecfm,ycomment,hdir='-')
    chn%XSNAP_HOURLY(:,:,jspec) = ztemp(1:chn%NSNAP_H,:)
  ELSE
    CALL read_surf_field2d(hprogram,chn%XSNAP_HOURLY(:,:,jspec),yrecfm,ycomment,hdir='-')
  ENDIF
END DO
!
IF (hprogram=="NC    ") DEALLOCATE(ztemp)
!
!*      3.     Conversion factor
!              -----------------
!
IF (hinit=='ALL') THEN
  CALL open_namelist(hprogram,ich,hfile=hchem_surf_file)
  CALL ch_open_inputb("EMISUNIT", ich, iluout)
!
! read unit identifier
  READ(ich,'(A3)') yconversion
!
  chn%CCONVERSION = yconversion
!
  ALLOCATE (chn%XCONVERSION(klu))
! determine the conversion factor
  CALL ch_conversion_factor(chn%XCONVERSION, chn%CCONVERSION,prhoa)
!
!*      4.     List of emissions to be aggregated into atm. chemical species
!              -------------------------------------------------------------
!
  CALL build_pronoslist_n(hsv, chn%NEMIS_NBR,chn%CEMIS_NAME,chn%TSPRONOSLIST,ich,iluout,6)
!
  CALL close_namelist(hprogram,ich)
!-------------------------------------------------------------------------------
END IF
!
IF (lhook) CALL dr_hook('CH_INIT_SNAP_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE ch_init_snap_n