      SUBROUTINE callsedim(ngrid,nlay, ptimestep,
     $                pplev,zlev, pt, rdust, rice,
     &                pq, pdqfi, pdqsed,pdqs_sed,nq)

! to use  'getin'
      USE ioipsl_getincom

      IMPLICIT NONE

c=======================================================================
c      Sedimentation of the  Martian aerosols
c      depending on their density and radius
c
c      F.Forget 1999
c
c      Modified by J.-B. Madeleine 2010: Now includes the doubleq
c        technique in order to have only one call to callsedim in
c        physiq.F.
c
c=======================================================================

c-----------------------------------------------------------------------
c   declarations:
c   -------------

#include "dimensions.h"
#include "dimphys.h"
#include "comcstfi.h"
#include "tracer.h"
#include "callkeys.h"

c
c   arguments:
c   ----------

      INTEGER ngrid              ! number of horizontal grid points
      INTEGER nlay               ! number of atmospheric layers
      REAL ptimestep             ! physics time step (s)
      REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
      REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
c    Aerosol radius provided by the water ice microphysical scheme:
      REAL rdust(ngrid,nlay)     ! Dust geometric mean radius (m)
      REAL rice(ngrid,nlay)      ! Ice geometric mean radius (m)

c    Traceurs :
      integer nq             ! number of tracers
      real pq(ngrid,nlay,nq)  ! tracers (kg/kg)
      real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
      real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
      real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
      
c   local:
c   ------

      REAL CBRT
      EXTERNAL CBRT

      INTEGER l,ig, iq

      real zqi(ngridmx,nlayermx,nqmx) ! to locally store tracers
      real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
      real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
      real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
      real r0(ngridmx,nlayermx) ! geometric mean doubleq radius (m)
c     Sedimentation radius of water ice
      real rfall(ngridmx,nlayermx)
c     Sedimentation effective variance of water ice
      REAL, PARAMETER :: nuice_sed = 0.45  !! TESTS_JB  !! 0.1 avant

c     Discrete size distributions (doubleq)
c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c       1) Parameters used to represent the changes in fall
c          velocity as a function of particle size;
      integer nr,ir
      parameter (nr=12) !(nr=7) ! number of bins
      real rd(nr),qr(ngridmx,nlayermx,nr)
      real rdi(nr+1)    ! extreme and intermediate radii
      real Sq(ngridmx,nlayermx)
      real rdmin,rdmax,rdimin,rdimax
      data rdmin/1.e-8/ !/1.e-7/
      data rdmax/30.e-6/
      data rdimin/1.e-10/
      data rdimax/1e-4/
      save rd, rdi

c       2) Second size distribution for the log-normal integration
c          (the mass mixing ratio is computed for each radius)

      integer ninter, iint
      parameter (ninter=4)  ! nombre de point entre chaque rayon rdi
      real rr(ninter,nr)
      save rr
      integer radpower

c       3) Other local variables used in doubleq

      real reff(ngridmx,nlayermx,2)  ! for diagnostic only
      INTEGER idust_mass   ! index of tracer containing dust mass
                           !   mix. ratio
      INTEGER idust_number ! index of tracer containing dust number
                           !   mix. ratio
      SAVE idust_mass,idust_number

c     Firstcall:

      LOGICAL firstcall
      SAVE firstcall
      DATA firstcall/.true./

      REAL betaset
      SAVE betaset


c    ** un petit test de coherence
c       --------------------------

      IF (firstcall) THEN
         IF(ngrid.NE.ngridmx) THEN
            PRINT*,'STOP dans callsedim'
            PRINT*,'probleme de dimensions :'
            PRINT*,'ngrid  =',ngrid
            PRINT*,'ngridmx  =',ngridmx
            STOP
         ENDIF

         write(*,*) "beta coefficient for sedimentation"
         betaset = 0.5 ! default value
         call getin("betaset",betaset)
         write(*,*) " betaset = ",betaset

c       Doubleq: initialization
        IF (doubleq) THEN
         do ir=1,nr
             rd(ir)= rdmin*(rdmax/rdmin)**(float(ir-1)/float(nr-1))
         end do
         rdi(1)=rdimin
         do ir=2,nr
           rdi(ir)= sqrt(rd(ir-1)*rd(ir))
         end do
         rdi(nr+1)=rdimax

         do ir=1,nr
           do iint=1,ninter
             rr(iint,ir)=
     &        rdi(ir)*
     &        (rdi(ir+1)/rdi(ir))**(float(iint-1)/float(ninter-1))
c             write(*,*) rr(iint,ir)
           end do
         end do

      ! identify tracers corresponding to mass mixing ratio and
      ! number mixing ratio
        idust_mass=0      ! dummy initialization
        idust_number=0    ! dummy initialization

        do iq=1,nq
          if (noms(iq).eq."dust_mass") then
            idust_mass=iq
          endif
          if (noms(iq).eq."dust_number") then
            idust_number=iq
          endif
        enddo

        write(*,*) 'TEST TEST idust_mass', idust_mass
        write(*,*) 'TEST TEST idust_number', idust_number

        ! check that we did find the tracers
        if ((idust_mass.eq.0).or.(idust_number.eq.0)) then
          write(*,*) 'callsedim: error! could not identify'
          write(*,*) ' tracers for dust mass and number mixing'
          write(*,*) ' ratio and doubleq is activated!'
          stop
        endif
        ENDIF !of if (doubleq)

        IF (water) THEN
          write(*,*) "water_param nueff Sedimentation:", nuice_sed
          IF (activice) THEN
            write(*,*) "water_param nueff Radiative:", nuice_ref
          ENDIF
        ENDIF
      
        firstcall=.false.
      ENDIF ! of IF (firstcall)

c-----------------------------------------------------------------------
c    1. Initialization
c    -----------------

      zqi(1:ngrid,1:nlay,1:nqmx) = 0.
c     Updating the mass mixing ratio with the tendencies coming
c       from other parameterizations:
c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

      do iq=1,nq
        do l=1,nlay
          do ig=1,ngrid
            zqi(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
          enddo
        enddo 
      enddo

c    Computing the different layer properties
c    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c    Mass (kg.m-2), thickness(m), crossing time (s)  etc.

      do  l=1,nlay
        do ig=1, ngrid
          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g 
          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
        end do
      end do

c =================================================================
      do iq=1,nq
        if(radius(iq).gt.1.e-9) then   ! no sedim for gaz

c -----------------------------------------------------------------
c         DOUBLEQ CASE
c -----------------------------------------------------------------
          if (doubleq.and.
     &        ((iq.eq.idust_mass).or.
     &         (iq.eq.idust_number))) then

c           Computing size distribution:
c           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

            do  l=1,nlay
              do ig=1, ngrid
                r0(ig,l)=
     &            CBRT(r3n_q*zqi(ig,l,idust_mass)/
     &            max(zqi(ig,l,idust_number),0.01))
                r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
              end do
            end do

c        Computing mass mixing ratio for each particle size
c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          IF (iq.EQ.idust_mass) then
            radpower = 2
          ELSE
            radpower = -1
          ENDIF
          Sq(1:ngrid,1:nlay) = 0.
          do ir=1,nr
            do l=1,nlay
              do ig=1,ngrid
c                ****************
c                Size distribution integration
c                (Trapezoid Integration Method)
                 qr(ig,l,ir)=0.5*(rr(2,ir)-rr(1,ir))*
     &             (rr(1,ir)**radpower)*
     &             exp(-(log(rr(1,ir)/r0(ig,l)))**2/(2*varian**2))
                 do iint=2,ninter-1
                   qr(ig,l,ir)=qr(ig,l,ir) +
     &             0.5*(rr(iint+1,ir)-rr(iint-1,ir))*
     &             (rr(iint,ir)**radpower)*
     &             exp(-(log(rr(iint,ir)/r0(ig,l)))**2/
     &             (2*varian**2))
                 end do
                 qr(ig,l,ir)=qr(ig,l,ir) +
     &             0.5*(rr(ninter,ir)-rr(ninter-1,ir))*
     &             (rr(ninter,ir)**radpower)*
     &             exp(-(log(rr(ninter,ir)/r0(ig,l)))**2/
     &             (2*varian**2))

c                **************** old method (not recommended!)
c                qr(ig,l,ir)=(rd(ir)**(5-3*iq))*
c    &           exp( -(log(rd(ir)/r0(ig,l)))**2 / (2*varian**2) )
c                ******************************

                 Sq(ig,l)=Sq(ig,l)+qr(ig,l,ir)
              enddo
            enddo
          enddo

          do ir=1,nr
            do l=1,nlay
              do ig=1,ngrid
                 qr(ig,l,ir) = zqi(ig,l,iq)*qr(ig,l,ir)/Sq(ig,l)
              enddo
            enddo
          enddo

c         Computing sedimentation for each tracer
c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

c         call zerophys(ngridmx*nlayermx,zqi(1,1,iq))
          zqi(1:ngrid,1:nlay,iq) = 0.
c         call zerophys(ngridmx,pdqs_sed(1,iq))
          pdqs_sed(1:ngrid,iq) = 0.

          do ir=1,nr
             call newsedim(ngrid,nlay,1,ptimestep,
     &       pplev,masse,epaisseur,pt,rd(ir),rho_dust,qr(1,1,ir),
     &       wq,betaset)

c            Tendencies
c            ~~~~~~~~~~
             do ig=1,ngrid
               pdqs_sed(ig,iq) = pdqs_sed(ig,iq)
     &                                + wq(ig,1)/ptimestep
             end do
             DO l = 1, nlay
               DO ig=1,ngrid
                 zqi(ig,l,iq)=zqi(ig,l,iq)+qr(ig,l,ir)
               ENDDO
             ENDDO
          enddo ! of do ir=1,nr
c -----------------------------------------------------------------
c         WATER CYCLE CASE
c -----------------------------------------------------------------
          else if (water.and.(iq.eq.igcm_h2o_ice)) then
c           if (doubleq) then
c             do l=1,nlay
c               do ig=1,ngrid
c                 rfall(ig,l)=max( rice(ig,l),rdust(ig,l) )
c                 rfall(ig,l)=min(rfall(ig,l),1.e-4)
c               enddo
c             enddo ! of do l=1,nlay
c           else
              do l=1,nlay
                do ig=1,ngrid
c               For water cycle, a typical dust size is assumed:
c               r(z)=r0*exp(-z/H) with r0=0.8 micron and H=18 km.
c               rfall(ig,l)=max( rice(ig,l)*1.5,rdust(ig,l) )
                rfall(ig,l)=max( rice(ig,l)*(1.+nuice_sed)**3.,
     &                           rdust(ig,l) )
c modif FranckMM pour ameliorer cycle H2O: rfall= 20 microns
c mars commente pour l'instant               rfall(ig,l)=20.e-6
                rfall(ig,l)=min(rfall(ig,l),1.e-4)
                enddo
              enddo ! of do l=1,nlay
c           endif
            call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
     &      pplev,masse,epaisseur,pt,rfall,rho_q(iq),zqi(1,1,iq),
     &      wq,1.0)
c           Tendencies
c           ~~~~~~~~~~
            do ig=1,ngrid 
              pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
            end do
c -----------------------------------------------------------------
c         GENERAL CASE
c -----------------------------------------------------------------
          else
            call newsedim(ngrid,nlay,1,ptimestep,
     &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),
     &      zqi(1,1,iq),wq,1.0)
c           Tendencies
c           ~~~~~~~~~~
            do ig=1,ngrid 
              pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
            end do
          endif ! of if doubleq and if water
c -----------------------------------------------------------------

          DO l = 1, nlay
            DO ig=1,ngrid
              pdqsed(ig,l,iq)=(zqi(ig,l,iq)-
     $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
            ENDDO
          ENDDO

        endif ! of if(radius(iq).gt.1.e-9)
c =================================================================
      enddo ! of do iq=1,nq
 
      RETURN
      END

