soilemisnon.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 SOILEMISNO_n(PSW_FORBIO, PUA, PVA, KSV, HSV, PFLUX)
      SUBROUTINE soilemisno_n (GB, I, &
                                pua, pva)
!     #####################################################
!!
!!****** *SOILEMISNO*
!!
!!
!!    PURPOSE
!!    -------
!
!     Calculates NO emissions from soil
!     plus estimation of Canopy Reduction Factor
!!
!!    METHOD
!!    ------
!     Parameterizes NO fluxes function of temperature and soil moisture and other soil parameters,
!     Development from a neural network algorithm.

!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!    MODD_EMIS_NOX
!!
!!    REFERENCE
!!    ---------
!!
!!    Parameterization from neural network
!!
!!    Input data : wind speed, deep soil temperature, surface soil temperature, surface WFPS,
!!    fertilisation rate, pH, sand percentage
!!    Delon et al. (2007) Tellus B
!!
!!    AUTHOR
!!    ------
!!
!!      C. Delon           * LA *
!!
!!    MODIFICATIONS
!!    -------------
!!

!
!--------------------------------------------------------------------------
!
!       0. DECLARATIONS
!          ------------
!
!
USE modd_gr_biog_n, ONLY : gr_biog_t
USE modd_isba_n, ONLY : isba_t
!
USE modd_emis_nox
USE modd_csts,       ONLY : xavogadro
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!       0.1 Declaration of arguments
!
!
!REAL, DIMENSION(:,:), INTENT(IN)              :: PSW_FORBIO
!
TYPE(gr_biog_t), INTENT(INOUT) :: gb
TYPE(isba_t), INTENT(INOUT) :: i
!
REAL, DIMENSION(:), INTENT(IN)                :: pua        ! wind module
REAL, DIMENSION(:), INTENT(IN)                :: pva
!INTEGER,             INTENT(IN)               :: KSV       ! number of scalars
!CHARACTER(LEN=6), DIMENSION(KSV),  INTENT(IN) :: HSV        ! chemical species name
!REAL, DIMENSION(:,:), INTENT(INOUT)           :: PFLUX      ! NO flux from soil
!                                                control switch for the first call
INTEGER                                       :: ji         ! index
INTEGER                                       :: jsv
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Local variables:
!
REAL, DIMENSION(SIZE(PUA,1))   :: zcrf            ! Canopy Reduction Factor
!
REAL, DIMENSION(SIZE(PUA,1))   :: ztg_d           ! Deep soil temperature in °C
REAL, DIMENSION(SIZE(PUA,1))   :: ztg_s           ! Surface soil temperature in °C
REAL, DIMENSION(SIZE(PUA,1))   :: zwfps_s         ! Water filled pore space at surface
REAL, DIMENSION(SIZE(PUA,1))   :: zsand           ! % of sand at surface (0-100)
REAL, DIMENSION(SIZE(PUA,1))   :: zwind          ! wind speed
REAL, DIMENSION(SIZE(PUA,1))   :: zfwork        
REAL, DIMENSION(SIZE(PUA,1))   :: zn_wind          ! Normalized wind speed
REAL, DIMENSION(SIZE(PUA,1))   :: zn_ztg_d        ! Normalized deep soil temperature
REAL, DIMENSION(SIZE(PUA,1))   :: zn_ztg_s        ! Normalized surface soil temperature
REAL, DIMENSION(SIZE(PUA,1))   :: zn_zwfps_s      ! Normalized WFPS at surface
REAL, DIMENSION(SIZE(PUA,1))   :: zn_fert        ! Normalized fertilisation rate (Nitrogen Unity)
REAL, DIMENSION(SIZE(PUA,1))   :: zn_ph          ! Normalized pH value
REAL, DIMENSION(SIZE(PUA,1))   :: zn_zsand        ! Normalized sand content (%)
REAL, DIMENSION(SIZE(PUA,1))   :: zn_y            ! Normalized NO flux
!
REAL, DIMENSION(SIZE(PUA,1),3)   :: zs            ! normalized sum
!
 CHARACTER(LEN=2)               :: test_crf ! 'OK' if VEG<60% (i.e. soils with sparse vegetation)
!
INTEGER :: j
REAL(KIND=JPRB) :: zhook_handle
!=============================================================================
IF (lhook) CALL dr_hook('SOILEMISNO_n',0,zhook_handle)
!
IF (.NOT.ASSOCIATED(gb%XNOFLUX))  ALLOCATE(gb%XNOFLUX(SIZE(pua,1)))
!
! Calculation of WFPS
! coefficients obtenus a partir des donnees Grignon+Hombori+Escompte(0.536 0.4 0.43)
zwfps_s(:) = (i%XWG(:,1,1) / 0.45) * 100.      
! Change unity of temperatures from Kelvin to Celsius
ztg_d(:) = i%XTG(:,2,1)  - 273.15
ztg_s(:) = i%XTG(:,1,1)  - 273.15
! Change sand fraction into sand percentage
zsand(:) = i%XSAND(:,1) * 100.
! Calculate wind module
zwind(:) = sqrt( pua(:)**2 + pva(:)**2 )
!
! Calculation of NO flux from soil 
!------------------------------------
! 1- Normalized centered entries
!
zn_ztg_s(:)   = xcoef_tg_s(1)   + xcoef_tg_s(2) * ztg_s(:)
zn_zwfps_s(:) = xcoef_wfps_s(1) + xcoef_wfps_s(2) * zwfps_s(:)
zn_ztg_d(:)   = xcoef_tg_d(1)   + xcoef_tg_d(2) * ztg_d(:)
zn_fert(:)    = xcoef_fert(1)   + xcoef_fert(2) * i%XFERT(:)
zn_zsand(:)   = xcoef_sand(1)   + xcoef_sand(2) * zsand(:)
zn_ph(:)      = xcoef_ph(1)     + xcoef_ph(2) * i%XPH(:)
zn_wind(:)    = xcoef_wind(1)   + xcoef_wind(2) * zwind(:)
!
! 2- weighted sums
!
DO j=1,3
  zs(:,j) = xwgt_0(j) + xwgt_tg_s(j) * zn_ztg_s(:) &
          + xwgt_wfps_s(j) * zn_zwfps_s(:) + xwgt_tg_d(j) * zn_ztg_d(:) &
          + xwgt_fert(j) * zn_fert(:) + xwgt_sand(j) * zn_zsand(:) &
          + xwgt_ph(j) * zn_ph(:) + xwgt_wind(j) * zn_wind(:) 
ENDDO
!
! 3- Hyperbolic tangent calculation    
!
zn_y(:) = xwgt_tot(1) + xwgt_tot(2)*tanh(zs(:,1)) + xwgt_tot(3)*tanh(zs(:,2)) + xwgt_tot(4)*tanh(zs(:,3)) 
!
!  4- Flux calculation
!       If  pH> 6, pulse effect, amplitude coefficient is maximum.
!       If pH < 6, amplitude coefficient is reduced to avoid strong emissions
WHERE (i%XPH(:) .GE. 6.0)
  gb%XNOFLUX(:) = xcoef_no0 + xcoef_no1_s*zn_y(:)
ELSEWHERE
  gb%XNOFLUX(:) = xcoef_no0 + xcoef_no1_l*zn_y(:)
ENDWHERE
!
!PRINT*,'flux de NO en gN/ha/d = ',XNOFLUX(:)
!
!  5- Flag to avoid negative fluxes.
WHERE (gb%XNOFLUX(:).LT. 0.) gb%XNOFLUX(:)=0.
!     PRINT*,'!!!!!! Attention flux de NO negatifs !!!!!',XNOFLUX(JI)
!
!  6- Changing units from gN/ha/d to molecules/m2/s
! 1 ha=10000 m2, 1d=86400s, 1mole(NO)=30g, 1mole=Avogadro molec (6.022E23).
!                           1mole(N) =14g
gb%XNOFLUX(:) = gb%XNOFLUX(:)*xavogadro/(1.0e4*8.64e4*14)
!
!PRINT*,'flux de NO en molec/cm2/s = ',XNOFLUX(JI)
!
!  7- Reduction du flux dans la canopee
!          WHERE (XLAI(:,1)/=XUNDEF) 
!         ZCRF(:) = -0.0917*XLAI(:,1) + 0.9429
WHERE (i%XLAI(:,1) > 1.9 .AND. i%XLAI(:,1) < 5.)
  zcrf(:) = 0.5
ELSEWHERE (i%XLAI(:,1) > 5.)
  zcrf(:) = 0.2
ELSEWHERE
  zcrf(:) = 1.
ENDWHERE
!       PRINT*,'LAI, CRF', XLAI(:), ZCRF(:)
gb%XNOFLUX(:) = gb%XNOFLUX(:)*zcrf(:)
!       PRINT*,'flux de NO en molec/m2/s apres CRF = ',XNOFLUX(:)
!
!  8- Introduction du Flux de NO final dans la chimie apres reduction par le CRF (avec MesoNH chimie)
!  IF (NBEQ>0) THEN
!      DO JSV=NSV_CHSBEG,NSV_CHSEND
!         IF (CSV(JSV) == "NO") THEN
!          PFLUX(:,JSV) = PFLUX(:,JSV) + XNOFLUX(:)
!         ENDIF
!      END DO
!  ELSE
!      PFLUX(:,1) = PFLUX(:,1) + XNOFLUX(:)
!  ENDIF
!
IF (lhook) CALL dr_hook('SOILEMISNO_n',1,zhook_handle)
!
END SUBROUTINE soilemisno_n