ch_emission_to_atmn.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_emission_to_atm_n (CHN, SV, &
                                       psfsv,prhoa)
!     ######################################################################
!!
!!***  *CH_EMISSION_TO_ATM_n* - 
!!
!!    PURPOSE
!!    -------
!!      
!!
!!**  METHOD
!!    ------
!!
!!    AUTHOR
!!    ------
!!    S. Queguiner
!!
!!    MODIFICATIONS
!!    -------------
!!    Original 10/2011
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!
USE modd_ch_snap_n, ONLY : ch_emis_snap_t
USE modd_sv_n, ONLY : sv_t
!
USE modd_type_efutil
USE modd_chs_aerosol
!
USE modi_ch_aer_emission
USE modi_abor1_sfx
!------------------------------------------------------------------------------
!
!*       0.   DECLARATIONS
!        -----------------
!
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(sv_t), INTENT(INOUT) :: sv
!
REAL,             DIMENSION(:,:),INTENT(INOUT):: psfsv  ! flux of     atmospheric scalar var.   (Mol/m2/s)
REAL,             DIMENSION(:),  INTENT(IN)   :: prhoa  ! Air density (kg/m3)
!
!*       0.2  declaration of local variables
!
 CHARACTER(LEN=6), DIMENSION(:), POINTER :: cnames
TYPE(pronosvar_t),POINTER :: curpronos !Current pronostic variable
!
INTEGER :: jspec ! Loop counter on aggregated emitted chemical species
INTEGER :: jsv   ! Loop counter on atmospheric species
INTEGER :: isv   ! Number       of atmospheric species
!
REAL,DIMENSION(SIZE(PSFSV,1),SIZE(PSFSV,2)) :: zemis ! interpolated in time emission flux
REAL,DIMENSION(SIZE(PSFSV,1)              ) :: zfco  ! CO emission flux

!
REAL(KIND=JPRB) :: zhook_handle
!
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CH_EMISSION_TO_ATM_n',0,zhook_handle)
!
!      1.     Agregation : emissions computation
!             ----------------------------------
!
isv = SIZE(sv%CSV)
!
zemis(:,:) = 0.
!
! Point on head of Pronostic variable list
! to cover the entire list.
 cnames=>sv%CSV
 curpronos=>chn%TSPRONOSLIST
!
DO WHILE(ASSOCIATED(curpronos))
  IF (curpronos%NAMINDEX > isv) CALL abor1_sfx('CH_EMISSION_FLUXN: FATAL ERROR')
  !  
  zemis(:,curpronos%NAMINDEX) = 0.
  !
  ! Loop on the number of agreg. coeff.
  DO jspec=1,curpronos%NBCOEFF
    !   Compute agregated flux    
    zemis(:,curpronos%NAMINDEX) = zemis(:,curpronos%NAMINDEX)+ &
            curpronos%XCOEFF(jspec)*chn%XEMIS_FIELDS(:,curpronos%NEFINDEX(jspec))
  END DO
  !
  curpronos=>curpronos%NEXT
  !
END DO
!
!------------------------------------------------------------------------------
!
!      2.     Primary Aerosol emissions
!             -------------------------
!
IF (lch_aero_flux) THEN
  zfco(:) = 0.
  DO jsv=1,isv
    IF (sv%CSV(jsv)=='CO    ') zfco(:) = zemis(:,jsv)
  END DO
  !
  CALL ch_aer_emission(zemis,prhoa,sv%CSV,1,zfco)
END IF
!
!------------------------------------------------------------------------------
!
!      3.     Adds emissions from inventories to chemical species fluxes
!             ----------------------------------------------------------
!
psfsv(:,:) = psfsv(:,:) + zemis(:,:)
!
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CH_EMISSION_TO_ATM_n',1,zhook_handle)
!
!
END SUBROUTINE ch_emission_to_atm_n