! Copyright 2008-2021 Earth Sciences Department, BSC-CNS
!
! This file is part of MONARCH.
!
! MONARCH is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! MONARCH is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with MONARCH. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
!
       MODULE MODULE_BSC_SEDIMENTATION
!
!-----------------------------------------------------------------------
!***  THIS MODULE CALCULATES THE AEROSOL SEDIMENTATION
!-----------------------------------------------------------------------
!
      USE MODULE_KINDS
!
      USE MODULE_DM_PARALLEL,ONLY : IDS,IDE,JDS,JDE                     &
                                   ,IMS,IME,JMS,JME                     &
                                   ,ITS,ITE,JTS,JTE                     &
                                   ,MPI_COMM_COMP,MYPE_SHARE,NUM_TILES
!
      USE MODULE_MP_ETANEW, ONLY : FPVS
      USE MODULE_CONSTANTS
!   
      USE, INTRINSIC :: IEEE_ARITHMETIC
      USE, INTRINSIC :: IEEE_FEATURES
!
!-----------------------------------------------------------------------
      IMPLICIT NONE
!-----------------------------------------------------------------------
!
      PRIVATE
      PUBLIC :: SEDIMENTATION
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
       SUBROUTINE SEDIMENTATION (                                  &
                                 NSEDIM,NUM_AERO                          &
                                ,NUM_ASH,NUM_DUST,NUM_SALT                &
                                ,NUM_BC,NUM_OM,NUM_SO4,NUM_NO3,NUM_NH4    &
                                ,NUM_UNSPC                                &
                                ,AERO_DEPDRY                              &
                                ,VSED5,VSED6,VSED7,VSED8                  &
                                ,SEDIM_TYPE                               &
                                ,RHO_AERO, R_AERO_E                       &
                                ,CHEM                                     &
                                ,T,Q                                      &
                                ,DSG2,SGML2,SG2,PDSG1,PSGML1,PSG1         &
                                ,PT                                       &
                                ,PD                                       &
                                ,DT                                       &
                                ,IDS,IDE,JDS,JDE                          &
                                ,IMS,IME,JMS,JME                          &
                                ,ITS,ITE,JTS,JTE,LM)
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!***  VARIABLES
!-----------------------------------------------------------------------
!
      INTEGER(KIND=KINT),INTENT(IN) :: IDS,IDE,JDS,JDE                       &
                           ,IMS,IME,JMS,JME                       &
                           ,ITS,ITE,JTS,JTE,LM
!
      INTEGER(KIND=KINT),INTENT(IN) :: NSEDIM, NUM_AERO
      INTEGER(KIND=KINT),INTENT(IN) :: NUM_ASH,NUM_DUST,NUM_SALT            
      INTEGER(KIND=KINT),INTENT(IN) :: NUM_BC,NUM_OM,NUM_SO4,NUM_NO3,NUM_NH4,NUM_UNSPC
!
      REAL(KIND=KFPT),INTENT(IN) :: DT,PT
!
      REAL(KIND=KFPT),DIMENSION(1:NUM_AERO),INTENT(IN) :: RHO_AERO,R_AERO_E                  !<-- particle radius in (m); particle density in (kg/m3)
!
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PD
!
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: T,Q
!
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM,1:NUM_AERO),INTENT(INOUT) :: CHEM
!
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:NUM_AERO),INTENT(INOUT) :: AERO_DEPDRY
!
      REAL(KIND=KFPT),DIMENSION(1:LM),INTENT(IN) :: DSG2,PDSG1,PSGML1,SGML2
!
      REAL(KIND=KFPT),DIMENSION(1:LM+1),INTENT(IN) :: PSG1,SG2
!
!
      REAL(KIND=KFPT),INTENT(IN) :: VSED5,VSED6,VSED7,VSED8
!
      INTEGER(KIND=KINT),INTENT(IN) :: SEDIM_TYPE   !0 implicit, 1 explicit
!-----------------------------------------------------------------------
!***  LOCAL VARIABLES
!-----------------------------------------------------------------------
!
      INTEGER(KIND=KINT) :: I,J,K,N,M,NTDT
      INTEGER(KIND=KINT) :: ndt_settl(1:NUM_AERO)     
      REAL(KIND=KFPT) :: DELTIM,C_CUN,PDSL,PLYR,DPL,PSFC,QL,TL,D2WF
      REAL(KIND=KFPT) :: WV, ESAT, QSAT, AERO_SAVE, AERO_BEFORE,dtmax, FLUX
      
!
      REAL(KIND=KFPT), DIMENSION (1:LM) :: TMP,AIRDEN,P_MIDL,P_MIDL_MB
      REAL(KIND=KFPT), DIMENSION (1:LM+1) :: PINT 
      REAL(KIND=KFPT), DIMENSION (1:LM,1:NUM_AERO) :: AERO, VSET
      REAL(KIND=KFPT), DIMENSION (1:NUM_AERO) :: R_AERO_E_WET,RHO_AERO_WET,dt_settl
      REAL(KIND=KFPT), DIMENSION (1:LM) :: RHUM,VISC,FREE_PATH
!
      REAL(KIND=KFPT), DIMENSION (ITS:ITE,JTS:JTE,1:LM) :: DELZ
!
      REAL(KIND=KFPT), DIMENSION (1:NUM_AERO) :: AERO_TOT_BEFORE,AERO_TOT_AFTER

      LOGICAL :: implicit
!
!-----------------------------------------------------------------------
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!-----------------------------------------------------------------------
!
      DELTIM=DT*NSEDIM                                                        !<-- DELTIM=DTTURBL IN MYJPBL (DTTURBL=DT*STEPBL)
!
!-----------------------------------------------------------------------
!***  SET UP INTEGRATION 
!-----------------------------------------------------------------------
!
       DO J=JTS,JTE
       DO I=ITS,ITE
!
       PDSL=PD(I,J)
       PSFC=SG2(LM+1)*PDSL+PSG1(LM+1)
       PINT(LM+1)=PSFC
!
       DO N=1,NUM_AERO
       AERO_TOT_BEFORE(N)=0.
       AERO_TOT_AFTER(N)=0.
       ENDDO
!
!-----------------------------------------------------------------------
!***  TOP=1 DOWN=LM
!-----------------------------------------------------------------------
!
         DO K=LM,1,-1 
!
          PLYR=SGML2(K)*PDSL+PSGML1(K)
          QL=MAX(Q(I,J,K),1.E-20)
          TL=T(I,J,K)
          AIRDEN(K)=PLYR/(R_D*TL*(P608*QL+1.))
          PINT(K)=PINT(K+1)-PDSG1(K)-DSG2(K)*PDSL
          P_MIDL(K)=PLYR
          DELZ(I,J,K)=TL*(P608*QL+1.)*R_D                                   &
                    *(PINT(K+1)-PINT(K))                                &
                    /(PLYR*G)

          P_MIDL_MB(K)=.01*P_MIDL(K)

          TMP(K)=TL
!
          VISC(K) = 1.458E-6*TMP(K)**1.5/(TMP(K)+110.4)          !Dynamic viscosity
          FREE_PATH(K) = 1.1E-3/P_MIDL_MB(K)/SQRT(TMP(K))         !Free path

          WV=QL/(1.-QL)
          ESAT=1000.*FPVS(TL)
          QSAT=(EP_2*ESAT)/(P_MIDL(K)-ESAT)
          RHUM(K)=WV/QSAT

           DO N=1,NUM_AERO
!           AERO(K,N)=CHEM(I,J,K,N)                               !concentration kg/m3
!           AERO(K,N)=CHEM(I,J,K,N)/DELZ(I,J,K)/AIRDEN(K)          !from kg/m2 to kg/kg (mixing ratio)
           AERO(K,N)=CHEM(I,J,K,N)/AIRDEN(K)          !from kg/m3 to kg/kg (mixing ratio)
           AERO_TOT_BEFORE(N)=AERO_TOT_BEFORE(N)+AERO(K,N)*DELZ(I,J,K)*AIRDEN(K)
           ENDDO
!
         ENDDO
!
         DO K = 1,LM         ! Top to bottom
         DO N = 1,NUM_AERO

         D2WF=1.0
         R_AERO_E_WET(N)=R_AERO_E(N)              !wet effective radius for ash and dust (and NO3 and NH4?)
         RHO_AERO_WET(N)=RHO_AERO(N)              !wet particle density for ash and dust (and NO3 and NH4?)

         IF(N.GT.NUM_ASH+NUM_DUST.AND.N.LE.NUM_ASH+NUM_DUST+NUM_SALT)THEN !SEA-SALT
          IF(RHUM(K).GT.0.99)THEN
           D2WF=4.8
          ELSEIF (RHUM(K).GT.0.95)THEN
           D2WF=2.9
          ELSEIF (RHUM(K).GT.0.90)THEN
           D2WF=2.4
          ELSEIF (RHUM(K).GT.0.80)THEN
           D2WF=2.0
          ELSEIF (RHUM(K).GT.0.70)THEN
           D2WF=1.8
          ELSEIF (RHUM(K).GT.0.50)THEN
           D2WF=1.6
          ENDIF
         ENDIF !SEA-SALT
!
         IF(N.GT.NUM_ASH+NUM_DUST+NUM_SALT.AND.N.LE.NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM)THEN !OC
         IF(N-(NUM_ASH+NUM_DUST+NUM_SALT).EQ.2.OR.N-(NUM_ASH+NUM_DUST+NUM_SALT).GE.4)THEN !philic
           IF (RHUM(K).GT.0.99)THEN
            D2WF=2.2
           ELSEIF (RHUM(K).GT.0.95)THEN
            D2WF=1.8
           ELSEIF (RHUM(K).GT.0.90)THEN
            D2WF=1.6
           ELSEIF (RHUM(K).GT.0.80)THEN
            D2WF=1.5
           ELSEIF (RHUM(K).GT.0.70)THEN
            D2WF=1.4
           ELSEIF (RHUM(K).GT.0.50)THEN
            D2WF=1.2
           ENDIF
         ENDIF !philic
         ENDIF !OC
!
         IF(N.GT.NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM.AND.N.LE.NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC)THEN !BC
         IF(N-(NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM).EQ.2)THEN !philic
           IF (RHUM(K).GT.0.99)THEN
            D2WF=1.9
           ELSEIF (RHUM(K).GT.0.95)THEN
            D2WF=1.5
           ELSEIF (RHUM(K).GT.0.90)THEN
            D2WF=1.4
           ELSEIF (RHUM(K).GT.0.80)THEN
            D2WF=1.2
           ELSEIF (RHUM(K).GT.0.70)THEN
            D2WF=1.0
           ELSEIF (RHUM(K).GT.0.50)THEN
            D2WF=1.0
           ENDIF
         ENDIF !philic
         ENDIF !BC
!
         IF(N.GT.NUM_ASH+NUM_DUST+NUM_SALT+NUM_BC+NUM_OM.AND.N.LE.NUM_ASH+NUM_DUST+NUM_SALT+NUM_BC+NUM_OM+NUM_SO4)THEN !SO4
           IF (RHUM(K).GT.0.99)THEN
            D2WF=2.2
           ELSEIF (RHUM(K).GT.0.95)THEN
            D2WF=1.9
           ELSEIF (RHUM(K).GT.0.90)THEN
            D2WF=1.8
           ELSEIF (RHUM(K).GT.0.80)THEN
            D2WF=1.6
           ELSEIF (RHUM(K).GT.0.70)THEN
            D2WF=1.5
           ELSEIF (RHUM(K).GT.0.50)THEN
            D2WF=1.4
           ENDIF
         ENDIF !SO4

         IF (D2WF.GT.1.0)THEN
           R_AERO_E_WET(N)=R_AERO_E(N)*D2WF
           RHO_AERO_WET(N)=D2WF**(-3)*RHO_AERO(N)+(1.-D2WF**(-3))*rhowater
         ENDIF
!
!*** Slip Correction Factor
                  !
         C_CUN = 1.0+FREE_PATH(K)/R_AERO_E_WET(N)                       &
                 *(1.257 + 0.4*EXP(-1.1*R_AERO_E_WET(N)/FREE_PATH(K)))

!*** Stokes 
!
         VSET(K,N) = C_CUN*2.0/9.0*G*(RHO_AERO_WET(N)-AIRDEN(K))        &
                     *R_AERO_E_WET(N)**2/VISC(K)
!
         ENDDO
         ENDDO
!
!Correct sedimentation velocity for coarse dust due to numerical diffusion
         IF(NUM_DUST.GT.0)THEN
         DO K = 1,LM-1         ! Top to bottom
         VSET(K,NUM_ASH+5)=VSET(K,NUM_ASH+5)*VSED5         
         VSET(K,NUM_ASH+6)=VSET(K,NUM_ASH+6)*VSED6         
         VSET(K,NUM_ASH+7)=VSET(K,NUM_ASH+7)*VSED7         
         VSET(K,NUM_ASH+8)=VSET(K,NUM_ASH+8)*VSED8         
         ENDDO
         ENDIF
!
         IF(NUM_DUST.GT.8)THEN
         DO K = 1,LM-1         ! Top to bottom
         VSET(K,NUM_ASH+13)=VSET(K,NUM_ASH+13)*VSED5
         VSET(K,NUM_ASH+14)=VSET(K,NUM_ASH+14)*VSED6
         VSET(K,NUM_ASH+15)=VSET(K,NUM_ASH+15)*VSED7
         VSET(K,NUM_ASH+16)=VSET(K,NUM_ASH+16)*VSED8
         ENDDO
         ENDIF
!

!*** Determine the critical time-step satisying the CFL condition: dt <= dtcritical = (dz)_min / v_settl
!*** There is one critical time step for each aerosol type (size)
!
         DO N = 1,NUM_AERO
!
          ntdt=INT(DELTIM)
          dtmax=MINVAL(DELZ(I,J,1:LM))/MAXVAL(VSET(1:LM,N))         ! dtcritical
!
          ndt_settl(N)=MAX(1,INT(ntdt/dtmax))                   ! maximum number of iterations
!         IF (ndt_settl(N) > 12) ndt_settl(N) = 12
          ndt_settl(N)=2*ndt_settl(N)                           ! safety factor
          dt_settl(N)=(1.0*ntdt)/(1.0*ndt_settl(N))
!
         ENDDO

!
!*** Finally, update tracers
!*** NOTE that sedimentation from the last layer (k=LM) to the ground is excluded becasue it is included in dry deposition
!
!         implicit = .true.
         if(SEDIM_TYPE.EQ.0)then
!
         DO N = 1,NUM_AERO
         DO M = 1,ndt_settl(N)
         DO K = 1,LM
          if(K.eq.1) then           ! top
!
!          AERO_SAVE=AERO(1,N)
          AERO(1,N)=AERO(1,N)/(1.0+dt_settl(N)*VSET(1,N)/DELZ(I,J,1))
!
          elseif(K.eq.LM) then     ! bottom  !We now do deposition due to settling here and not in the dry dep scheme
!
          AERO(LM,N)=AERO(LM,N)+dt_settl(N)*VSET(LM-1,N)*AERO(LM-1,N)/DELZ(I,J,LM)     !1/DELZ(LM-1)*DELZ(LM-1)/DELZ(LM)
!
          else
!
!          AERO_BEFORE=AERO(K,N)
!
!          AERO(K,N)=AERO(K,N)/(1.0+dt_settl(N)*VSET(K,N)/DELZ(I,J,K)) &
!                   +dt_settl(N)*VSET(K-1,N)*AERO_SAVE/DELZ(I,J,K)                   !1/DELZ(K-1)*DELZ(K-1)/DELZ(K)
          AERO(K,N) = (AERO(K,N) + dt_settl(N)*VSET(K-1,N)*AERO(K-1,N)/DELZ(I,J,K)) &
                       / (1.0+dt_settl(N)*VSET(K,N)/DELZ(I,J,K))
!
!          AERO_SAVE=AERO_BEFORE

          endif
!
         ENDDO
         ENDDO
         ENDDO
!
         else   ! explicit solution (must verify CFL)
             !
         DO N = 1,NUM_AERO           
         DO M = 1,ndt_settl(N)
         DO K = 1,LM
          if(K.eq.1) then           ! top
          !
          AERO(1,N) = AERO(1,N) * (1.0 - dt_settl(N)*VSET(1,N)/DELZ(I,J,1))
                       !
          elseif(K.eq.LM) then     ! bottom
                       !
          AERO(LM,N) = AERO(LM,N) + dt_settl(N)*VSET(LM-1,N)*AERO(LM-1,N)/DELZ(I,J,LM)
                       !
          else
                       !
          AERO(K,N) = AERO(K,N) * (1.0 - dt_settl(N)*VSET(K,N)/DELZ(I,J,K)) &
                      + (dt_settl(N)*VSET(K-1,N)*AERO(K-1,N)/DELZ(I,J,K))
                       !                  
          endif

          ENDDO
          ENDDO
          ENDDO
             !
!
          endif
!Sedimentation from the bottom layer to the ground 
!
          DO N = 1,NUM_AERO
!
          FLUX = DELTIM*VSET(LM,N)*AERO(LM,N)*AIRDEN(LM)       ! kg/m2 during DELTIM       
          FLUX = MIN(FLUX, AERO(LM,N)*AIRDEN(LM)*DELZ(I,J,LM))           ! do not remove more mass than the existing
!
          IF(FLUX.GT.0.) THEN
          AERO(LM,N)=AERO(LM,N)-FLUX/DELZ(I,J,LM)/AIRDEN(LM)   !mixing ratio kg/kg
          ENDIF
!
          ENDDO

!          endif


!
!
!*** Clip negative values 
          !
          DO K = 1,LM
          DO N = 1,NUM_AERO
             IF( AERO(K,N) < 0.0 ) AERO(K,N) = 1.E-20
             AERO_TOT_AFTER(N)=AERO_TOT_AFTER(N)+AERO(K,N)*DELZ(I,J,K)*AIRDEN(K)
          ENDDO
          ENDDO

!Update chem tracer array and compute nitrate coarse sedimentation
!
!         P_DUST_START=NUM_ASH+1
!         P_SSA_START=NUM_ASH+NUM_DUST+1
!         P_NO3_DUST=NUM_ASH+NUM_DUST+NUM_SALT+NUM_BC+NUM_OM+NUM_SO4+2
!         P_NO3_SSA=NUM_ASH+NUM_DUST+NUM_SALT+NUM_BC+NUM_OM+NUM_SO4+3
         DO K=1,LM
          DO N=1,NUM_AERO
!            IF(N.EQ.P_NO3_DUST)THEN
!              !Compute nitrate coarse_dust bin sedimentation proportional to dust coarse bins 5 to 8
!              DUST_MASS_PRIOR=MAX(CHEM(I,J,K,P_DUST_START+4)+CHEM(I,J,K,P_DUST_START+5)+CHEM(I,J,K,P_DUST_START+6)+CHEM(I,J,K,P_DUST_START+7),0.)
!              DUST_MASS_POST=MAX(AERO(K,P_DUST_START+4)+AERO(K,P_DUST_START+5)+AERO(K,P_DUST_START+6)+AERO(K,P_DUST_START+7))*AIRDEN(K),0.)
!              DUST_TREND=(DUST_MASS_POST-DUST_MASS_PRIOR)/DUST_MASS_PRIOR
!              CHEM(I,J,K,P_NO3_DUST)=MAX(CHEM(I,J,K,P_NO3_DUST)+(CHEM(I,J,K,P_NO3_DUST)*DUST_TREND),1.E-20*AIRDEN(K))
!            ELSEIF(N.EQ.P_NO3_SSA)THEN
!              !Compute nitrate coarse_ssa bin sedimentation proportional to ssa coarse bins 5 to 8
!              SSA_MASS_PRIOR=CHEM(I,J,K,NUM_ASH+NUM_DUST+5)+CHEM(I,J,K,NUM_ASH+NUM_DUST+6)+CHEM(I,J,K,NUM_ASH+NUM_DUST+7)+CHEM(I,J,K,NUM_ASH+NUM_DUST+8)
!              SSA_MASS_POST=(AERO(K,NUM_ASH+5)+AERO(K,NUM_ASH+6)+AERO(K,NUM_ASH+7)+AERO(K,NUM_ASH+NUM_DUST+8))*AIRDEN(K)
!              SSA_TREND=(DUST_MASS_POST-DUST_MASS_PRIOR)/DUST_MASS_PRIOR
!              CHEM(I,J,K,P_NO3_DUST)=MAX(CHEM(I,J,K,P_NO3_DUST)+(CHEM(I,J,K,P_NO3_DUST)*DUST_TREND),1.E-20*AIRDEN(K))
!            ELSE
!             CHEM(I,J,K,N)=AERO(K,N)*DELZ(I,J,K)*AIRDEN(K)  !From kg/kg to kg/m2
              CHEM(I,J,K,N)=AERO(K,N)*AIRDEN(K)  !From kg/kg to kg/m3
!            ENDIF
          ENDDO
         ENDDO
!FLux out
         DO N=1,NUM_AERO
            AERO_DEPDRY(I,J,N)=AERO_DEPDRY(I,J,N)+AERO_TOT_BEFORE(N)-AERO_TOT_AFTER(N)
         ENDDO
!
       ENDDO
       ENDDO
!
!-----------------------------------------------------------------------
!
       END SUBROUTINE SEDIMENTATION
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!----------------------------------------------------------------------

       END MODULE MODULE_BSC_SEDIMENTATION
!
!-----------------------------------------------------------------------
