!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_COMP ! ###################### ! INTERFACE ! SUBROUTINE EMIS_COMP(PTEND1,PTEND2,PTEND3,PTEND4,PTEND5,PTEND6,PRHODREF,PTIME,PTSTEP,PDELX,PDELT,ITEST) REAL,DIMENSION(:,:,:) ,INTENT(INOUT) :: PTEND1,PTEND4,PTEND5,PTEND6 ! output file REAL,DIMENSION(:,:,:,:),INTENT(IN) :: PTEND2 ! forcing file REAL,DIMENSION(:,:,:),INTENT(IN) :: PTEND3 ! forcing file REAL,DIMENSION(:,:,:) ,INTENT(IN) :: PRHODREF ! fluid density REAL ,INTENT(IN) :: PTIME,PTSTEP ! physical time (s) REAL ,INTENT(IN) :: PDELX ! space resolution (m) REAL ,INTENT(IN) :: PDELT ! time resolution (s) INTEGER ,INTENT(IN) :: ITEST END SUBROUTINE EMIS_COMP ! END INTERFACE ! END MODULE MODI_EMIS_COMP ! ! ! ! ############################################################## SUBROUTINE EMIS_COMP(PTEND1,PTEND2,PTEND3,PTEND4,PTEND5,PTEND6,PRHODREF,PTIME,PTSTEP,PDELX,PDELT,ITEST) ! ############################################################## ! !!**** *EMIS_COMP* !! !! PURPOSE !! ------- ! The purpose of this routine is to compute the tendencies due to ! pollutant emission ! !! 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 USE MODD_DYN_n, ONLY: XTSTEP ! ! interface IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments REAL,DIMENSION(:,:,:) ,INTENT(INOUT) :: PTEND1,PTEND4,PTEND5,PTEND6 ! output file REAL,DIMENSION(:,:,:,:),INTENT(IN) :: PTEND2 ! forcing file REAL,DIMENSION(:,:,:),INTENT(IN) :: PTEND3 ! forcing file REAL,DIMENSION(:,:,:) ,INTENT(IN) :: PRHODREF ! fluid density REAL ,INTENT(IN) :: PTIME,PTSTEP ! physical time (s) REAL ,INTENT(IN) :: PDELX ! space resolution (m) REAL ,INTENT(IN) :: PDELT ! time resolution (s) INTEGER ,INTENT(IN) :: ITEST ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,IJL ! proc size INTEGER :: JI,JJ,JK,JL,JM,JN ! loop index REAL :: ZDELTX0,ZDELTY0,ZDELTZ0,ZDELTT0 ! data resolution REAL :: ZXXREF,ZXYREF,ZXZREF ! reference location REAL :: ZDXREF,ZDYREF,ZDZREF ! space step mesh REAL :: ZCOEFX0,ZCOEFY0,ZCOEFZ0,ZCOEFT0,ZCOEF00 ! time/space ponderation REAL :: ZCOEFX1,ZCOEFY1,ZCOEFZ1,ZCOEFT1 ! time/space simulation REAL :: ZCOEFX2,ZCOEFY2,ZCOEFZ2,ZCOEFT2 ! time/space data INTEGER :: IIREF,IJREF,IKREF ! reference location INTEGER :: IIMIN,IIMAX,IJMIN,IJMAX,IKMIN,IKMAX ! loop index REAL :: ZPI,ZZZREF,ZCOEFUU,ZCD ! Pi number ! !------------------------------------------------------------------------------ ! !**** 1. PRELIMINARIES ! ---------------- ! IF (0.>1.) WRITE(*,*)'A' JM=INT((PTIME/3600.)) JN=INT((PTIME-JM*3600.)/60.) JM=JM+1 IF (JM<=0) GOTO 101 IF (JM>NEMIS_HOUR) GOTO 102 JN=JN+1 JN=MAX( 1,JN) JN=MIN(60,JN) ! WRITE(*,*)'JM',JM ! WRITE(*,*)'JN',JN IF (0.>1.) WRITE(*,*)'B' CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) IKB = 1 + JPVEXT IKE = SIZE(PTEND1,3) - JPVEXT IJL = SIZE(PTEND2,3) ZPI = 3.14159265359 IF (0.>1.) WRITE(*,*)'C' ! !**** 2. PRELIMINARIES ! ---------------- ! ZDELTX0 = PDELX ZDELTY0 = PDELX ZDELTZ0 = PDELX ZDELTT0 = PDELT IF (0.>1.) WRITE(*,*)'D' ZXXREF = (XXHAT(IIB)+XXHAT(IIB+1))/2. ZXYREF = (XYHAT(IJB)+XYHAT(IJB+1))/2. ZXZREF = (XZZ(IIB,IJB,2)+XZZ(IIB,IJB,3))/2. ZDXREF =-(XXHAT(IIB)-XXHAT(IIB+1)) ZDYREF =-(XYHAT(IJB)-XYHAT(IJB+1)) ZDZREF =-(XZZ(IIB,IJB,2)-XZZ(IIB,IJB,3)) IF (ITEST==1) THEN ZZZREF = (ZDXREF*ZDYREF)**0.5 ZCD = 2. ENDIF DO JL = 1,IJL ZCOEFX2 = PTEND2(JM,JN,JL,1) ZCOEFY2 = PTEND2(JM,JN,JL,2) ZCOEFZ2 = PTEND2(JM,JN,JL,3) ZCOEFT2 = PTEND2(JM,JN,JL,4) IF (ZCOEFX2.LT.0005.) GO TO 121 IF (ZCOEFY2.LT.0005.) GO TO 122 IF (ZCOEFZ2.GT.0050.) GO TO 123 IF (ZCOEFX2.GT.5995.) GO TO 124 IF (ZCOEFY2.GT.3995.) GO TO 125 IIREF = IIB+NINT((ZCOEFX2-ZXXREF)/ZDXREF) IJREF = IJB+NINT((ZCOEFY2-ZXYREF)/ZDYREF) IKREF = IKB+NINT((ZCOEFZ2-ZXZREF)/ZDZREF) IIMIN = IIREF-(CEILING(ZDELTX0/ZDXREF)) IIMAX = IIREF+(CEILING(ZDELTX0/ZDXREF)) IJMIN = IJREF-(CEILING(ZDELTY0/ZDYREF)) IJMAX = IJREF+(CEILING(ZDELTY0/ZDYREF)) IKMIN = IKREF-(CEILING(ZDELTZ0/ZDZREF)) IKMAX = IKREF+(CEILING(ZDELTZ0/ZDZREF)) IIMIN = MAX(IIMIN,IIB) IJMIN = MAX(IJMIN,IJB) IKMIN = MAX(IKMIN,IKB) IIMAX = MIN(IIMAX,IIE) IJMAX = MIN(IJMAX,IJE) IKMAX = MIN(IKMAX,IKE) IF (0.>1.) WRITE(*,*)'E' ZCOEFT1 = PTIME ZCOEFT0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFT1-ZCOEFT2)/ZDELTT0)**2.)-exp(-1.)))*(COS(ZPI*(ZCOEFT1-ZCOEFT2)/2./ZDELTT0))**2. IF (ZCOEFT0.LT.XEMIS_RESI) GOTO 110 DO JI=IIMIN,IIMAX ZCOEFX1 = (XXHAT(JI)+XXHAT(JI+1))/2. ZCOEFX0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFX1-ZCOEFX2)/ZDELTX0)**2.)-exp(-1.)))*(COS(ZPI*(ZCOEFX1-ZCOEFX2)/2./ZDELTX0))**2. IF (ZCOEFX0.LT.XEMIS_RESI) GOTO 111 DO JJ=IJMIN,IJMAX ZCOEFY1 = (XYHAT(JJ)+XYHAT(JJ+1))/2. ZCOEFY0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFY1-ZCOEFY2)/ZDELTY0)**2.)-exp(-1.)))*(COS(ZPI*(ZCOEFY1-ZCOEFY2)/2./ZDELTY0))**2. IF (ZCOEFY0.LT.XEMIS_RESI) GOTO 112 DO JK=IKMIN,IKMAX ZCOEFZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK+1))/2. ZCOEFZ0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFZ1-ZCOEFZ2)/ZDELTZ0)**2.)-exp(-1.)))*(COS(ZPI*(ZCOEFZ1-ZCOEFZ2)/2./ZDELTZ0))**2. ZCOEF00 = ZCOEFX0*ZCOEFY0*ZCOEFZ0*ZCOEFT0 PTEND1(JI,JJ,JK) = PTEND1(JI,JJ,JK)+ZCOEF00*PTSTEP*PTEND3(JM,JN,JL)/PRHODREF(JI,JJ,JK) ! mixing ratio (rho_s/rho_f) IF (ITEST==1) THEN ZCOEFUU=(PTEND4(JI,JJ,JK)**2.+PTEND5(JI,JJ,JK)**2.+PTEND6(JI,JJ,JK)**2.)**0.5 PTEND4(JI,JJ,JK) = PTEND4(JI,JJ,JK)*(1.-ZCD*ZCOEF00*ZCOEFUU*XTSTEP/ZZZREF) PTEND5(JI,JJ,JK) = PTEND5(JI,JJ,JK)*(1.-ZCD*ZCOEF00*ZCOEFUU*XTSTEP/ZZZREF) IF (JK==2) ZCOEFUU=0. PTEND6(JI,JJ,JK) = PTEND6(JI,JJ,JK)*(1.-ZCD*ZCOEF00*ZCOEFUU*XTSTEP/ZZZREF) ENDIF ENDDO 112 CONTINUE ENDDO 111 CONTINUE ENDDO 110 CONTINUE 121 CONTINUE 122 CONTINUE 123 CONTINUE 124 CONTINUE 125 CONTINUE ENDDO IF (0.>1.) WRITE(*,*)'F' ! IF ((JM>2 ).AND.(JN==1 )) THEN DO JL = 1,IJL ZCOEFX2 = PTEND2(JM-1,60,JL,1) ZCOEFY2 = PTEND2(JM-1,60,JL,2) ZCOEFZ2 = PTEND2(JM-1,60,JL,3) ZCOEFT2 = PTEND2(JM-1,60,JL,4) IF (ZCOEFX2.LT.0005.) GO TO 221 IF (ZCOEFY2.LT.0005.) GO TO 222 IF (ZCOEFZ2.GT.0050.) GO TO 223 IF (ZCOEFX2.GT.5995.) GO TO 224 IF (ZCOEFY2.GT.3995.) GO TO 225 IIREF = IIB+NINT((ZCOEFX2-ZXXREF)/ZDXREF) IJREF = IJB+NINT((ZCOEFY2-ZXYREF)/ZDYREF) IKREF = IKB+NINT((ZCOEFZ2-ZXZREF)/ZDZREF) IIMIN = IIREF-(CEILING(ZDELTX0/ZDXREF)) IIMAX = IIREF+(CEILING(ZDELTX0/ZDXREF)) IJMIN = IJREF-(CEILING(ZDELTY0/ZDYREF)) IJMAX = IJREF+(CEILING(ZDELTY0/ZDYREF)) IKMIN = IKREF-(CEILING(ZDELTZ0/ZDZREF)) IKMAX = IKREF+(CEILING(ZDELTZ0/ZDZREF)) IIMIN = MAX(IIMIN,IIB) IJMIN = MAX(IJMIN,IJB) IKMIN = MAX(IKMIN,IKB) IIMAX = MIN(IIMAX,IIE) IJMAX = MIN(IJMAX,IJE) IKMAX = MIN(IKMAX,IKE) ZCOEFT1 = PTIME ZCOEFT0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFT1-ZCOEFT2)/ZDELTT0)**2.)-EXP(-1.)))*(COS(ZPI*(ZCOEFT1-ZCOEFT2)/2./ZDELTT0))**2. IF (ZCOEFT0.LT.XEMIS_RESI) GOTO 210 DO JI=IIMIN,IIMAX ZCOEFX1 = (XXHAT(JI)+XXHAT(JI+1))/2. ZCOEFX0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFX1-ZCOEFX2)/ZDELTX0)**2.)-EXP(-1.)))*(COS(ZPI*(ZCOEFX1-ZCOEFX2)/2./ZDELTX0))**2. IF (ZCOEFX0.LT.XEMIS_RESI) GOTO 211 DO JJ=IJMIN,IJMAX ZCOEFY1 = (XYHAT(JJ)+XYHAT(JJ+1))/2. ZCOEFY0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFY1-ZCOEFY2)/ZDELTY0)**2.)-EXP(-1.)))*(COS(ZPI*(ZCOEFY1-ZCOEFY2)/2./ZDELTY0))**2. IF (ZCOEFY0.LT.XEMIS_RESI) GOTO 212 DO JK=IKMIN,IKMAX ZCOEFZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK+1))/2. ZCOEFZ0 = 1./2.*(1.+SIGN(1.,EXP(-((ZCOEFZ1-ZCOEFZ2)/ZDELTZ0)**2.)-EXP(-1.)))*(COS(ZPI*(ZCOEFZ1-ZCOEFZ2)/2./ZDELTZ0))**2. ZCOEF00 = ZCOEFX0*ZCOEFY0*ZCOEFZ0*ZCOEFT0 PTEND1(JI,JJ,JK) = PTEND1(JI,JJ,JK)+ZCOEF00*PTSTEP*PTEND3(JM-1,60,JL)/PRHODREF(JI,JJ,JK)! mixing ratio (rho_s/rho_f) IF (ITEST==1) THEN ZCOEFUU=(PTEND4(JI,JJ,JK)**2.+PTEND5(JI,JJ,JK)**2.+PTEND6(JI,JJ,JK)**2.)**0.5 PTEND4(JI,JJ,JK) = PTEND4(JI,JJ,JK)*(1.-ZCD*ZCOEF00*ZCOEFUU*XTSTEP/ZZZREF) PTEND5(JI,JJ,JK) = PTEND5(JI,JJ,JK)*(1.-ZCD*ZCOEF00*ZCOEFUU*XTSTEP/ZZZREF) IF (JK==2) ZCOEFUU=0. PTEND6(JI,JJ,JK) = PTEND6(JI,JJ,JK)*(1.-ZCD*ZCOEF00*ZCOEFUU*XTSTEP/ZZZREF) ENDIF ENDDO 212 CONTINUE ENDDO 211 CONTINUE ENDDO 210 CONTINUE 221 CONTINUE 222 CONTINUE 223 CONTINUE 224 CONTINUE 225 CONTINUE ENDDO ENDIF ! IF (0.>1.) WRITE(*,*)'G' IF ((JM1.) WRITE(*,*)'H' ENDIF IF (0.>1.) WRITE(*,*)'I' ! 101 CONTINUE 102 CONTINUE ! RETURN ! END SUBROUTINE EMIS_COMP