!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- !--------------- special set of characters for RCS information !----------------------------------------------------------------- ! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/ini_cturb.f90,v $ $Revision: 1.2.4.1.2.2.2.1.2.2 $ $Date: 2014/01/09 15:01:55 $ !----------------------------------------------------------------- !----------------------------------------------------------------- ! ###################### MODULE MODI_EMIS_FOND ! ###################### ! INTERFACE ! SUBROUTINE EMIS_FOND(PTEND1,KTCOUNT) REAL,DIMENSION(:,:,:,:),INTENT(INOUT) :: PTEND1 ! output file INTEGER, INTENT(IN) :: KTCOUNT END SUBROUTINE EMIS_FOND ! END INTERFACE ! END MODULE MODI_EMIS_FOND ! ! ! ! ############################################################## SUBROUTINE EMIS_FOND(PTEND1,KTCOUNT) ! ############################################################## ! !!**** *EMIS_FOND* !! !! PURPOSE !! ------- ! The purpose of this routine is to compute the tendencies due to ! background pollution (initial+inlet condition) ! ! The data is given by INERIS and interpolates on the MNH grid ! This file concerns only CAEPport-MOSIQAA applications ! (neutral/stable cases) ! !! METHOD !! ------ !!! !! EXTERNAL !! -------- !! NONE !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! REFERENCE !! --------- !! !! AUTHOR !! ------ !! Franck Auguste * CERFACS(AE) * !! !! MODIFICATIONS !! ------------- !! Original 01/10/2017 !! !------------------------------------------------------------------------------ ! !**** 0. DECLARATIONS ! --------------- ! ! module USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP USE MODD_ARGSLIST_ll, ONLY : LIST_ll ! ! declaration USE MODD_EMIS_PARAM_n USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT USE MODD_CONF, ONLY: NHALO,CCONF ! ! interface ! IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments REAL,DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PTEND1 ! output file INTEGER, INTENT(IN) :: KTCOUNT ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! proc size INTEGER :: JI,JJ,JK ! loop index REAL :: ZREF ! altitude model REAL,DIMENSION(:), ALLOCATABLE :: ZALTI ! altitude level REAL,DIMENSION(:,:), ALLOCATABLE :: ZFOND ! concentration level REAL :: ZLIMIT ! !------------------------------------------------------------------------------ ! !**** 1. PRELIMINARIES ! ---------------- ! ! Longitudinal location limiting the imposed value in meter (West flow case) ZLIMIT = 20. ! ALLOCATE(ZALTI(4)) ZALTI(1)=020. ZALTI(2)=050. ZALTI(3)=100. ZALTI(4)=200. ALLOCATE(ZFOND(4,SIZE(PTEND1,4))) ZFOND(:,:)=0. ! NO STABLE (1ppbv \approx 1e-9kg.m-3) !1e+6 for mg.m-3 !ZFOND(1,4)=0.016977/28.976*30.01*1e-9*1e+6 !ZFOND(2,4)=0.000705/28.976*30.01*1e-9*1e+6 !ZFOND(3,4)=0.000487/28.976*30.01*1e-9*1e+6 !ZFOND(4,4)=0.000241/28.976*30.01*1e-9*1e+6 ! ! NO2 STABLE (1ppbv \approx 2e-9kg.m-3) !1e+6 for mg.m-3 !ZFOND(1,5)=0.955020/28.976*46.05*1e-9*1e+6 !ZFOND(2,5)=0.376401/28.976*46.05*1e-9*1e+6 !ZFOND(3,5)=0.171205/28.976*46.05*1e-9*1e+6 !ZFOND(4,5)=0.122282/28.976*46.05*1e-9*1e+6 ! NO NEUTRAL (1ppbv \approx 1e-9kg.m-3) !1e+6 for mg.m-3 ZFOND(1,4)=0.026610/28.976*30.01*1e-9*1e+6 ZFOND(2,4)=9.38E-05/28.976*30.01*1e-9*1e+6 ZFOND(3,4)=3.76E-05/28.976*30.01*1e-9*1e+6 ZFOND(4,4)=4.41E-05/28.976*30.01*1e-9*1e+6 ! ! NO2 NEUTRAL (1ppbv \approx 2e-9kg.m-3) !1e+6 for mg.m-3 ZFOND(1,5)=3.253620/28.976*46.05*1e-9*1e+6 ZFOND(2,5)=2.103880/28.976*46.05*1e-9*1e+6 ZFOND(3,5)=0.783530/28.976*46.05*1e-9*1e+6 ZFOND(4,5)=0.606420/28.976*46.05*1e-9*1e+6 NO UNSTABLE (1ppb \approx 1e-9kg.m-3) !ZFOND(1,4)=0.2400977/28.976*30.01*1e-9*1.e+6 !ZFOND(2,4)=0.1800705/28.976*30.01*1e-9*1.e+6 !ZFOND(3,4)=0.1600487/28.976*30.01*1e-9*1.e+6 !ZFOND(4,4)=0.1400241/28.976*30.01*1e-9*1.e+6 ! NO2 UNSTABLE (1ppb \approx 2e-9kg.m-3) !ZFOND(1,5)=0.673620/28.976*46.05*1e-9*1.e+6 !ZFOND(2,5)=0.533880/28.976*46.05*1e-9*1.e+6 !ZFOND(3,5)=0.453530/28.976*46.05*1e-9*1.e+6 !ZFOND(4,5)=0.376420/28.976*46.05*1e-9*1.e+6 CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) IKB = 1 + JPVEXT IKE = SIZE(PTEND1,3) - JPVEXT ! IF (CCONF=='RESTA'.AND.(KTCOUNT<=2)) GO TO 112 DO JI=IIB,IIE IF ((XXHAT(JI)>ZLIMIT).AND.(KTCOUNT>2)) GO TO 111 DO JJ=IJB,IJE DO JK=IKB,IKE ZREF = XZZ(JI,JJ,JK) IF (ZREF.LT.ZALTI(1)) THEN PTEND1(JI,JJ,JK,:) = ZFOND(1,:) ELSEIF ((ZREF.GT.ZALTI(1)).AND.(XZZ(JI,2,JK).LT.ZALTI(2))) THEN PTEND1(JI,JJ,JK,:) = (ZFOND(1,:)*ABS(ZREF-ZALTI(2))+ZFOND(2,:)*ABS(ZREF-ZALTI(1)))/(ZALTI(2)-ZALTI(1)) ELSEIF ((ZREF.GT.ZALTI(2)).AND.(XZZ(JI,2,JK).LT.ZALTI(3))) THEN PTEND1(JI,JJ,JK,:) = (ZFOND(2,:)*ABS(ZREF-ZALTI(3))+ZFOND(3,:)*ABS(ZREF-ZALTI(2)))/(ZALTI(3)-ZALTI(2)) ELSEIF ((ZREF.GT.ZALTI(3)).AND.(XZZ(JI,2,JK).LT.ZALTI(4))) THEN PTEND1(JI,JJ,JK,:) = (ZFOND(3,:)*ABS(ZREF-ZALTI(4))+ZFOND(4,:)*ABS(ZREF-ZALTI(3)))/(ZALTI(4)-ZALTI(3)) ELSE PTEND1(JI,JJ,JK,:) = ZFOND(4,:) ENDIF ENDDO ENDDO 111 CONTINUE ENDDO 112 CONTINUE DEALLOCATE(ZALTI,ZFOND) RETURN END SUBROUTINE EMIS_FOND