ch_init_emissionn.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_emission_n (CHE, CHU, SV, &
                                     hprogram,klu,kch,prhoa)
!     #######################################
!
!!****  *CH_INIT_EMIISION_n* - routine to initialize chemical emissions data structure
!!
!!    PURPOSE
!!    -------
!       Allocates and initialize emission surface fields
!       by reading their value in initial file.
!
!!**  METHOD
!!    ------
!!    
!!    
!!    AUTHOR
!!    ------
!!      D. Gazen       * L.A. *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original        08/03/2001
!!      D.Gazen  01/12/03  change emissions handling for surf. externalization
!!      P.Tulet  01/01/04  introduction of rhodref for externalization
!!      M.Leriche 04/2014  change length of CHARACTER for emission 6->12
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
USE modd_ch_emis_field_n, ONLY : ch_emis_field_t
USE modd_ch_surf_n, ONLY : ch_surf_t
USE modd_sv_n, ONLY : sv_t
!
USE modi_get_luout
USE modi_build_emisstab_n
USE modi_build_pronoslist_n
USE modi_read_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   declarations of arguments
!
!
!
TYPE(ch_emis_field_t), INTENT(INOUT) :: che
TYPE(ch_surf_t), INTENT(INOUT) :: chu
TYPE(sv_t), INTENT(INOUT) :: sv
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! Program name
INTEGER,           INTENT(IN)  :: klu      ! number of points
INTEGER,           INTENT(IN)  :: kch      ! logical unit of input chemistry file
REAL, DIMENSION(:),INTENT(IN)  :: prhoa    ! air density
!
!*       0.2   declarations of local variables
!
INTEGER             :: iresp                 !   File 
INTEGER             :: iluout                ! output listing logical unit
 CHARACTER (LEN=16)  :: yrecfm                ! management
 CHARACTER (LEN=100) :: ycomment              ! variables
INTEGER             :: jspec                 ! Loop index for cover data
INTEGER             :: iind1,iind2           ! Indices counter
!
 CHARACTER(LEN=40)                 :: yspec_name ! species name
 CHARACTER(LEN=12), DIMENSION(:),ALLOCATABLE :: yemis_name ! species name
INTEGER,DIMENSION(:),ALLOCATABLE  :: inbtimes! number of emission times array
INTEGER,DIMENSION(:),ALLOCATABLE  :: itimes  ! emission times for a species
INTEGER,DIMENSION(:),ALLOCATABLE  :: ioffndx ! index array of offline emission species
INTEGER                           :: inbts   ! number of emission times for a species
INTEGER                           :: inboff  ! Number of offline emissions
INTEGER                           :: iverb   ! verbose level
 CHARACTER(LEN=3)                  :: ysurf   ! surface type
!
INTEGER           :: iversion       ! version of surfex file being read
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('CH_INIT_EMISSION_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
WRITE(iluout,*) '------ Beginning of CH_INIT_EMISSION ------'
!
!* ascendant compatibility
yrecfm='VERSION'
 CALL read_surf( &
                hprogram,yrecfm,iversion,iresp)
!
!*      2.     Chemical Emission fields
!              ------------------------
!
! Read the total number of emission files 
IF (iversion>=4) THEN
  CALL read_surf( &
                hprogram,'EMISFILE_NBR',che%NEMIS_NBR,iresp)
ELSE
  CALL read_surf( &
                hprogram,'EMISFILE_GR_NBR',che%NEMIS_NBR,iresp)
END IF
IF (iresp/=0) THEN
  CALL abor1_sfx('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF 2D CHEMICAL EMISSION FIELDS')
END IF
!
! Read the number of emission species
IF (iversion>=4) THEN
  CALL read_surf( &
                hprogram,'EMISPEC_NBR',che%NEMISPEC_NBR,iresp)
ELSE
  CALL read_surf( &
                hprogram,'EMISPEC_GR_NBR',che%NEMISPEC_NBR,iresp)
END IF
IF (iresp/=0) THEN
  CALL abor1_sfx('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF EMITTED CHEMICAL SPECIES')
END IF
!
!
IF (.NOT. ASSOCIATED(che%CEMIS_NAME))  THEN 
  ALLOCATE(che%CEMIS_NAME(che%NEMISPEC_NBR))
ELSE
  WRITE(iluout,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(che%CEMIS_NAME)
END IF

IF (.NOT. ASSOCIATED(che%CEMIS_AREA))   ALLOCATE(che%CEMIS_AREA(che%NEMISPEC_NBR))
IF (.NOT. ASSOCIATED(che%NEMIS_TIME))   ALLOCATE(che%NEMIS_TIME(che%NEMIS_NBR))
 che%NEMIS_TIME(:) = -1
!
ALLOCATE(itimes(che%NEMIS_NBR))
ALLOCATE(inbtimes(che%NEMISPEC_NBR))
ALLOCATE(ioffndx(che%NEMISPEC_NBR))
!
inbtimes(:) = -1
ioffndx(:)  = 0 ! Index array of offline species 
!
iind1      = 0 ! Index to fill NEMIS_GR_TIMES array
iind2      = 0 ! with emission times of offline species
!
inboff     = 0 ! number of offline emission species (with emis time > 0)
DO jspec = 1,che%NEMISPEC_NBR ! Loop on the number of species
!
! Read article EMISNAMExxx for the name of species
! and extract from comment : surface type + number of emission times
  WRITE(yrecfm,'("EMISNAME",I3.3)') jspec
  CALL read_surf( &
                hprogram,yrecfm,yspec_name,iresp,ycomment)
  IF (iresp/=0) THEN
    CALL abor1_sfx('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
  END IF

  WRITE(yrecfm,'("EMISAREA",I3.3)') jspec
  CALL read_surf( &
                hprogram,yrecfm,ysurf,iresp,ycomment)
  WRITE(yrecfm,'("EMISNBT",I3.3)') jspec
  CALL read_surf( &
                hprogram,yrecfm,inbts,iresp,ycomment)
  WRITE(iluout,*) ' Emission ',jspec,' : ',trim(yspec_name),'(',inbts,' instants )'
!
! Read emission times for species number JSPEC
  WRITE(yrecfm,'("EMISTIMES",I3.3)') jspec
  CALL read_surf( &
                hprogram,yrecfm,itimes(1:inbts),iresp,ycomment,'-')
  IF (iresp/=0) THEN
    CALL abor1_sfx('CH_INIT_EMISSIONN: PROBLEM WHEN READING EMISSION TIMES')
  END IF
  IF (inbts == 1) WRITE(iluout,*) ' -> ',itimes(1)
!
! Is it an offline emission ?
  IF (inbts >= 1) THEN
    IF (itimes(1) >= 0) THEN 
! Yes it is. (Note that negative time refers to inline emission like biogenics
! fluxes)
!
      inboff = inboff+1
      ioffndx(inboff)  = jspec
!
! INBTIMES and NEMIS_TIME only updated for offline emission
      iind1 = iind2+1
      iind2 = iind2+inbts
      che%NEMIS_TIME(iind1:iind2) = itimes(1:inbts)
      inbtimes(inboff) = inbts
    END IF
  END IF
!
 che%NTIME_MAX = maxval(che%NEMIS_TIME)
!
! INBTIMES, CEMIS_AREA and CEMIS_NAME 
! are updated for ALL species
  che%CEMIS_NAME(jspec) = yspec_name
  che%CEMIS_AREA(jspec) = ysurf
! 
END DO
!
WRITE(iluout,*) '---- Nunmer of OFFLINE species = ',inboff
WRITE(iluout,*) 'INBTIMES=',inbtimes
WRITE(iluout,*) 'IOFFNDX=',ioffndx

iverb=6

IF (inboff > 0) THEN
  ALLOCATE(che%TSEMISS(inboff))
  ALLOCATE(yemis_name(inboff))

  CALL build_emisstab_n( &
                        chu, &
                        hprogram,kch,che%CEMIS_NAME,inbtimes,che%NEMIS_TIME,&
         ioffndx,che%TSEMISS,klu,iluout,iverb,prhoa)  
  DO jspec = 1,inboff ! Loop on the number of species
    yemis_name(jspec) = che%TSEMISS(jspec)%CNAME(1:12)
  END DO
  CALL build_pronoslist_n(sv, &
                          SIZE(che%TSEMISS),yemis_name,che%TSPRONOSLIST,kch,iluout,iverb)
  DEALLOCATE(yemis_name)
ELSE
  ALLOCATE(che%TSEMISS(0))
  nullify(che%TSPRONOSLIST)
END IF

DEALLOCATE(itimes,inbtimes,ioffndx)
WRITE(iluout,*) '------ Leaving CH_INIT_EMISSION ------'
IF (lhook) CALL dr_hook('CH_INIT_EMISSION_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE ch_init_emission_n