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, S, K, NP, NPE, 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_s_t, isba_k_t, isba_np_t, isba_npe_t
!
USE modd_emis_nox
USE modd_csts,       ONLY : xavogadro
!
USE modd_surf_par, ONLY : xundef
!
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_s_t), INTENT(INOUT) :: S
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(isba_np_t), INTENT(INOUT) :: NP
TYPE(isba_npe_t), INTENT(INOUT) :: NPE
!
REAL, DIMENSION(:), INTENT(IN)                :: PUA        ! wind module
REAL, DIMENSION(:), INTENT(IN)                :: PVA
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, IMASK
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(:) = xundef
ztg_d(:) = xundef
zsand(:) = xundef
!
DO ji = 1,np%AL(1)%NSIZE_P
  !
  imask = np%AL(1)%NR_P(ji)
  !
  zwfps_s(imask) = (npe%AL(1)%XWG(ji,1) / 0.45) * 100.      
  ! Change unity of temperatures from Kelvin to Celsius
  ztg_d(imask) = npe%AL(1)%XTG(ji,2)  - 273.15
  ztg_s(imask) = npe%AL(1)%XTG(ji,1)  - 273.15
  !
ENDDO
!
! Change sand fraction into sand percentage
zsand(:) = k%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) * s%XFERT(:)
zn_zsand(:) = xcoef_sand(1) + xcoef_sand(2) * zsand(:)
zn_ph(:) = xcoef_ph(1) + xcoef_ph(2) * s%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 (s%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
zcrf(:) = 1.
DO ji = 1,np%AL(1)%NSIZE_P
  imask = np%AL(1)%NR_P(ji)
  IF (npe%AL(1)%XLAI(ji) > 1.9 .AND. npe%AL(1)%XLAI(ji) < 5.) THEN
    zcrf(imask) = 0.5
  ELSEIF (npe%AL(1)%XLAI(ji) > 5.) THEN
    zcrf(imask) = 0.2
  ENDIF
ENDDO
!       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