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, PCONVERSION, HSV, HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
!     #######################################
!
!!****  *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
!!      M.Leriche & V. Masson 05/16 bug in write emis fields for nest
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
USE modd_ch_emis_field_n, ONLY : ch_emis_field_t
!
USE modi_get_luout
USE modi_build_emisstab_n
USE modi_build_pronoslist_n
USE modi_read_surf
USE modi_open_namelist
USE modi_close_namelist
USE modi_read_surf_field2d
!
!
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
REAL, DIMENSION(:), POINTER :: PCONVERSION
 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
!
INTEGER             :: IRESP                 !   File 
INTEGER             :: ILUOUT                ! output listing logical unit
 CHARACTER (LEN=16) :: YRECFM                ! management
 CHARACTER (LEN=40) :: 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
INTEGER                           :: ICH      ! logical unit of input chemistry file
 CHARACTER(LEN=3)                  :: YSURF   ! surface type
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! work array to read emission fields
!
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)
!
!*      1.     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
!
IF (hinit/='ALL') THEN
  ALLOCATE(che%XEMIS_FIELDS(klu,che%NEMIS_NBR))
  ALLOCATE(che%CEMIS_COMMENT(che%NEMIS_NBR))
END IF
!
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
! 
!*      2.     Simple reading of emission fields

  IF (hinit /= "ALL") THEN
    yrecfm='E_'//trim(adjustl(yspec_name))
    ALLOCATE(zwork2d(klu,inbts))
    CALL read_surf_field2d(hprogram,zwork2d(:,:),yrecfm,ycomment)
    che%XEMIS_FIELDS(:,iind1:iind2) = zwork2d(:,:)
    che%CEMIS_COMMENT(iind1:iind2) = ycomment
    DEALLOCATE(zwork2d)
  END IF
!
END DO
!
WRITE(iluout,*) '---- Nunmer of OFFLINE species = ',inboff
WRITE(iluout,*) 'INBTIMES=',inbtimes
WRITE(iluout,*) 'IOFFNDX=',ioffndx

iverb=6

!*      3.     Conversion and aggregation

IF (hinit == "ALL") THEN
  IF (inboff > 0) THEN
    CALL open_namelist(hprogram,ich,hfile=hchem_surf_file)
    ALLOCATE(che%TSEMISS(inboff))
    ALLOCATE(yemis_name(inboff))

    CALL build_emisstab_n(pconversion, hprogram,ich,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(hsv, SIZE(che%TSEMISS),yemis_name,che%TSPRONOSLIST,ich,iluout,iverb)
    DEALLOCATE(yemis_name)
    CALL close_namelist(hprogram,ich)
  ELSE
    ALLOCATE(che%TSEMISS(0))
    NULLIFY(che%TSPRONOSLIST)
  END IF
ENDIF

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