Index: /trunk/LMDZ.COMMON/makelmdz
===================================================================
--- /trunk/LMDZ.COMMON/makelmdz	(revision 1660)
+++ /trunk/LMDZ.COMMON/makelmdz	(revision 1661)
@@ -376,4 +376,11 @@
    OPTIMC="${coptim}"
    INCLUDEC='-I$(LIBF)/grid -I.'
+fi
+#########
+
+######### CAS PARTICULIER NUAGES VENUS
+if [[ "$physique" == "venus" ]]
+then
+   src_dirs="$src_dirs phy${physique}/cloudvenus"
 fi
 #########
Index: /trunk/LMDZ.COMMON/makelmdz_fcm
===================================================================
--- /trunk/LMDZ.COMMON/makelmdz_fcm	(revision 1660)
+++ /trunk/LMDZ.COMMON/makelmdz_fcm	(revision 1661)
@@ -59,4 +59,5 @@
 COSP_PATH=$LMDGCM/.void_dir
 CHEM_PATH=$LMDGCM/.void_dir
+CLOUD_PATH=$LMDGCM/.void_dir
 AERONO_PATH=$LMDGCM/.void_dir
 # Path to fcm utility:
@@ -473,4 +474,11 @@
 fi
 
+# for Venus (but could be used by others as well), there is also "phyvenus/cloudvenus"
+if [[ -d ${LIBFGCM}/phy${physique}/cloud${physique} ]]
+then
+   CLOUD_PATH="${LIBFGCM}/phy${physique}/cloud${physique}"
+   INCLUDE="$INCLUDE -I${LIBFGCM}/phy${physique}/cloud${physique}"
+fi
+
 # for Mars (but could be used by others as well), there is also "aeronomars"
 if [[ -d ${LIBFGCM}/aerono${physique} ]]
@@ -715,4 +723,5 @@
 echo "%COSP          $COSP_PATH"     >> $config_fcm
 echo "%CHEM          $CHEM_PATH"     >> $config_fcm
+echo "%CLOUD         $CLOUD_PATH"    >> $config_fcm
 echo "%AERONO        $AERONO_PATH"   >> $config_fcm
 echo "%CPP_KEY       $CPP_KEY"       >> $config_fcm
Index: /trunk/LMDZ.VENUS/libf/phyvenus/chemparam_mod.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/chemparam_mod.F90	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/chemparam_mod.F90	(revision 1661)
@@ -1,5 +1,5 @@
 MODULE chemparam_mod
 
-!MODULE qui définit les indices des traceurs et leurs masses molaires.
+!MODULE qui definit les indices des traceurs et leurs masses molaires.
 ! utilise aussi pour variables communes nuages/photochimie
 
@@ -13,11 +13,22 @@
                  i_cocl2, i_s, i_so, i_so2, i_so3,       &
                  i_s2o2, i_ocs, i_hso3, i_h2so4, i_s2,   &
-                 i_clso2, i_oscl, i_h2oliq, i_h2so4liq,  &
-		 i_n2 
+                 i_clso2, i_oscl, i_n2 
                  
+INTEGER, SAVE :: i_h2oliq, i_h2so4liq
+
+INTEGER, SAVE :: i_m0_aer, i_m3_aer,                       &
+                 i_m0_mode1drop, i_m0_mode1ccn,            &
+		 i_m3_mode1sa, i_m3_mode1w, i_m3_mode1ccn, &
+		 i_m0_mode2drop, i_m0_mode2ccn,            &
+		 i_m3_mode2sa, i_m3_mode2w, i_m3_mode2ccn
+
+INTEGER, SAVE :: nmicro  ! number of microphysical tracers 
+
 REAL, DIMENSION(:), SAVE, ALLOCATABLE :: M_tr
  
 
 !----------------------------------------------------------------------------
+! DEF FOR CL_SCHEME = 1 (AURELIEN)
+
 !     number of clouds mode modelized
       INTEGER, PARAMETER :: nbr_mode = 3
@@ -34,4 +45,7 @@
       REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: WH2SO4
       REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: rho_droplet
+!----------------------------------------------------------------------------
+! DEF FOR CL_SCHEME = 2 (FULL MICROPHYS)
+
 !----------------------------------------------------------------------------
 
@@ -670,4 +684,6 @@
   END SUBROUTINE cloud_ini
   
+! ===========================================================
+
   SUBROUTINE chemparam_ini
   USE infotrac_phy, ONLY: nqtot, tname
@@ -811,4 +827,8 @@
   		PRINT*,'oscl',i_oscl
   		M_tr(i_oscl)=83.517
+		CASE('n2')
+		i_n2=i
+		M_tr(i_n2)=28.013
+! MICROPHYSICAL TRACERS FOR CL_SCHEME=1
   		CASE('h2oliq')
   		i_h2oliq=i
@@ -819,7 +839,41 @@
   		PRINT*,'h2so4liq',i_h2so4liq
   		M_tr(i_h2so4liq)=98.078
-		CASE('n2')
-		i_n2=i
-		M_tr(i_n2)=28.013
+! MICROPHYSICAL TRACERS FOR CL_SCHEME=2
+                CASE('M0_aer')
+		i_m0_aer=i
+		PRINT*,'M0_aer',i_m0_aer
+		CASE('M3_aer')
+		i_m3_aer=i
+		PRINT*,'M3_aer',i_m3_aer
+                CASE('M0_m1drop')
+		i_m0_mode1drop=i
+		PRINT*,'M0_m1drop',i_m0_mode1drop
+                CASE('M0_m1ccn')
+		i_m0_mode1ccn=i
+		PRINT*,'M0_m1ccn',i_m0_mode1ccn
+		CASE('M3_m1sa')
+		i_m3_mode1sa=i
+		PRINT*,'M3_m1sa',i_m3_mode1sa
+		CASE('M3_m1w')
+		i_m3_mode1w=i
+		PRINT*,'M3_m1w',i_m3_mode1w
+		CASE('M3_m1ccn')
+		i_m3_mode1ccn=i
+		PRINT*,'M3_m1ccn',i_m3_mode1ccn
+                CASE('M0_m2drop')
+		i_m0_mode2drop=i
+		PRINT*,'M0_m2drop',i_m0_mode2drop
+                CASE('M0_m2ccn')
+		i_m0_mode2ccn=i
+		PRINT*,'M0_m2ccn',i_m0_mode2ccn
+		CASE('M3_m2sa')
+		i_m3_mode2sa=i
+		PRINT*,'M3_m2sa',i_m3_mode2sa
+		CASE('M3_m2w')
+		i_m3_mode2w=i
+		PRINT*,'M3_m2w',i_m3_mode2w
+		CASE('M3_m2ccn')
+		i_m3_mode2ccn=i
+		PRINT*,'M3_m2ccn',i_m3_mode2ccn
   	END SELECT
   	
@@ -828,5 +882,27 @@
   
   END SUBROUTINE chemparam_ini
-  
+
+! ===========================================================
+
+  SUBROUTINE vapors4muphy_ini(nlon,nlev,trac)
+  USE infotrac_phy, ONLY: nqtot, tname
+  IMPLICIT NONE
+
+  integer :: nlon, nlev
+  real    :: trac(nlon,nlev,nqtot) ! traceur ( en vmr)
+
+  integer :: i
+  real    :: trac1d(nlev,2) ! traceur lu ( en vmr)
+ 
+! lecture d'un fichier texte contenant les profils de trac1d(:1) = H2O et trac1d(:,2) = H2SO4
+
+  DO i=1,nlon
+     trac(i,:,i_h2o) = trac1d(:,1)
+     trac(i,:,i_h2so4) = trac1d(:,2)
+  ENDDO
+
+
+  END SUBROUTINE vapors4muphy_ini
+
 END MODULE chemparam_mod
 
Index: /trunk/LMDZ.VENUS/libf/phyvenus/clesphys.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/clesphys.h	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/clesphys.h	(revision 1661)
@@ -15,5 +15,5 @@
        INTEGER nbapp_rad, nbapp_chim, iflag_con, iflag_ajs
        INTEGER lev_histins, lev_histday, lev_histmth
-       INTEGER tr_scheme
+       INTEGER tr_scheme, cl_scheme
        INTEGER nircorr, nltemodel, solvarmod
        REAL    ecriphy
@@ -32,5 +32,5 @@
      &     iflag_con, iflag_ajs,                                        &
      &     lev_histins, lev_histday, lev_histmth, tr_scheme,            &
-     &     nircorr, nltemodel, solvarmod, nb_mode
+     &     cl_scheme, nircorr, nltemodel, solvarmod, nb_mode
 
        COMMON/clesphys_r/ ecriphy, solaire, z0, lmixmin,                &
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/donnees.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/donnees.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/donnees.F90	(revision 1661)
@@ -0,0 +1,178 @@
+MODULE donnees
+
+  use real16
+  implicit none
+
+  real, parameter :: ZERO = epsilon(1.0_real_16) != 2.220446049250313E-016
+  real, parameter :: PI = 3.1415926536D0
+  real, save :: E          ! Constant for microphys. processes
+
+
+  ! THERMO
+  real, parameter :: kbz = 1.3806488D-23 !m2.kg.s-2.K-2 Boltzmann constant
+  real, parameter :: RGAS = 8.31441D0    !J/(mole K)    Gas constant
+  real, parameter :: LSA = 6.322D5       !J/kg     Latent heat of evap of SA 
+  real, parameter :: MAIR = 43.45D-3     !kg/mole  Molecular mass of venus air
+  real, parameter :: MWV = 18.0153D-3    !kg/mole  Molecular mass of water
+  real, parameter :: CSA = 0.4430057096D0!=MAIR/MSA   
+
+  real, save :: PPSA, PPWV ! Partial pressure of SA and water
+  real, save :: RH     ! Relative Humidity
+  real, save :: KAIR   ! Thermal conductivity of air (J/m sec K)
+  real, save :: KN     ! Knudsen number
+  real, save :: D      ! Molecular diffusivity of the air (m2/s)
+  real, save :: akn    ! Approx slip-flow correction coef
+!  real, parameter :: akn = 1.591D0 ! Approx slip-flow correction coeff 
+
+
+  ! SEDIMENTATION and PRODUCTION
+  !> Fractal dimension of fractal aerosols.
+  REAL, SAVE :: df = 3.D0  ! 3 = sphere
+  !> Monomer radius (m).
+  REAL, SAVE :: rmono = 6.66D-8    
+  REAL, SAVE :: rpla = 6051800.D0 !m Venus radius
+  !> Planet acceleration due to gravity constant (ground) (\(m.s^{-2}\)).
+  REAL, SAVE :: g0 = 6.673D-11*(4.867D24/(6051800.D0)**2) 
+!!$  !> Air molecules mean radius (m).   !SG   Y|°O°|Y 
+  REAL, SAVE :: air_rad  = 1.75D-10
+
+
+  ! MODES  (H2SO4-H2O)
+  real, save :: redge  ! Virtual limits between the two modes
+  real, save :: r1, r2 ! Mean raidus of the distribution (m)
+  real, save :: N1, N2 ! Total number concentration (#/m3)
+  real, save :: NTOT   ! Total number of droplets (mode 1 and 2)
+
+
+  ! DROPLET AND GAS
+  real, save :: WSA, WSAEQ, SH2SO4, RHOSA, RHOsasat
+
+  ! Heterogeneous nucleation parameter (Franck's thesis, p.34)
+  real, parameter :: desorpco2 = 6.D-20  !J   Absorp./desorp. of 1 h2o molecule at the CCN surface
+  real, parameter :: surfdifco2 = 6.D-21 !J   Activation energy for surface diffusion
+  real, parameter :: nusco2 = 1.D+13     !s-1 Jump frequency
+
+  ! CONSERVATION
+  real, save :: CHECKSA
+  real, save :: CHECKWV
+
+  ! H2SO4
+  ! vo1h2so4 = masse 1 moléc. AS en kg / densité AS en kg/m3
+  ! vo1h2so4 = m_point/rho = 1.628656574D-25/1.8302D3
+  real, parameter :: vo1h2so4 = 8.898790154D-29 !m3
+  real, parameter :: m0h2so4 = 1.628640074D-25  !kg       Wettability
+  real, parameter :: MSA = 98.08D-3             !kg/mole  Molecular mass of SA
+  real, save :: ST         ! Surface tension of sulfuric acid solution/vapor (N/m)
+
+  real, save :: sigh2so4 ! tension superficielle de H2SO4
+  real, save :: h2so4_m3 ! Number concentration of H2SO4 (m-3)
+
+  ! RADII GRID (m)
+  real, save, dimension(:), allocatable :: rad_cld,ri,rs,vol
+  real, save ::  vratio
+
+
+
+
+  ! FIADERO'S CORRECTION
+
+  !! This flag enables/disables the __Fiadero__ correction alogrithm for fractal mode settling velocity
+  !! computation.
+  !!
+  !! @bug
+  !! Currently, the Fiadero correction creates instatibilities on the vertical structure. It seems to be
+  !! related to the coupling between the two moments. In order to reduce the instabilities, settling
+  !! velocity of moments are forced to be the same, see [[mm_globals(module):mm_wsed_m0(variable)]] and
+  !! [[mm_globals(module):mm_wsed_m3(variable)]]).
+  LOGICAL, SAVE          :: no_fiadero_w = .false.
+  !> Minimum ratio for __Fiadero__ correction.
+  !!
+  !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the minimum
+  !! value of the moment's ratio between two adjacents vertical cells to be used within the correction.
+  REAL, SAVE :: fiadero_min  = 0.1D0
+  !> Maximum ratio for __Fiadero__ correction.
+  !!
+  !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the maximum
+  !! value of the moment's ratio between two adjacents vertical cells to be used within the correction.
+  REAL, SAVE :: fiadero_max  = 10.D0
+
+  LOGICAL, SAVE :: wsed_m0 = .false. !! Force all aerosols moments to fall at M0 settling velocity.
+  LOGICAL, SAVE :: wsed_m3 = .false. !! Force all aerosols moments to fall at M3 settling velocity.
+
+
+
+contains
+  !  subroutine   build_radius_grid
+  !  SUBROUTINE   logdist   Calculates the lognormal size distribution function with bins
+
+
+!******************************************************************************
+  SUBROUTINE build_radius_grid(nbins,rmi,rma,vratio)
+!******************************************************************************
+    INTEGER, INTENT(in)                                :: nbins
+    REAL, INTENT(in)                     :: rmi,rma
+    REAL, INTENT(out)                    :: vratio
+    INTEGER :: i
+
+    if (allocated(rad_cld)) deallocate(rad_cld)
+    if (allocated(ri)) deallocate(ri)
+    if (allocated(rs)) deallocate(rs)
+    if (allocated(vol)) deallocate(vol)
+    ALLOCATE(rad_cld(nbins),ri(nbins),rs(nbins),vol(nbins))
+  
+    vratio=(rma/rmi)**(3.D0/(nbins-1))
+    vol(1)=4.D0/3.D0*pi*rmi**3
+
+    DO i=1,nbins
+      rad_cld(i)=rmi*vratio**(i/3.D0)
+      IF (i < nbins) vol(i+1)=vol(1)*vratio**i
+      ri(i) = (2.D0/(vratio+1.))**(1.D0/3.D0)*rad_cld(i)
+      rs(i) = (2.D0*vratio/(vratio+1.D0))**(1.D0/3.D0)*rad_cld(i)
+    ENDDO
+
+  END SUBROUTINE build_radius_grid
+
+
+!******************************************************************************
+  SUBROUTINE logdist(sigma,ntotal,r0,rad,n_aer)
+!******************************************************************************
+
+    USE free_param
+    implicit none
+    
+    ! Inputs / Outputs
+    real,intent(in) :: sigma, ntotal, r0
+    real,intent(out) :: n_aer(nbin)
+    real,intent(in) :: rad(nbin)
+
+    ! Local variables
+    real :: lognr,dr,n_aer_erf(nbin),sqr2sig,logsig
+    integer :: i
+
+    dr = ((2.D0*vratio)/(vratio +1.D0))**(1.D0/3.D0) - (2.D0/(vratio + 1.D0))**(1.D0/3.D0)
+
+    logsig = log(sigma)
+    sqr2sig = logsig*sqrt(2.0)
+
+    OPEN(666,FILE="logn.dat")
+
+    DO i=1,nbin
+       lognr = 1.D0 / (sqrt(2.D0*PI)*logsig*rad(i))               !m-1
+       lognr = lognr * exp(-0.5D0*(log(rad(i)/r_aer)/logsig)**2)  !m-1
+       n_aer(i) = lognr*dr*rad(i) !#
+       n_aer_erf(i) =  0.5 * (erf(log(rs(i)/r_aer)/sqr2sig) - erf(log(ri(i)/r_aer)/sqr2sig))
+       WRITE(666,'(6(ES15.7,2X))') rad(i),lognr,n_aer(i), n_aer_erf(i), rad(i)*dr, rs(i)-ri(i)
+    END DO
+
+    CLOSE(666)
+
+!    write(*,'(a,2(ES15.7,1X))') "logdist: nAER(norm), ERF method = ", SUM(n_aer(:)),SUM(n_aer_erf)
+    n_aer(:) = n_aer(:)*ntotal
+!    write(*,'((a),2(ES15.7,1X))') '  -->      total', SUM(n_aer(:)), ntotal
+!    write(*,'((a),ES15.7)')       '  --> rel. error', abs(SUM(n_aer(:))-ntotal)/ntotal
+!    write(*,'(a)') 'Using erf METHOD (more accurate)'
+    n_aer(:) = n_aer_erf(:) * ntotal
+
+  END SUBROUTINE logdist
+
+END MODULE donnees
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/drop_coagul.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/drop_coagul.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/drop_coagul.F90	(revision 1661)
@@ -0,0 +1,13 @@
+
+SUBROUTINE drop_coagul(TAIR,PAIR,dt,M0_m1,M3_m1,M0_m2,M3_m2)
+
+  implicit none
+
+  real, intent(in) :: TAIR, PAIR
+  real, intent(in) :: dt
+
+  real, intent(inout) :: M0_m1, M3_m1, M0_m2, M3_m2
+
+  print*, 'plop coagulation'
+
+END SUBROUTINE drop_coagul
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/flux.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/flux.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/flux.F90	(revision 1661)
@@ -0,0 +1,73 @@
+SUBROUTINE FLUX(TAIR,PAIR,dt,sig,r,M3g,dM0,dM3)
+
+  !*  Masses flux = Condensation/Evaporation + Thermodynamical equilibrium
+  !* 
+  !*  Condensation/Evaporation:
+  !*    Sulfuric acid drive this process (James 1997): most present in droplets
+  !*    more or less 95%
+  !*
+  !*  Thermodynamical equilibrium:
+  !*    Only water flux here (James 1997) => compare to acid vapor, water 
+  !*    vapor is most present in the atmosphere
+  !*
+  !*  ONLY FOR ONE MODE HERE
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  real, intent(in), dimension(3) :: M3g ! Third moment of the mode
+  real, intent(in) :: TAIR, PAIR, dt    ! Temp, timestep, pressure
+  real, intent(in) :: r, sig      ! Mean radius and variance of the mode
+  real, intent(out) :: dM3, dM0   ! Tendancy
+
+  real :: RDSA, RCSA               ! Resistance
+  real :: A , B, cste, a1, a2, a3  ! Calculus cstes
+  real :: alpha_k   ! Function
+  real :: MSAD      ! Mass of sulfuric acid in the droplet, in kg
+  real :: mk3       ! Tendancy
+  real :: gamma
+
+
+  ! ----- EQUILIBRIUM -----
+  CALL WSA_ROSA_NEW(TAIR,PAIR,r,WSAEQ,MSAD) ! Calculation of WSA
+
+  ! ----- CONDENSATION / EVAPORATION -----
+  IF (WSAEQ .gt. 0) THEN
+     ! Resistance due to the VAPOR diffusion (s/m2)
+     ! Here, we supposed a Dirac function for the calculation of D (Kn(r)
+     RDSA = (RHOSA*RGAS*TAIR) / (D*MSA*RHOsasat)
+     ! Resistance due to the HEAT diffusion (s/m2)
+     RCSA = (LSA*RHOSA)/(KAIR*TAIR) * ((LSA*MSA)/(RGAS*TAIR)-1.0D0)
+
+     A = 2.0D0*ST*MSA / (RHOSA*RGAS*TAIR) !m
+     B = exp(A/r)  
+     cste = 3.0D0/(RCSA+RDSA)
+
+     a1 = SH2SO4-B-A*B/r-(r**2)*B*A/2.0D0*(2.0D0*r+A)/(r**4)
+     a2 = A*B/(r**3) * (A+3.0D0*r)                  !m-1
+     a3 = (-1.0D0)*A*B * (2.0D0*r+A)/(2.0D0*r**4)   !m-2
+
+     gamma = (a1 * r**(-2) * alpha_k(1,sig)/alpha_k(3,sig) + &
+          &  a2 * r**(-1) * alpha_k(2,sig)/alpha_k(3,sig) + &
+          &  a3) * cste
+
+     mk3 = (1.D0/dt)*((WSA/WSAEQ) - 1.D0)*dt
+     mk3 = mk3 + (gamma/WSAEQ)
+     mk3 = 1.D0 - mk3
+     mk3 = (1.D0/mk3) * (M3g(1)+M3g(2)+M3g(3))
+
+     ! ----- TOTAL FLUX -----
+     !  dm < 0: evaporation and dm > 0: condensation
+     dM3 = mk3 - (M3g(1) + M3g(2) + M3g(3)) !m3 s
+     dM0 = dM3 / (r**3*alpha_k(3,sig))
+  ELSE
+     dM3 = 0.D0
+     dM0 = 0.D0
+  END IF
+
+  WSA = WSAEQ
+
+  RETURN 
+END SUBROUTINE FLUX
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/free_param.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/free_param.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/free_param.F90	(revision 1661)
@@ -0,0 +1,54 @@
+MODULE free_param
+  
+  implicit none
+  
+  ! TIME (s) 
+!  real, parameter :: TSTOP = 3 !Stop
+  real, parameter :: TSTOP = 3600 !Stop
+!  real, parameter :: TSTOP = 86400.0D0 ! Stop
+
+  integer, parameter :: nbin = 100
+
+
+  ! FLAGS
+  logical, parameter :: MERGE     = .FALSE. ! Mode merging
+  logical, parameter :: NUCLEA    = .TRUE.  ! Homogeneous nucleation
+  logical, parameter :: MASSFLUX  = .TRUE.  ! Thermodyn. equi. and cond./evap.
+  logical, parameter :: HETNUCLEA = .FALSE.  ! Heterogeneous nucleation
+  logical, parameter :: SEDIM     = .FALSE.  ! Sedimentation
+  logical, parameter :: COAG      = .FALSE. ! Coagulation
+  integer, parameter :: PROD      = 0       ! No aer production
+!!  integer, parameter :: PROD      = 1       ! Aer production with normal distri
+!  integer, parameter :: PROD      = 2       ! Production only in 1 layer
+  
+
+  ! MODE 1 & 2 - James 1997 + Knollenberg and Hunten 1980
+  ! Be careful, you need to change sigma in sed_and_prod.f90 too
+  real, parameter :: sigma1 = 1.56D0  ! Geometric standard deviation
+  real, parameter :: ri1 = 3.0D-7     ! Geometric radius (m)
+  real, parameter :: sigma2 = 1.29D0  ! Geometric standard deviation
+  real, parameter :: ri2 = 1.0D-6     ! Geometric radius (m)  
+
+  
+  ! RADIUS GRID
+  real, parameter ::  rmin = 0.0001D-6 !m
+  real, parameter ::  rmax = 100.0D-6  !m
+
+  
+  ! PRODUCTION - AEROSOL     NB:  The source should be at more or less 55km !
+  real, parameter :: r_aer = 0.125D-6      !m
+  real, parameter :: p_aer = 310000.D0     !Pa, 40km on Venus
+!  real, parameter :: p_aer = 260000.D0     !Pa, 40km on Venus
+  real, parameter :: sig_aer = 1.56D0      !Of the distribution, same as mode 1
+  real, save      :: ntot_aer              !#/m-3
+  real, parameter :: ntot_aer_flag2 = 4.D5 !#/m-3
+  real, parameter :: tx_prod = 9.D-7       !kg.m-2.s-1, JB:tx_prod = 3.5D-13
+  real, parameter :: rho_aer = 2000.D0     !kg/m-3
+  REAL, PARAMETER :: sigz  = 20.0D3        ! currently set to 20km
+
+
+  ! HETEROGENEOUS NUCLEATION
+  real, parameter :: mtetalocal = 0.952D0 ! moullabilite
+
+
+END MODULE free_param
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mad_muphy.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mad_muphy.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mad_muphy.F90	(revision 1661)
@@ -0,0 +1,614 @@
+!-----------------------------------------------------------------------
+! S.GUILBON - LATMOS - 2016.
+!-----------------------------------------------------------------------
+! PROGRAM MAD contains
+!
+!  SUBROUTINE   MAD_MUPHY        Microphysical processes with moments
+!  SUBROUTINE   change_layer     Need if layer changes
+!  SUBROUTINE   change_wsa       Need if wsa changes
+!  SUBROUTINE   change_vapor     Need if number concentration of vapor changes
+!  FUNCTION     logn
+!  FUNCTION     moment
+
+!------------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------------
+SUBROUTINE MAD_MUPHY(dt,TAIR,PAIR,MRWV_loc,MRSA_loc,M0_aeros,M3_aeros,  &
+                           M0_m1drop,M0_m1ccn,M3_m1sa,M3_m1w,M3_m1ccn,  &
+	                   M0_m2drop,M0_m2ccn,M3_m2sa,M3_m2w,M3_m2ccn)
+  ! Loop on lat and long outside this subroutine => in phytrac_chimie
+!------------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------------
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  integer :: i, mode
+
+  ! LAYER
+  real, intent(in) :: TAIR, PAIR, dt 
+  real, intent(inout) :: MRWV_loc, MRSA_loc
+
+  ! MOMENTS
+  real, intent(inout):: M0_aeros, M3_aeros
+  real, intent(inout):: M0_m1drop,M0_m1ccn,M0_m2drop,M0_m2ccn
+  real, intent(inout):: M3_m1sa,M3_m1w,M3_m1ccn,M3_m2sa,M3_m2w,M3_m2ccn
+
+  ! MODAL TENDENCIES
+  real, dimension(2) :: M0_m1, M0_m2 
+  real, dimension(3) :: M3_m1, M3_m2
+  real :: p, k                        ! Modal order
+  real :: sum_M0, sum_M3              ! Sum of moment
+  real :: dM0_merge_m1, dM3_merge_m1  ! Mode merging mode 1
+  real :: dM0_merge_m2, dM3_merge_m2  ! Mode merging mode 2
+  real :: dM0_flux_m1,  dM0_flux_m2   ! Masse flux, only M0, mode 1 and 2
+  real :: dM3_flux_m1,  dM3_flux_m2   ! Masse flux, only M3, mode 1 and 2
+  real :: dM0_aeros, dM3_aeros, ra    ! Heterogeneous nucleation, only aerosol
+  real :: dM0_hom, dM3_hom            ! Homogeneous nucleation, only mode 1
+  real :: dM0_het, dM3_het            ! Heterogeneous nucleation, only mode 1
+  real :: dM0_m1_drop, dM0_m1_ccn, dM3_m1_SA, dM3_m1_WV, dM3_m1_ccn, dM0_aeros_m2
+  real :: dM0_m2_drop, dM0_m2_ccn, dM3_m2_SA, dM3_m2_WV, dM3_m2_ccn, dM3_aeros_m2
+  real :: dM3_m1, dM3_m2, dM3, dM3_SA1, dM3_SA2, dM3_WV1, dM3_WV2, dM3_SA, dM3_WV
+  real :: frac_ccn_m1, frac_ccn_m2
+
+  ! CONSERVATION Variables
+  real :: var_mode1_M0, var_mode1_M3, var_mode2_M0, var_mode2_M3
+  real :: var_MRSA_m1, var_MRWV_m1
+  real :: var_MRSA_m2, var_MRWV_m2
+  real :: var_MR_m1, var_MR_m2, var_MRSA, var_MRWV
+  real :: factor, diff, check, MRTOT
+
+  ! FUNCTIONS
+  real :: moment, D0, alpha_k
+
+  ! OUTPUTS and GRAPHES
+  real, dimension(nbin) :: n_g1
+  integer :: cpt
+
+  !-------------
+
+  ! Initialization of vectors
+  M0_m1(1)=M0_m1drop
+  M0_m1(2)=M0_m1ccn
+  M0_m2(1)=M0_m2drop
+  M0_m2(2)=M0_m2ccn
+  M3_m1(1)=M3_m1sa
+  M3_m1(2)=M3_m1w
+  M3_m1(3)=M3_m1ccn
+  M3_m2(1)=M3_m2sa
+  M3_m2(2)=M3_m2w
+  M3_m2(3)=M3_m2ccn
+  
+  !-------------
+
+  ! Initialization of tendencies   
+  dM0_hom = 0.D0      ;  dM3_hom = 0.D0
+  dM0_het = 0.D0      ;  dM3_het = 0.D0 
+  dM0_aeros = 0.D0    ;  dM3_aeros = 0.D0  
+  dM0_flux_m1 = 0.D0  ;  dM0_flux_m2 = 0.D0
+  dM3_flux_m1 = 0.D0  ;  dM3_flux_m2 = 0.D0
+  dM0_merge_m1 = 0.D0 ;  dM3_merge_m1 = 0.D0 
+  dM0_merge_m2 = 0.D0 ;  dM3_merge_m2 = 0.D0 
+
+  !-------------
+
+  ! To controle the conservation !
+  ! Total mass (vapor + cond) of species (h2o + h2so4)
+  sum_M3 = M3_m1(1) + M3_m1(2) + M3_m1(3) ! mode 1
+  MRTOT = sum_M3/(exp(4.5D0*log(sigma1)))
+  sum_M3 = M3_m2(1) + M3_m2(2) + M3_m2(3) ! mode 2
+  MRTOT = MRTOT + sum_M3/(exp(4.5D0*log(sigma2)))
+  MRTOT = MRTOT*(4.0D0/3.0D0)*PI*RHOSA    ! total condensed mass of SA
+  MRTOT = MRTOT*WSA/(MSA*E) + MRTOT*(1.D0-WSA)/(MWV*E) + MRSA_loc + MRWV_loc ! in vapor quantity
+  check = MRTOT
+
+!-----------------------------------------------------------------------
+!                    INITIALIZATION - THERMO
+!-----------------------------------------------------------------------
+  WSA = 0.01D0    ! Init. of the fraction of sulfuric acid [0.1;1]
+  WSAEQ = 0.0D0   ! WSA at equilibrium
+
+  call change_wsa(TAIR,PAIR,MRSA_loc)            ! Need if wsa changes
+  call change_layer(TAIR,PAIR)                   ! Need if layer changes
+  call change_vapor(TAIR,PAIR,MRSA_loc,MRWV_loc) ! Need if nb vapor concentration changes
+
+  ! Number concentration of H2SO4 (m-3)
+  h2so4_m3 = MRSA_loc*PAIR/(KBZ*TAIR) 
+
+!-----------------------------------------------------------------------
+!                           MODE MERGING
+!----------------------------------------------------------------------- 
+  IF (SEDIM .and. MERGE) THEN
+     redge = (r1*r2)**0.5D0 ! Edge radius of mode 1
+     write(*,*)'The intersection size or virtual bonduary', redge
+
+     IF (r1 .EQ. redge) THEN
+        write(*,*)'Mode 1 merge to mode 2', redge, r1
+        CALL MERGING(r1,N1,sigma1,sigma2,dM0_merge_m1,dM3_merge_m1, &
+             &   dM0_merge_m2,dM3_merge_m2)
+        ! mode 1
+        M0_m1(1) = dM0_merge_m1
+        M0_m1(2) = dM0_merge_m1*frac_ccn_m1
+        M3_m1(1) = dM3_merge_m1*(1.D0-frac_ccn_m1)*WSA
+        M3_m1(2) = dM3_merge_m1*(1.D0-frac_ccn_m1)*(1.D0-WSA)
+        M3_m1(3) = dM3_merge_m1*frac_ccn_m1
+        ! mode 2
+        M0_m2(1) = M0_m2(1) + dM0_merge_m2
+        M0_m2(2) = M0_m2(2) + dM0_merge_m2*(frac_ccn_m2+frac_ccn_m1)
+        M3_m2(1) = M3_m2(1) + dM3_merge_m2*(1.D0-(frac_ccn_m2+frac_ccn_m1))*WSA
+        M3_m2(2) = M3_m2(2) + dM3_merge_m2*(1.D0-(frac_ccn_m2+frac_ccn_m1))*(1.D0-WSA)
+        M3_m2(3) = M3_m2(3) + dM3_merge_m2*(frac_ccn_m2+frac_ccn_m1)
+     ENDIF
+
+     IF (r2 .EQ. redge) THEN
+        write(*,*)'Mode 2 merge to mode 1',redge,r2
+        CALL MERGING(r2,N2,sigma2,sigma1,dM0_merge_m2,dM3_merge_m2, &
+             &   dM0_merge_m1,dM3_merge_m1)
+        ! mode 1
+        M0_m2(1) = dM0_merge_m2
+        M0_m2(2) = dM0_merge_m2*frac_ccn_m2
+        M3_m2(1) = dM3_merge_m2*(1.D0-frac_ccn_m2)*WSA
+        M3_m2(2) = dM3_merge_m2*(1.D0-frac_ccn_m2)*(1.D0-WSA)
+        M3_m2(3) = dM3_merge_m2*frac_ccn_m2
+        ! mode 2
+        M0_m1(1) = M0_m1(1) + dM0_merge_m1
+        M0_m1(2) = M0_m1(2) + dM0_merge_m1*(frac_ccn_m2+frac_ccn_m1)
+        M3_m1(1) = M3_m1(1) + dM3_merge_m1*(1.D0-(frac_ccn_m2+frac_ccn_m1))*WSA
+        M3_m1(2) = M3_m1(2) + dM3_merge_m1*(1.D0-(frac_ccn_m2+frac_ccn_m1))*(1.D0-WSA)
+        M3_m1(3) = M3_m1(3) + dM3_merge_m1*(frac_ccn_m2+frac_ccn_m1)
+     ENDIF
+  ENDIF
+
+
+!-----------------------------------------------------------------------
+!                           NUCLEATION                       Only mode 1
+!-----------------------------------------------------------------------
+  IF(NUCLEA) then ! HOmogeneous NUcleation with MOment
+     CALL HONUMO(TAIR,dt,M0_m1,M3_m1,dM0_hom,dM3_hom) !#.m(air)-3 and m3.m(air)-3
+  ENDIF
+
+  IF(HETNUCLEA) then ! HETerogeneous NUcleation with MOment
+     ! Calculation of ra (mean radius of aerosols) before heterogeneous nucleation
+     ! Needed ra to calculate the bin idstrib to determine Jhet.
+     IF (M0_aeros .le. ZERO) THEN ! Mean radii MODE AER
+        ra = 0.D0
+     ELSE
+        ra = (1.D0/alpha_k(3,sig_aer) * M3_aeros/M0_aeros)**(1.D0/3.D0)     
+     ENDIF
+
+     CALL HETNUMO(TAIR,dt,ra,M0_aeros,M3_aeros,M0_m1,M3_m1, &
+          & dM0_aeros,dM3_aeros,dM0_het,dM3_het)
+  ENDIF
+
+
+!-----------------------------------------------------------------------
+!                           MASSES FLUX                       Mode 1 & 2
+!-----------------------------------------------------------------------
+  ! We can have condensation/evaporation if we have some particles :)
+  ! Conditions : flag + mode + gas
+  IF (MASSFLUX .and. (M0_m1(1).gt.ZERO)) THEN ! Mode 1
+     CALL FLUX(TAIR,PAIR,dt,sigma1,r1,M3_m1,dM0_flux_m1,dM3_flux_m1)
+  ENDIF
+
+  IF (MASSFLUX .and. (M0_m2(1).gt.ZERO))  THEN ! Mode 2
+     CALL FLUX(TAIR,PAIR,dt,sigma2,r2,M3_m2,dM0_flux_m2,dM3_flux_m2)
+  ENDIF
+
+
+!-----------------------------------------------------------------------
+!                           CONSERVATION                      Mode 1 & 2
+!----------------------------------------------------------------------- 
+  ! M3(1) sulfuric acid
+  ! M3(2) water
+  ! M3(3) condensed cloud nuclei
+  !-------------------------------------!
+
+
+  !--------AEROSOLS / HETERONUC---------!
+  ! We just modify the tendencies. They will be add to moments.
+  IF ((M0_aeros + dM0_aeros) .le. ZERO) THEN
+     dM0_aeros = (-1.D0) * M0_aeros
+     dM3_aeros = (-1.D0) * M3_aeros
+     dM0_het = M0_aeros
+     dM3_het = M3_aeros
+  ENDIF
+  !-------------------------------------!
+
+
+  !----------SUM OF TENDENCIES----------!
+  ! +5% of ccn vol to condensed mass to active the mass flux in next time step.
+  ! Mode 1
+  dM0_m1_drop = dM0_hom + dM0_het + dM0_flux_m1
+  dM0_m1_ccn = dM0_het
+  dM3_m1_SA = (dM3_hom + dM3_het + dM3_flux_m1) * WSA
+  dM3_m1_WV = (dM3_hom + dM3_het + dM3_flux_m1) * (1.D0-WSA)
+  dM3_m1_ccn = dM3_het
+  ! Mode 2
+  dM0_m2_drop = dM0_flux_m2
+  dM0_m2_ccn = 0.D0
+  dM3_m2_SA = dM3_flux_m2 * WSA
+  dM3_m2_WV = dM3_flux_m2 * (1.D0-WSA)
+  dM3_m2_ccn = 0.D0
+  ! Aerosols and CCN
+  dM0_aeros_m2 = 0.D0
+  dM3_aeros_m2 = 0.D0
+  !-------------------------------------!
+
+
+  !--------TOO MUCH EVAPORATION---------!
+  ! We just modify the tendencies. They will be add to moments.
+  IF ((M3_m1(1) + dM3_m1_SA) .le. ZERO) THEN
+     dM3_m1_SA = (-1.D0) * M3_m1(1) !-- vol acid
+  ENDIF
+  IF ((M3_m1(2) + dM3_m1_WV) .le. ZERO) THEN
+     dM3_m1_WV = (-1.D0) * M3_m1(2) !-- vol water
+  ENDIF
+  IF ((M0_m1(1) + dM0_m1_drop) .le. ZERO) THEN
+     dM0_m1_drop = (-1.D0)* M0_m1(1) !-- nb droplets
+     dM0_m1_ccn = (-1.D0) * M0_m1(2) !-- nb ccn
+     dM3_m1_SA  = (-1.D0) * M3_m1(1) !-- acid
+     dM3_m1_WV  = (-1.D0) * M3_m1(2) !-- water
+     dM3_m1_ccn = (-1.D0) * M3_m1(3) !-- ccn
+     dM0_aeros = M0_m1(2)        !++ nb ccn
+     dM3_aeros = M3_m1(3)        !++ vol ccn
+  ENDIF
+  ! Second mode of particles !
+  IF ((M3_m2(1) + dM3_m2_SA) .le. ZERO) THEN
+     dM3_m2_SA = (-1.D0) * M3_m2(1) !-- vol acid
+  ENDIF
+  IF ((M3_m2(2) + dM3_m2_WV) .le. ZERO) THEN
+     dM3_m2_WV = (-1.D0) * M3_m2(2) !-- vol water
+  ENDIF
+  IF ((M0_m2(1) + dM0_m2_drop) .le. ZERO) THEN
+     dM0_m2_drop = (-1.D0)* M0_m2(1) !-- nb droplets
+     dM0_m2_ccn = (-1.D0) * M0_m2(2) !-- nb ccn
+     dM3_m2_SA  = (-1.D0) * M3_m2(1) !-- acid
+     dM3_m2_WV  = (-1.D0) * M3_m2(2) !-- water
+     dM3_m2_ccn = (-1.D0) * M3_m2(3) !-- ccn
+     dM0_aeros_m2 = M0_m2(2)         !++ nb ccn
+     dM3_aeros_m2 = M3_m2(3)         !++ vol ccn
+  ENDIF
+  !-------------------------------------!
+
+
+  !--------TOO MUCH CONDENSATION--------!
+  ! SUM with new tendencies
+  dM3_m1 = dM3_m1_SA + dM3_m1_WV
+  dM3_m2 = dM3_m2_SA + dM3_m2_WV
+  ! Vapor mode 1
+  dM3 = dM3_m1 / (exp(4.5D0*log(sigma1)))
+  dM3 = RHOSA * 4.D0/3.D0 * PI * dM3_m1 ! mass
+  dM3_SA1 = (dM3_m1*WSA)/(MSA*E)                     ! Total consumed SA vapor 
+  dM3_WV1 = (dM3_m1*(1.D0-WSA))/(MWV*E)              ! Total consumed water vapor 
+  ! Vapor mode 2
+  dM3 = dM3_m2/(exp(4.5D0*log(sigma2)))
+  dM3 = RHOSA * 4.D0/3.D0 * PI * dM3_m2 ! mass
+  dM3_SA2 = (dM3_m2*WSA)/(MSA*E)           ! Total consumed SA vapor 
+  dM3_WV2 = (dM3_m2*(1.D0-WSA))/(MWV*E)    ! Total consumed water vapor 
+  ! Sum with distinguished mode: not same process for mode 1 and mode 2
+  dM3_SA = dM3_SA1 + dM3_SA2 ! h2so4
+  dM3_WV = dM3_WV1 + dM3_WV2 ! h2o
+  ! We just modify the tendencies. They will be add to moments.
+  ! we define a sort of purcentage of participation for each moment.
+  IF (((MRSA_loc + dM3_SA) .le. ZERO).and.(dM3_SA.ne.0.D0).and.(WSA.ne.0.D0)) THEN ! Comsuption of all H2SO4 vapor
+     dM3_m1_SA = dM3_SA1/dM3_SA * MRSA_loc * MSA*E/WSA * 1.D0/(RHOSA*4.D0/3.D0*PI)*alpha_k(3,sigma1)
+     dM3_m2_SA = dM3_SA2/dM3_SA * MRSA_loc * MSA*E/WSA * 1.D0/(RHOSA*4.D0/3.D0*PI)*alpha_k(3,sigma2)
+     dM3_SA = dM3_SA1 + dM3_SA2
+  ENDIF
+  IF (((MRWV_loc + dM3_WV) .le. ZERO).and.(dM3_WV.ne.0.D0)) THEN  ! Comsuption of all H2O vapor
+     dM3_m1_WV = dM3_WV1/dM3_WV * MRWV_loc * MWV*E/(1.D0-WSA) * 1.D0/(RHOSA*4.D0/3.D0*PI)*alpha_k(3,sigma1)
+     dM3_m2_WV = dM3_WV2/dM3_WV * MRWV_loc * MWV*E/(1.D0-WSA) * 1.D0/(RHOSA*4.D0/3.D0*PI)*alpha_k(3,sigma2)
+     dM3_WV = dM3_WV1 + dM3_WV2
+  ENDIF
+  !------------------------------------!
+
+
+  !-------------UPDATES----------------!
+  ! Updates Vapors !
+  MRSA_loc = MRSA_loc + dM3_SA ! acid
+  MRWV_loc = MRWV_loc + dM3_WV ! water
+  ! Updtaes of CCN and Aerosols
+  M0_aeros = M0_aeros + dM0_aeros +  dM0_aeros_m2     ! number of aerosols
+  M3_aeros = M3_aeros + dM3_aeros +  dM3_aeros_m2     ! vol/mass of aerosols  
+  ! Updates moments - Mode 1
+  M0_m1(1) = M0_m1(1) + dM0_m1_drop ! number of droplets
+  M0_m1(2) = M0_m1(2) + dM0_m1_ccn  ! number of CCN in droplets
+  M3_m1(1) = M3_m1(1) + dM3_m1_SA   ! vol/mass of Héso4 in droplets
+  M3_m1(2) = M3_m1(2) + dM3_m1_WV   ! vol/mass of h2o in droplets
+  M3_m1(3) = M3_m1(3) + dM3_m1_ccn  ! vol/mass of CCN in droplets
+  ! Updates moments - Mode 2
+  M0_m2(1) = M0_m2(1) + dM0_m2_drop
+  M0_m2(2) = M0_m2(2) + dM0_m2_ccn
+  M3_m2(1) = M3_m2(1) + dM3_m2_SA
+  M3_m2(2) = M3_m2(2) + dM3_m2_WV
+  M3_m2(3) = M3_m2(3) + dM3_m2_ccn
+  !------------------------------------!
+  write(*,*)'l.653: after up', M3_m1(1),M3_m1(2),M3_m1(3),dM3_m1_SA,dM3_m1_WV,dM3_m1_ccn
+  write(*,*)'l.654: after up', M0_m1(1),M0_m1(2),dM0_m1_drop
+!-----------------------------------------------------------------------
+  ! To controle/check the mass conservation !
+  MRTOT = (M3_m1(1)+M3_m1(2))/(exp(4.5D0*log(sigma1)))         ! mode 1
+  MRTOT = MRTOT + (M3_m2(1)+M3_m2(2))/(exp(4.5D0*log(sigma2))) ! mode 2
+  MRTOT = MRTOT * (4.0D0/3.0D0)*PI*RHOSA                       ! mass 
+  MRTOT = MRTOT*WSA/(MSA*E) + MRTOT*(1.D0-WSA)/(MWV*E)         ! binary solution !     
+  MRTOT = MRTOT + MRSA_loc + MRWV_loc                          ! with vapor gas
+  diff = check - MRTOT                                         ! difference ?
+
+  if (diff .gt. ZERO) then
+     write(*,*) 'MASS CHANGEs !!!', diff
+     stop
+  endif
+
+  ! Updates
+  call change_wsa(TAIR,PAIR,MRSA_loc)
+  call change_vapor(TAIR,PAIR,MRSA_loc,MRWV_loc)
+
+
+!-----------------------------------------------------------------------
+!                           COAGULATION
+!----------------------------------------------------------------------- 
+!!$  IF (COAG) THEN
+!!$     CALL drop_coagul(TAIR,PAIR,dt,M0_m1,M3_m1,M0_m2,M3_m2)
+!!$  END IF
+
+
+!-----------------------------------------------------------------------
+!                        R_mean AND N_tot
+!----------------------------------------------------------------------- 
+  
+  IF (M0_m1(1) .le. ZERO) THEN ! Mean radii MODE 1
+     r1 = 0.D0
+     N1 = 0.D0
+     M0_m1(1) = 0.D0
+     M0_aeros = M0_aeros + M0_m1(2)
+     M0_m1(2) = 0.D0
+     M3_m1(1) = 0.D0
+     M3_m1(2) = 0.D0
+     M3_aeros = M3_aeros + M3_m1(3)
+     M3_m1(3) = 0.D0
+  ELSE
+     r1 = (1.D0/alpha_k(3,sigma1) * (M3_m1(1)+M3_m1(2)+M3_m1(3))/M0_m1(1))**(1.D0/3.D0)
+     N1 = M0_m1(1)
+     IF ((r1 .lt. ZERO) .or. (N1.lt.ZERO)) THEN
+        r1 = 0.D0
+        N1 = 0.D0
+     ENDIF
+     write(*,*)'rmean not ZERO',r1,N1,M0_m1(1),M3_m1(1),WSA
+  ENDIF
+  
+  IF (M0_m2(1) .le. ZERO) THEN ! Mean radii MODE 2
+     r2 = 0.D0
+     N2 = 0.D0
+     M0_m2(1) = 0.D0
+     M0_aeros = M0_aeros + M0_m2(2)
+     M0_m2(2) = 0.D0
+     M3_m2(1) = 0.D0
+     M3_m2(2) = 0.D0
+     M3_aeros = M3_aeros + M3_m2(3)
+     M3_m2(3) = 0.D0
+  ELSE
+     r2 = (1.D0/alpha_k(3,sigma2) * (M3_m2(1)+M3_m2(2)+M3_m2(3))/M0_m2(1))**(1.D0/3.D0)
+     N2 = M0_m2(1)
+     IF ((r2 .lt. ZERO) .or. (N2.lt.ZERO)) THEN
+        r2 = 0.D0
+        N2 = 0.D0
+     ENDIF
+  ENDIF
+
+  IF (M0_aeros .le. ZERO) THEN ! Mean radii MODE AER
+     ra = 0.D0
+  ELSE
+     ra = (1.D0/alpha_k(3,sig_aer) * M3_aeros/M0_aeros)**(1.D0/3.D0)     
+  ENDIF
+
+  NTOT = N1 + N2
+  ! CCN fraction in distribution => based on mode 1, like WSA ratio !
+  frac_ccn_m1 = M0_m1(2)/(M0_m1(1)+M0_m1(2))
+  frac_ccn_m2 = M0_m2(2)/(M0_m2(1)+M0_m2(2))
+
+  write(*,*)'rmean',r1,'NTOT',N1, 'SH2SO4', SH2SO4
+
+
+!-----------------------------------------------------------------------
+!                           MODE MERGING
+!----------------------------------------------------------------------- 
+  IF (MERGE) THEN
+     redge = (r1*r2)**0.5D0 ! Edge radius of mode 1
+     write(*,*)'The intersection size or virtual bonduary', redge
+
+     IF (r1 .EQ. redge) THEN
+        write(*,*)'Mode 1 merge to mode 2', redge, r1
+        CALL MERGING(r1,N1,sigma1,sigma2,dM0_merge_m1,dM3_merge_m1, &
+             &   dM0_merge_m2,dM3_merge_m2)
+        ! mode 1
+        M0_m1(1) = dM0_merge_m1
+        M0_m1(2) = dM0_merge_m1*frac_ccn_m1
+        M3_m1(1) = dM3_merge_m1*(1.D0-frac_ccn_m1)*WSA
+        M3_m1(2) = dM3_merge_m1*(1.D0-frac_ccn_m1)*(1.D0-WSA)
+        M3_m1(3) = dM3_merge_m1*frac_ccn_m1
+        ! mode 2
+        M0_m2(1) = M0_m2(1) + dM0_merge_m2
+        M0_m2(2) = M0_m2(2) + dM0_merge_m2*(frac_ccn_m2+frac_ccn_m1)
+        M3_m2(1) = M3_m2(1) + dM3_merge_m2*(1.D0-(frac_ccn_m2+frac_ccn_m1))*WSA
+        M3_m2(2) = M3_m2(2) + dM3_merge_m2*(1.D0-(frac_ccn_m2+frac_ccn_m1))*(1.D0-WSA)
+        M3_m2(3) = M3_m2(3) + dM3_merge_m2*(frac_ccn_m2+frac_ccn_m1)
+     ENDIF
+
+     IF (r2 .EQ. redge) THEN
+        write(*,*)'Mode 2 merge to mode 1',redge,r2
+        CALL MERGING(r2,N2,sigma2,sigma1,dM0_merge_m2,dM3_merge_m2, &
+             &   dM0_merge_m1,dM3_merge_m1)
+        ! mode 1
+        M0_m2(1) = dM0_merge_m2
+        M0_m2(2) = dM0_merge_m2*frac_ccn_m2
+        M3_m2(1) = dM3_merge_m2*(1.D0-frac_ccn_m2)*WSA
+        M3_m2(2) = dM3_merge_m2*(1.D0-frac_ccn_m2)*(1.D0-WSA)
+        M3_m2(3) = dM3_merge_m2*frac_ccn_m2
+        ! mode 2
+        M0_m1(1) = M0_m1(1) + dM0_merge_m1
+        M0_m1(2) = M0_m1(2) + dM0_merge_m1*(frac_ccn_m2+frac_ccn_m1)
+        M3_m1(1) = M3_m1(1) + dM3_merge_m1*(1.D0-(frac_ccn_m2+frac_ccn_m1))*WSA
+        M3_m1(2) = M3_m1(2) + dM3_merge_m1*(1.D0-(frac_ccn_m2+frac_ccn_m1))*(1.D0-WSA)
+        M3_m1(3) = M3_m1(3) + dM3_merge_m1*(frac_ccn_m2+frac_ccn_m1)
+     ENDIF
+  ENDIF
+
+
+!-----------------------------------------------------------------------
+!                          OUTPUTS => GRAPHES ! :D
+!-----------------------------------------------------------------------
+  if (dt .eq. 1) then
+     write(*,*) 'Ntot, rc mode 1: ', N1,r1
+     ! Log-normal distribution function
+     CALL build_radius_grid(nbin,rmin,rmax,vratio)
+     CALL logdist(sigma1,N1,r1,rad_cld,n_g1)
+     DO i = 1, nbin
+        open(888,file='ND_t3600_nuc-het-flux_dt1_1step_sssat')
+        write(888,'(I10,2X,3(ES15.7,1X))') i, rad_cld(i), n_g1(i)
+     ENDDO
+  endif
+
+
+  RETURN
+END SUBROUTINE MAD_MUPHY
+
+
+!*****************************************************************************
+!                              *************                                 !
+!                               SUBROUTINES                                  !
+!                              *************                                 !
+!*****************************************************************************
+SUBROUTINE change_layer(TAIR,PAIR)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  real, intent(in) :: TAIR, PAIR
+  real :: FPLAIR, DFWVA, MFPAIR, CDTAIR
+
+  MFPAIR = FPLAIR(TAIR,PAIR) ! Mean free path of air molecules
+  write(*,*) 'MFPAIR',MFPAIR, TAIR, PAIR
+  Kn = MFPAIR/ri1             ! Knudsen number 
+
+  D = DFWVA(TAIR,PAIR)      ! Molecular diffusivity of the air (m2/s)
+  Akn = Kn*(1.333D0+0.71D0*(1.0D0/Kn)/(1.0D0+(1.0D0/Kn)))
+  D = D/(1.0D0 + Akn)
+
+  E = PAIR / (KBZ*TAIR)  ! Constant for microphys. processes
+
+  KAIR = CDTAIR(TAIR)        ! Thermal conductivity of air (J/m sec K)
+
+END SUBROUTINE change_layer
+
+
+!*****************************************************************************
+SUBROUTINE change_wsa(TAIR,PAIR,MRSA_loc)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  real, intent(in) :: TAIR, PAIR, MRSA_loc
+  real :: ROSAS, PSASAS_ZELE,  STSAS
+  write(*,*)'checkpoint change_wsa', ST, RHOSA, RHOsasat, PSASAS_ZELE(TAIR,WSA), TAIR, WSA
+  ST = STSAS(TAIR,WSA)      ! Surface tension of sulfuric acid solution/vapor (N/m)
+
+  RHOSA = ROSAS(TAIR,WSA)          ! Density of liquid sulfuric acid solution (kg/m3)
+  RHOsasat = PSASAS_ZELE(TAIR,WSA) ! Saturated sulfuric acid vapor pressure (Pa)
+
+  SH2SO4 = (PAIR*MRSA_loc)/RHOsasat    ! Saturation Ratio
+
+  write(*,*)'checkpoint change_wsa', PSASAS_ZELE(TAIR,WSA)
+
+END SUBROUTINE change_wsa
+
+
+!*****************************************************************************
+SUBROUTINE change_vapor(TAIR,PAIR,MRSA_loc,MRWV_loc)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  real, intent(in) :: TAIR, PAIR, MRSA_loc, MRWV_loc
+  real :: waterps
+
+  H2SO4_m3 = MRSA_loc*PAIR/(KBZ*TAIR) ! Number concentration of H2SO4 (m-3)
+
+  PPWV = PAIR*MRWV_loc                   ! Partial pressure of water vapor (Pa or N/m2)
+  PPSA = PAIR*MRSA_loc                   ! Partial Pressure of sulfuric acid (Pa or N/m2)
+
+  RH = PPWV/waterps(TAIR) * 1.0D2    ! Relative humidity (%)
+
+  CHECKWV = PPWV/PAIR
+  CHECKSA = PPSA/PAIR
+
+END SUBROUTINE change_vapor
+
+
+!*****************************************************************************
+FUNCTION logn(x,rm,sig)
+
+  !*     Computes the log-normal distribution at x with parameters rm and sig
+  !*
+  !*     INPUTS
+  !*          x    location
+  !*          rm   mean radius
+  !*          sig  standard deviation
+  !*
+  !*     OUTPUTS
+  !*          The value of the log-normal distribution at location x
+
+  use free_param
+  use donnees
+  IMPLICIT NONE
+
+  real, intent(in) :: sig, rm, x
+  real ::  cste, logn
+
+  cste = 1.D0 / (sqrt(2.D0*PI)*log(sig))
+  logn = cste / x * exp(-0.5D0*((log(x)-log(rm))/log(sig))**2)
+
+  RETURN
+END FUNCTION logn
+
+
+!*****************************************************************************
+FUNCTION moment(k, ntot, rbar, sigma) 
+
+  !*     Computes the kth order moment of the log-normale with parameters : ntot,rbar and sigma
+  !*
+  !*     INPUTS
+  !*            k     : the order of the moment to compute
+  !*            ntot  : the total number of particles of the distribution (ie: M0)
+  !*            rbar  : the mean raidus of the ditribution
+  !*            sigma : the standard deviation of the distribution.
+
+  IMPLICIT NONE
+
+  real, intent(in) :: ntot, rbar, sigma, k 
+  real :: moment
+
+  moment = ntot * rbar ** k * exp(0.5D0 *(k*log(sigma))**2)
+
+  RETURN
+END FUNCTION moment
+
+
+!*****************************************************************************
+FUNCTION alpha_k(k,sig)
+
+  IMPLICIT NONE
+
+  real :: k, alpha_k
+  real :: sig
+
+  alpha_k = EXP(0.5 * k*k *(LOG(sig))**2)
+
+  return
+end FUNCTION alpha_k
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mode_merging.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mode_merging.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mode_merging.F90	(revision 1661)
@@ -0,0 +1,214 @@
+
+!  SUBROUTINE   MERGING   Mode merging calculations
+!  FUNCTION     U         For the donor mode
+!  FUNCTION     ALPHA
+!  FUNCTION     BETA
+!  SUBROUTINE   GetN1R1
+!  SUBROUTINE   GetN2R2
+
+
+!*****************************************************************************
+SUBROUTINE MERGING(rini,ni,sigmai,sigmaf,dM0i,dM3i,dM0f,dM3f)
+
+  ! Example: mode 1 merge to mode 2
+  ! dMi and dMf are the fraction of moment need to be 
+  ! additioned to M_2 and replace for M_1
+
+  use donnees
+  IMPLICIT NONE
+
+  ! Inputs
+  real, intent(in) :: rini, ni, sigmai, sigmaf
+  ! Outputs
+  real, intent(out) :: dM0i,dM3i,dM0f,dM3f
+  ! Local varialbes
+  real :: Nt1,Rt1,Nt2,Rt2
+  ! Functions
+  real :: moment
+
+  ! A mode is free to move anywhere in size space, it has a preferred position,
+  ! called home base rhb1 for mode 1 and rhb2 for mode 2
+
+  ! Calculation of the new N1,R1,N2 and R2 after mode-merging
+  CALL GetN1R1(ni,rini,Nt1,Rt1,sigmai)
+  CALL GetN2R2(ni,rini,Nt2,Rt2,sigmai,sigmaf)
+
+  ! BE CAREFUL: here the moment are not normalized
+  dM0i = moment(0,Nt1,Rt1,sigmai)
+  dM3i = moment(3,Nt1,Rt1,sigmai)
+
+  dM0f = moment(0,Nt2,Rt2,sigmaf)
+  dM3f = moment(3,Nt2,Rt2,sigmaf)
+
+  RETURN
+END SUBROUTINE MERGING
+
+
+!*****************************************************************************
+FUNCTION U(rini,k,sigmai)
+
+  !*     Computes [ln(Redge)-ln(Ri) - k*ln(sigmai)**2]/ [SQRT(2)*ln(sigmai)]
+  !*     for the donor mode
+  !*
+  !*     INPUTS
+  !*           rini     mean radius of donor mode before mode-merging
+  !*           k        moment order used for computation
+  !*
+  !*     OUTPUTS
+  !*           U        a function of the log-N distrib parameters
+  !*
+  !*     See also: J.B. notes about mode-merging
+
+  use donnees
+  IMPLICIT NONE
+
+  real, intent(in) :: rini, k, sigmai
+  real :: U
+
+  U = (log(redge)-log(rini)-k*log(sigmai)**2)/(sqrt(2.)*log(sigmai))
+
+  RETURN
+END FUNCTION U
+
+
+!*****************************************************************************
+FUNCTION ALPHA(rini,k,sigmai)
+
+  !*     Computes: 1 + erf(u(param,k)) for the donor mode
+  !*
+  !*     INPUTS
+  !*           rini     Mean radius of donor mode before mode-merging
+  !*           k        Moment order used for computation
+  !*
+  !*     OUTPUTS
+  !*           ALPHA    error of the donor mode
+  !*
+  !*     See also: J.B. notes about mode-merging
+
+  IMPLICIT NONE
+
+  ! Imputs
+  real, intent(in) :: rini, k, sigmai
+  ! Function
+  REAL ::  U, ALPHA
+
+  ALPHA = 1.0D0 + erf(U(rini,k,sigmai))
+
+  RETURN
+END FUNCTION ALPHA
+
+
+!*****************************************************************************
+FUNCTION BETA(rini,k,sigmai)
+
+  !*     Computes: 1 - erf(u(param,k)) for the donor mode
+  !*
+  !*     INPUTS
+  !*           rini     Mean radius of donor mode before mode-merging
+  !*           k        Moment order used for computation
+  !*
+  !*     OUTPUTS
+  !*           BETA     Error of the donor mode
+  !*     
+  !*     See also: J.B. notes about mode-merging
+
+  IMPLICIT NONE
+
+  ! Imputs
+  real, intent(in) :: rini, k, sigmai
+  ! Function
+  REAL :: U, BETA
+
+  BETA = 1.D0 - erf(U(rini,k,sigmai))
+
+  RETURN
+END FUNCTION BETA
+
+
+!*****************************************************************************
+SUBROUTINE GetN1R1(ni,rini,Nt1,Rt1,sigmai)
+
+  !*     Computes the final Mean radius and total number particles for donor mode
+  !*
+  !*     INPUTS
+  !*           rini     Mean radius of donor mode before mode-merging
+  !*           ni       Total number of particles at initial state
+  !*
+  !*     OUTPUTS
+  !*     A tuple (N1,R1) with the total number of particles and Mean radius of mode 1
+  !*           N1       Total number of particles of donor mode after mode-merging
+  !*           R1       Mean radius of donor mode after mode-merging
+  !*
+  !*    See also : J.B. notes about mode-merging
+
+  IMPLICIT NONE
+
+  ! Imputs
+  real, intent(in) :: ni,rini,sigmai
+  ! Outputs
+  real, intent(out) :: Nt1,Rt1
+  ! Function
+  REAL :: ALPHA
+  ! Local variables
+  REAL :: cn1, cr1, p, q, a, b
+
+  p = 3.0D0
+  q = 6.0D0
+
+  a = ALPHA(rini,p,sigmai)
+  b = ALPHA(rini,q,sigmai)
+
+  cn1 = ni/2.0D0
+  cr1 = rini
+
+  Nt1 = cn1 * a / (a/b)**(p/(p-q))
+  Rt1 = cr1 * (a / b)**(1.D0/(p-q))
+
+  RETURN
+END SUBROUTINE GetN1R1
+
+
+!*****************************************************************************
+SUBROUTINE GetN2R2(ni,rini,N2,R2,sigmai,sigmaf)
+
+  !*     Computes the final Mean radius and total number of particles for 
+  !*     the receptor mode
+  !*
+  !*     FUNCTION
+  !*           BETA
+  !*     
+  !*     INPUTS
+  !*           rini     Mean radius of donor mode before mode-merging
+  !*           ni       Total number of particles at initial state
+  !*
+  !*     OUTPUTS
+  !*     A tuple (N2,R2) with the total number of particles and Mean radius of mode 2
+  !*           N2       Total number of particles of receptor mode after mode-merging
+  !*           R2       Mean radius of receptor mode after mode-merging
+  !*
+  !*     See also : J.B. notes about mode-merging
+
+  IMPLICIT NONE
+
+  ! Imputs
+  REAL :: sigmai, sigmaf
+  real :: ni, rini, N2, R2
+  ! Local variables
+  real :: a, b, cn2, cr2, p, q
+  ! Function
+  REAL :: BETA
+
+  p = 3.0D0
+  q = 6.0D0
+
+  a = BETA(rini,p,sigmai)
+  b = BETA(rini,q,sigmai)
+
+  cn2 = ni/2.D0 *exp(-0.5D0*p*q * (log(sigmai)**2 - log(sigmaf)**2))
+  cr2 = rini * exp(0.5D0* (p+q) * (log(sigmai)**2 - log(sigmaf)**2))
+
+  N2 = cn2 * a/(a/b)**(p/(p-q))
+  R2 = cr2 * (a/b)**(1.D0/(p-q))
+
+  RETURN
+END SUBROUTINE GetN2R2
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/newbinapara.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/newbinapara.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/newbinapara.F90	(revision 1661)
@@ -0,0 +1,289 @@
+MODULE real16
+INTEGER,PARAMETER :: REAL_16 = SELECTED_REAL_KIND (p=14,r=100)
+END MODULE real16
+
+program binarytest
+
+use real16
+
+implicit none
+
+real(real_16) :: t,rh,rhoa,j,x,ntot,r,rhotres
+logical :: kinetic
+
+t = 240.0 !kelvin
+rh = 0.5 !saturation ratio, unitless
+rhoa = 1e14 !m-3
+
+call newbinapara(t,rh,rhoa,j,x,ntot,r,kinetic,rhotres)
+print *,'t ',t
+print *,'rh ',rh
+print *,'rhoa ',rhoa
+print *,'j ',j
+print *,'x ',x
+print *,'ntot ',ntot
+print *,'r ',r
+print *,'kinetic? ',kinetic
+print *,'[acid] for J=1 ',rhotres
+
+end program binarytest
+
+SUBROUTINE newbinapara(t,rh,rhoa,jnuc,x,ntot,rc,kinetic,rhotres)
+
+
+  !    Fortran 90 subroutine binapara
+  !
+  !    Calculates parametrized values of particle formation rate,
+  !    mole fraction of sulphuric acid,
+  !    total number of particles, and the radius of the critical cluster
+  !    in H2O-H2SO4 system if temperature, saturatio ratio of water and 
+  !    sulfuric acid concentration  are given. 
+  !
+  !    Calculates also the kinetic limit and the particle formation rate
+  !    above this limit (in which case we set ntot=1 and x=1)
+  !
+  !
+  !    Copyright (C)2016 Määttänen et al. 2016
+  !
+  !    
+  !    anni.maattanen@latmos.ipsl.fr
+  !    joonas.merikanto@fmi.fi
+  !    hanna.vehkamaki@helsinki.fi
+
+  use real16
+
+
+  IMPLICIT NONE 
+
+
+  real(REAL_16),intent(inout) :: t     !temperature in K (165-400 K)
+  real(REAL_16),intent(inout) :: rh    !saturatio ratio of water (0.00001-1)
+  real(REAL_16),intent(inout) :: rhoa    !sulfuric acid concentration in 1/m3 (10^10 - 10^19) 
+  real(REAL_16),intent(out) :: jnuc    !nucleation rate in 1/cm3s (J>10^-7 1/cm3s)
+  real(REAL_16),intent(out) :: ntot !total number of molecules in the critical cluster
+  real(REAL_16),intent(out) :: x    ! mole fraction of H2SO4 in the critical cluster       
+  real(REAL_16),intent(out) :: rc    !radius of the critical cluster in nm     
+  real(REAL_16),intent(out) :: rhotres    ! treshold concentration of h2so4 (1/cm^3) 
+  !which produces nucleation rate   1/(cm^3 s) as a function of rh and t 
+  real(REAL_16),intent(out) :: kinrhotres    ! treshold concentration of h2so4 (1/cm^3) 
+  !of the kinetic limit as a function of rh and t
+  real(REAL_16) :: nac !local variable for number of acid molecules
+  logical,intent(out) :: kinetic
+
+  kinetic=.false.
+  jnuc=0.0
+  x=0.0
+  ntot=0.0
+  rc=0.0
+  rhotres=0.0
+  kinrhotres=0.0
+ 
+
+  
+  if (rh .ge. 1.e-2 .and. rh .lt. 1.) then
+     
+     kinrhotres=exp(7.8920778706888086e+1 + 7.3665492897447082*rh - 1.2420166571163805e+4/t &
+          & + (-6.1831234251470971e+2*rh)/t - 2.4501159970109945e-2*t &
+          & -1.3463066443605762e-2*rh*t + 8.3736373989909194e-06*t**2   &
+          & -1.4673887785408892*Log(rh) + (-3.2141890006517094e+1*Log(rh))/t & 
+          & + 2.7137429081917556e-3*t*Log(rh))
+     
+     if(kinrhotres*1.E6.lt.rhoa) kinetic=.true.
+  endif
+  
+  if (rh .gt. 1.e-4  .and. rh .lt. 1.e-2) then
+     
+     kinrhotres=exp(7.9074383049843647e+1 - 2.8746005462158347e+1*rh - 1.2070272068458380e+4/t &
+          & + (-5.9205040320056632e+3*rh)/t - 2.4800372593452726e-2*t &
+          & -4.3983007681295948e-2*rh*t + 2.5943854791342071e-5*t**2   &
+          & -2.3141363245211317*Log(rh) + (9.9186787997857735e+1*Log(rh))/t & 
+          & + 5.6819382556144681e-3*t*Log(rh))
+
+     if(kinrhotres*1.E6.lt.rhoa) kinetic=.true.
+
+  endif
+
+  if (rh .gt. 5.e-6  .and. rh .lt. 1.e-4) then
+
+     kinrhotres=exp(8.5599712000361677e+1 + 2.7335119660796581e+3*rh - 1.1842350246291651e+4/t &
+          & + (-1.2439843468881438e+6*rh)/t - 5.4536964974944230e-2*t &
+          & + 5.0886987425326087*rh*t + 7.1964722655507067e-5*t**2   &
+          & -2.4472627526306372*Log(rh) + (1.7561478001423779e+2*Log(rh))/t & 
+          & + 6.2640132818141811e-3*t*Log(rh))
+
+     if(kinrhotres*1.E6.lt.rhoa) kinetic=.true.
+
+  endif
+
+  if(kinetic) then    
+     jnuc=(2.*0.3E-9)**2.*sqrt(8.*3.141593*1.38E-23*(1./(1.661e-27*98.07)+1./(1.661e-27*98.07)))/2.*sqrt(t)*rhoa**2./1.E6
+     ntot=1.
+     x=1.
+     rc=0.3E-9
+  else
+     
+     if(t < 165.) then
+        print *,'Warning: temperature < 165.0 K, using 165.0 K'
+        t=165.0
+     end if
+     
+     if(t > 400.) then
+        print *,'Warning: temperature > 400. K, using 400. K'
+        t=400.
+     end if
+     
+     if(rh < 1.E-5) then
+        print *,'Warning: saturation ratio of water < 1.e-5, using 1.e-5'
+        rh=1.E-5
+     end if
+     
+     if(rh > 1.0) then
+        print *,'Warning: saturation ratio of water > 1 using 1'
+        rh=1.0
+     end if
+
+     if(rhoa < 1.e10) then
+        print *,'Warning: sulfuric acid concentration < 1e4 1/cm3, using 1e4 1/cm3'
+        rhoa=1.e10
+     end if
+
+     if(rhoa > 1.e19) then
+        print *,'Warning: sulfuric acid concentration > 1e13 1/cm3, using 1e13 1/cm3'
+        rhoa=1.e19
+     end if
+
+
+     x=  7.9036365428891719e-1 - 2.8414059650092153e-3*t + 1.4976802556584141e-2*LOG(rh) &
+          & - 2.4511581740839115e-4*t*LOG(rh) + 3.4319869471066424e-3 *LOG(rh)**2     &  
+          & - 2.8799393617748428e-5*t*LOG(rh)**2 + 3.0174314126331765e-4*LOG(rh)**3 & 
+          & - 2.2673492408841294e-6*t*LOG(rh)**3 - 4.3948464567032377e-3*LOG(rhoa/1.e6)&
+          & + 5.3305314722492146e-5*t*LOG(rhoa/1.e6)
+
+
+     jnuc= 2.1361182605986115e-1 + 3.3827029855551838 *t -3.2423555796175563e-2*t**2 +  &
+          &  7.0120069477221989e-5*t**3 +8.0286874752695141/x +  &
+          &  -2.6939840579762231e-1*LOG(rh) +1.6079879299099518*t*LOG(rh) +  &
+          &  -1.9667486968141933e-2*t**2*LOG(rh) +  &
+          &  5.5244755979770844e-5*t**3*LOG(rh) + (7.8884704837892468*LOG(rh))/x +  &
+          &  4.6374659198909596*LOG(rh)**2 - 8.2002809894792153e-2*t*LOG(rh)**2 +  &
+          &  8.5077424451172196e-4*t**2*LOG(rh)**2 +  &
+          &  -2.6518510168987462e-6*t**3*LOG(rh)**2 +  &
+          &  (-1.4625482500575278*LOG(rh)**2)/x - 5.2413002989192037e-1*LOG(rh)**3 +  &
+          &  5.2755117653715865e-3*t*LOG(rh)**3 +  &
+          &  -2.9491061332113830e-6*t**2*LOG(rh)**3 +  &
+          &  -2.4815454194486752e-8*t**3*LOG(rh)**3 +  &
+          &  (-5.2663760117394626e-2*LOG(rh)**3)/x +  &
+          &  1.6496664658266762*LOG(rhoa/1.e6) +  &
+          &  -8.0809397859218401e-1*t*LOG(rhoa/1.e6) +  &
+          &  8.9302927091946642e-3*t**2*LOG(rhoa/1.e6) +  &
+          &  -1.9583649496497497e-5*t**3*LOG(rhoa/1.e6) +  &
+          &  (-8.9505572676891685*LOG(rhoa/1.e6))/x +  &
+          &  -3.0025283601622881e+1*LOG(rh)*LOG(rhoa/1.e6) +  &
+          &  3.0783365644763633e-1*t*LOG(rh)*LOG(rhoa/1.e6) +  &
+          &  -7.4521756337984706e-4*t**2*LOG(rh)*LOG(rhoa/1.e6) +  &
+          &  -5.7651433870681853e-7*t**3*LOG(rh)*LOG(rhoa/1.e6) +  &
+          &  (1.2872868529673207*LOG(rh)*LOG(rhoa/1.e6))/x +  &
+          &  -6.1739867501526535e-1*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &  7.2347385705333975e-3*t*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &  -3.0640494530822439e-5*t**2*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &  6.5944609194346214e-8*t**3*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &  (-2.8681650332461055e-2*LOG(rh)**2*LOG(rhoa/1.e6))/x +  &
+          &  6.5213802375160306*LOG(rhoa/1.e6)**2 +  &
+          &  -4.7907162004793016e-2*t*LOG(rhoa/1.e6)**2 +  &
+          &  -1.0727890114215117e-4*t**2*LOG(rhoa/1.e6)**2 +  &
+          &  5.6401818280534507e-7*t**3*LOG(rhoa/1.e6)**2 +  &
+          &  (5.4113070888923009e-1*LOG(rhoa/1.e6)**2)/x +  &
+          &  5.2062808476476330e-1*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &  -6.0696882500824584e-3*t*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &  2.3851383302608477e-5*t**2*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &  -1.5243837103067096e-8*t**3*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &  (-5.6543192378015687e-2*LOG(rh)*LOG(rhoa/1.e6)**2)/x +  &
+          &  -1.1630806410696815e-1*LOG(rhoa/1.e6)**3 +  &
+          &  1.3806404273119610e-3*t*LOG(rhoa/1.e6)**3 +  &
+          &  -2.0199865087650833e-6*t**2*LOG(rhoa/1.e6)**3 +  &
+          &  -3.0200284885763192e-9*t**3*LOG(rhoa/1.e6)**3 +  &
+          &  (-6.9425267104126316e-3*LOG(rhoa/1.e6)**3)/x
+
+     ntot =-3.5863435141979573e-3 - 1.0098670235841110e-1 *t + 8.9741268319259721e-4 *t**2 - 1.4855098605195757e-6*t**3  &
+          &   - 1.2080330016937095e-1/x + 1.1902674923928015e-3*LOG(rh) - 1.9211358507172177e-2*t*LOG(rh) +  &
+          &   2.4648094311204255e-4*t**2*LOG(rh) - 7.5641448594711666e-7*t**3*LOG(rh) +  &
+          &   (-2.0668639384228818e-02*LOG(rh))/x - 3.7593072011595188e-2*LOG(rh)**2 + 9.0993182774415718e-4 *t*LOG(rh)**2 +  &
+          &   -9.5698412164297149e-6*t**2*LOG(rh)**2 + 3.7163166416110421e-8*t**3*LOG(rh)**2 +  &
+          &   (1.1026579525210847e-2*LOG(rh)**2)/x + 1.1530844115561925e-2 *LOG(rh)**3 +  &
+          &   - 1.8083253906466668e-4 *t*LOG(rh)**3 + 8.0213604053330654e-7*t**2*LOG(rh)**3 +  &
+          &   -8.5797885383051337e-10*t**3*LOG(rh)**3 + (1.0243693899717402e-3*LOG(rh)**3)/x +  &
+          &   -1.7248695296299649e-2*LOG(rhoa/1.e6) + 1.1294004162437157e-2*t*LOG(rhoa/1.e6) +  &
+          &   -1.2283640163189278e-4*t**2*LOG(rhoa/1.e6) + 2.7391732258259009e-7*t**3*LOG(rhoa/1.e6) +  &
+          &   (6.8505583974029602e-2*LOG(rhoa/1.e6))/x +2.9750968179523635e-1*LOG(rh)*LOG(rhoa/1.e6) +  &
+          &   -3.6681154503992296e-3 *t*LOG(rh)*LOG(rhoa/1.e6) + 1.0636473034653114e-5*t**2*LOG(rh)*LOG(rhoa/1.e6) +  &
+          &   5.8687098466515866e-9*t**3*LOG(rh)*LOG(rhoa/1.e6) + (-5.2028866094191509e-3*LOG(rh)*LOG(rhoa/1.e6))/x +  &
+          &   7.6971988880587231e-4*LOG(rh)**2*LOG(rhoa/1.e6) - 2.4605575820433763e-5*t*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &   2.3818484400893008e-7*t**2*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &   -8.8474102392445200e-10*t**3*LOG(rh)**2*LOG(rhoa/1.e6) +  &
+          &   (-1.6640566678168968e-4*LOG(rh)**2*LOG(rhoa/1.e6))/x - 7.7390093776705471e-2*LOG(rhoa/1.e6)**2 +  &
+          &   5.8220163188828482e-4*t*LOG(rhoa/1.e6)**2 + 1.2291679321523287e-6*t**2*LOG(rhoa/1.e6)**2 +  &
+          &   -7.4690997508075749e-9*t**3*LOG(rhoa/1.e6)**2 + (-5.6357941220497648e-3*LOG(rhoa/1.e6)**2)/x +  &
+          &   -4.7170109625089768e-3*LOG(rh)*LOG(rhoa/1.e6)**2 + 6.9828868534370193e-5*t*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &   -3.1738912157036403e-7*t**2*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &   2.3975538706787416e-10*t**3*LOG(rh)*LOG(rhoa/1.e6)**2 +  &
+          &   (4.2304213386288567e-4*LOG(rh)*LOG(rhoa/1.e6)**2)/x + 1.3696520973423231e-3*LOG(rhoa/1.e6)**3 +  &
+          &   -1.6863387574788199e-5*t*LOG(rhoa/1.e6)**3 + 2.7959499278844516e-8*t**2*LOG(rhoa/1.e6)**3 +  &
+          &   3.9423927013227455e-11*t**3*LOG(rhoa/1.e6)**3 + (8.6136359966337272e-5*LOG(rhoa/1.e6)**3)/x
+     
+     ntot=EXP(ntot)
+
+
+     rc=EXP(-22.378268374023630+0.44462953606125100*x+0.33499495707849131*LOG(ntot))
+     
+     jnuc=EXP(jnuc)
+        
+     
+     if(jnuc < 1.e-7) then
+        print *,'Warning: nucleation rate < 1e-7/cm3s, using 0.0/cm3s,'
+        jnuc=0.0
+     endif
+
+     nac =x*ntot
+     if (nac .lt. 1.) then
+        print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting x=1'
+        x=1.
+     endif
+
+
+  endif
+
+
+
+  if (t .ge. 310.) then
+
+     rhotres=exp(-3.1820396091231999e+2 + 7.2451289153199676*rh + 2.6729355170089486e+4/t &
+          & + (-7.1492506076423069e+2*rh)/t + 1.2617291148391978*t &
+          & -1.6438112080468487e-2*rh*t -1.4185518234553220e-3*t**2   &
+          & -9.2864597847386694*Log(rh) + (1.2607421852455602e+3*Log(rh))/t & 
+          & + 1.3324434472218746e-2*t*Log(rh))
+
+  endif
+
+  if (t .gt. 190. .and. t .lt. 310.) then
+
+     rhotres=exp(-3.1820396091231999e+2 + 7.2451289153199676*rh + 2.6729355170089486e+4/t &
+          & + (-7.1492506076423069e+2*rh)/t + 1.2617291148391978*t &
+          & - 1.6438112080468487e-2*rh*t -1.4185518234553220e-3*t**2   &
+          & -9.2864597847386694*Log(rh) + (1.2607421852455602e+3*Log(rh))/t & 
+          & + 1.3324434472218746e-2*t*Log(rh))
+
+  endif
+
+
+  if (t .lt. 185. .and. t .gt. 155.) then
+
+     rhotres=1.1788859232398459e+5 - 1.0244255702550814e+4*rh + 4.6815029684321962e+3*rh**2 -1.6755952338499657e+2*t
+
+  endif
+
+
+
+  RETURN
+
+END SUBROUTINE newbinapara
+
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/nucleations.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/nucleations.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/nucleations.F90	(revision 1661)
@@ -0,0 +1,344 @@
+
+!  SUBROUTINE    HONUMO        HOmogeneous NUcleation with MOments
+!  SUBROUTINE    HETNUMO       HETerogeneous NUcleation with MOments
+!  SUBROUTINE    newnuklefit   Calculates jnuc and rc
+!  SUBROUTINE    heteronuk     Calculates the sum of activated aerosols
+
+
+!****************************************************************************
+! HOmogeneous NUcleation with MOments
+!
+! This subroutine uses the newnuclefit function. 
+! Hanna Vehkamäki et al., 2002 : An improved parameterization for 
+! sulfuric acid/water nucleation rates for tropospheric 
+! and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
+!
+! we determine here the tendency of M0
+! the created paticles will be in mode 1 (the smallest particles).
+! 
+! The inputs mk0 and mk3 are not use in this function.
+!
+! An implicit method are used (easy)
+!
+! by S.Guilbon (LATMOS), 2016.
+!
+SUBROUTINE HONUMO(TAIR,dt,mk0,mk3,dM0_homo,dM3_homo)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  ! INputs
+  real, intent(in), dimension(2) :: mk0   ! first moment
+  real, intent(in), dimension(3) :: mk3   ! third moment
+  real, intent(in)  :: TAIR, dt           ! temperature, timestep
+  ! Outputs 
+  real, intent(out) :: dM0_homo, dM3_homo ! Variations of moments
+
+  !Local variables
+  real :: jnuc, rc        ! Nucleation rate and critical radius
+  real :: m_H2SO4, m_H2O  ! Total condensed masses
+  real :: CWV, ntotal
+
+  ! Calculate jnuc and rc
+  CALL newnuklefit(TAIR,h2so4_m3,jnuc,rc,ntotal)     
+
+  ! initialization
+  dM0_homo = 0.D0
+  dM3_homo = 0.D0
+
+  ! Conditions to have nucleation process
+  IF (jnuc .ge. 1.D-1 .and. jnuc .le. 1.D16 .and. ntotal .gt. 4.0) then
+     CWV = MAIR/MWV
+     rc = 1.D-9  !m  Because of the calculation of WSA
+
+     ! Modal tendancies: Total nb density and vol. of created particles
+     ! Same thing with implicit scheme (cf thesis)
+     dM0_homo = dt * jnuc          !#.m(air)-3 
+     dM3_homo = dt * jnuc * rc**3  !m3.m(air)-3
+  ENDIF
+
+  RETURN 
+
+END SUBROUTINE HONUMO
+
+
+!****************************************************************************
+! HETerogeneous NUcleation with MOment
+!
+! Here, we use a simple representation of nucleation rate 
+! and heterogeneous nucleation, like in VenLA (see Maattanen Anni).
+! 
+! The number of activated ccn will become the number of created droplets
+! ra is the mean radius of the aerosol distribution.
+!
+! for mk0 calculation, method 1 and method 2 give same results :)
+!  mk0 = Jhetsum ! Number of activated CCN, in # - (method 1)
+! Here, we use implicit scheme (cf thesis)
+!
+SUBROUTINE HETNUMO(TAIR,dt,ra,mk0aer,mk3aer,mk0drop, mk3drop, &
+     & dM0_aer,dM3_aer,dM0_het,dM3_het)
+
+  use free_param
+  use donnees
+  
+  IMPLICIT NONE
+  
+  ! Inputs and Outputs 
+  real, intent(in)  :: dt,TAIR,ra           ! time step, temperature, mean radius
+  real, intent(in)  :: mk0aer, mk3aer       ! original moments M(t)
+  real, intent(in), dimension(2) :: mk0drop ! original moment M(t)
+  real, intent(in), dimension(3) :: mk3drop ! original moment M(t)
+  real, intent(out) :: dM0_het, dM3_het     ! tendencies of liquid droplets
+  real, intent(out) :: dM0_aer, dM3_aer     ! tendencies of aerosols
+  ! Local variables
+  real :: Jhetsum, alpha_loc1, alpha_loc2
+  real :: mk0, mk3, alpha_k
+
+  call build_radius_grid(nbin,rmin,rmax,vratio)
+  call heteronuk(TAIR,ra,mk0aer,Jhetsum)
+
+  write(*,*)'mk0aer',mk0aer
+
+  alpha_loc1 = alpha_k(2,sig_aer) 
+  mk0 = 1.D0 + (4.D0*PI*Jhetsum*r_aer*r_aer*alpha_loc1)*dt
+  mk0 = (1.D0/mk0)   
+  mk0 = mk0 * mk0aer ! - (method 2)
+  mk0 = mk0 - mk0aer ! Delta betwen 2 time steps = tendancy
+
+  alpha_loc2 = alpha_k(5,sig_aer)/alpha_k(3,sig_aer)
+  mk3 = 1.D0 + (4.D0*PI*Jhetsum*r_aer*r_aer*alpha_loc2)*dt
+  mk3 = 1.D0/mk3
+  mk3 = mk3 * mk3aer
+  mk3 = mk3 - mk3aer ! Delta betwen 2 time steps = tendancy
+  write(*,*)'HET - mk3 - methode 2', mk3
+
+  ! Modal tendancies
+  ! the lost quantity in aerosol will go to droplets.
+  dM0_aer = mk0
+  dM3_aer = mk3
+  dM0_het = mk0  * (-1)      
+  dM3_het = mk3  * (-1)
+
+END SUBROUTINE HETNUMO
+
+
+!*****************************************************************************
+SUBROUTINE newnuklefit(t,rhoa,jnuc,rc,ntotal)
+
+  !    Fortran 90 subroutine binapara
+  !
+  !    Calculates parametrized values of particle formation rate,
+  !    mole fraction of sulphuric acid,
+  !    total number of particles, and the radius of the critical cluster
+  !    in H2O-H2SO4 system if temperature, saturatio ratio of water and 
+  !    sulfuric acid concentration  are given. 
+  !
+  !    Calculates also the kinetic limit and the particle formation rate
+  !    above this limit (in which case we set ntotal=1 and x=1)
+  !
+  !    NB: produces nucleation rate   1/(cm^3 s) as a function of rh and t
+  !    of the kinetic limit as a function of rh and t
+  !
+  !    Copyright (C)2016 Määttänen et al. 2016
+  !
+  !    anni.maattanen@latmos.ipsl.fr
+  !    joonas.merikanto@fmi.fi
+  !    hanna.vehkamaki@helsinki.fi
+  !
+  !    modified by S.Guilbon for the Venus GCM (2016)
+  !
+  ! SG: change the unity of jnuc here
+  ! SG: change inputs and outputs
+
+  use free_param
+  use donnees
+
+  ! Inputs
+  real,intent(inout) :: t        ! temperature in K (165-400 K)
+  real,intent(inout) :: rhoa     ! sulfuric acid concentration in 1/m3 (10^10 - 10^19) 
+
+  ! Outputs
+  real,intent(out) :: jnuc       ! nucleation rate in 1/m3s (J>10^-1 1/m3s)
+  real,intent(out) :: rc         ! radius of the critical cluster in m 
+  real,intent(out) :: ntotal       ! total number of molecules in the critical cluster
+
+  ! Local variables
+  real :: x          ! mole fraction of H2SO4 in the critical cluster     
+  real :: nac        ! local variable for number of acid molecules
+
+  ! Initialization
+  jnuc = 0.D0
+  ntotal = 0.D0
+  rc = 0.D0
+  x = 0.D0   
+
+  if(t < 165.D0) then
+     print *,'Warning: temperature < 165.0 K, using 165.0 K'
+     t=165.D0
+  end if
+
+  if(t > 400.D0) then
+     print *,'Warning: temperature > 400. K, using 400. K'
+     t=400.D0
+  end if
+
+  if(rh < 1.D-5) then
+     print *,'Warning: saturation ratio of water < 1.e-5, using 1.e-5'
+     rh=1.D-5
+  end if
+
+  if(rh > 1.D0) then
+     print *,'Warning: saturation ratio of water > 1 using 1'
+     rh=1.D0
+  end if
+
+  if(rhoa < 1.D10) then
+     print *,'Warning: sulfuric acid concentration < 1e4 1/cm3, using 1e4 1/cm3'
+     rhoa=1.D10
+  end if
+
+  if(rhoa > 1.D19) then
+     print *,'Warning: sulfuric acid concentration > 1e13 1/cm3, using 1e13 1/cm3'
+     rhoa=1.D19
+  end if
+
+  x=  7.9036365428891719D-1 - 2.8414059650092153D-3*t + 1.4976802556584141D-2*LOG(rh) &
+       & - 2.4511581740839115D-4*t*LOG(rh) + 3.4319869471066424D-3 *LOG(rh)**2     &  
+       & - 2.8799393617748428D-5*t*LOG(rh)**2 + 3.0174314126331765D-4*LOG(rh)**3 & 
+       & - 2.2673492408841294D-6*t*LOG(rh)**3 - 4.3948464567032377D-3*LOG(rhoa/1.D6)&
+       & + 5.3305314722492146D-5*t*LOG(rhoa/1.D6)
+
+
+  jnuc= 2.1361182605986115D-1 + 3.3827029855551838D0 *t -3.2423555796175563D-2*t**2 +  &
+       &  7.0120069477221989D-5*t**3 + 8.0286874752695141D0/x +  &
+       &  -2.6939840579762231D-1*LOG(rh) + 1.6079879299099518D0*t*LOG(rh) +  &
+       &  -1.9667486968141933D-2*t**2*LOG(rh) +  &
+       &  5.5244755979770844D-5*t**3*LOG(rh) + (7.8884704837892468D0*LOG(rh))/x +  &
+       &  4.6374659198909596D0*LOG(rh)**2 - 8.2002809894792153D-2*t*LOG(rh)**2 +  &
+       &  8.5077424451172196D-4*t**2*LOG(rh)**2 +  &
+       &  -2.6518510168987462D-6*t**3*LOG(rh)**2 +  &
+       &  (-1.4625482500575278D0*LOG(rh)**2)/x - 5.2413002989192037D-1*LOG(rh)**3 +  &
+       &  5.2755117653715865D-3*t*LOG(rh)**3 +  &
+       &  -2.9491061332113830D-6*t**2*LOG(rh)**3 +  &
+       &  -2.4815454194486752D-8*t**3*LOG(rh)**3 +  &
+       &  (-5.2663760117394626D-2*LOG(rh)**3)/x +  &
+       &  1.6496664658266762D0*LOG(rhoa/1.D6) +  &
+       &  -8.0809397859218401D-1*t*LOG(rhoa/1.D6) +  &
+       &  8.9302927091946642D-3*t**2*LOG(rhoa/1.D6) +  &
+       &  -1.9583649496497497D-5*t**3*LOG(rhoa/1.D6) +  &
+       &  (-8.9505572676891685D0*LOG(rhoa/1.D6))/x +  &
+       &  -3.0025283601622881D+1*LOG(rh)*LOG(rhoa/1.D6) +  &
+       &  3.0783365644763633D-1*t*LOG(rh)*LOG(rhoa/1.D6) +  &
+       &  -7.4521756337984706D-4*t**2*LOG(rh)*LOG(rhoa/1.D6) +  &
+       &  -5.7651433870681853D-7*t**3*LOG(rh)*LOG(rhoa/1.D6) +  &
+       &  (1.2872868529673207D0*LOG(rh)*LOG(rhoa/1.D6))/x +  &
+       &  -6.1739867501526535D-1*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &  7.2347385705333975D-3*t*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &  -3.0640494530822439D-5*t**2*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &  6.5944609194346214D-8*t**3*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &  (-2.8681650332461055D-2*LOG(rh)**2*LOG(rhoa/1.D6))/x +  &
+       &  6.5213802375160306D0*LOG(rhoa/1.D6)**2 +  &
+       &  -4.7907162004793016D-2*t*LOG(rhoa/1.D6)**2 +  &
+       &  -1.0727890114215117D-4*t**2*LOG(rhoa/1.D6)**2 +  &
+       &  5.6401818280534507D-7*t**3*LOG(rhoa/1.D6)**2 +  &
+       &  (5.4113070888923009D-1*LOG(rhoa/1.D6)**2)/x +  &
+       &  5.2062808476476330D-1*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &  -6.0696882500824584D-3*t*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &  2.3851383302608477D-5*t**2*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &  -1.5243837103067096D-8*t**3*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &  (-5.6543192378015687D-2*LOG(rh)*LOG(rhoa/1.D6)**2)/x +  &
+       &  -1.1630806410696815D-1*LOG(rhoa/1.D6)**3 +  &
+       &  1.3806404273119610D-3*t*LOG(rhoa/1.D6)**3 +  &
+       &  -2.0199865087650833D-6*t**2*LOG(rhoa/1.D6)**3 +  &
+       &  -3.0200284885763192D-9*t**3*LOG(rhoa/1.D6)**3 +  &
+       &  (-6.9425267104126316D-3*LOG(rhoa/1.D6)**3)/x
+
+  ntotal =-3.5863435141979573D-3 - 1.0098670235841110D-1 *t + 8.9741268319259721D-4 *t**2 - 1.4855098605195757D-6*t**3  &
+       &   - 1.2080330016937095D-1 /x + 1.1902674923928015D-3*LOG(rh) - 1.9211358507172177D-2*t*LOG(rh) +  &
+       &   2.4648094311204255D-4*t**2*LOG(rh) - 7.5641448594711666D-7*t**3*LOG(rh) +  &
+       &   (-2.0668639384228818D-02*LOG(rh))/x - 3.7593072011595188D-2*LOG(rh)**2 + 9.0993182774415718D-4 *t*LOG(rh)**2 +  &
+       &   -9.5698412164297149D-6*t**2*LOG(rh)**2 + 3.7163166416110421D-8*t**3*LOG(rh)**2 +  &
+       &   (1.1026579525210847D-2*LOG(rh)**2)/x + 1.1530844115561925D-2 *LOG(rh)**3 +  &
+       &   - 1.8083253906466668D-4 *t*LOG(rh)**3 + 8.0213604053330654D-7*t**2*LOG(rh)**3 +  &
+       &   -8.5797885383051337D-10*t**3*LOG(rh)**3 + (1.0243693899717402D-3*LOG(rh)**3)/x +  &
+       &   -1.7248695296299649D-2*LOG(rhoa/1.D6) + 1.1294004162437157D-2*t*LOG(rhoa/1.D6) +  &
+       &   -1.2283640163189278D-4*t**2*LOG(rhoa/1.D6) + 2.7391732258259009D-7*t**3*LOG(rhoa/1.D6) +  &
+       &   (6.8505583974029602D-2*LOG(rhoa/1.D6))/x +2.9750968179523635D-1*LOG(rh)*LOG(rhoa/1.D6) +  &
+       &   -3.6681154503992296D-3 *t*LOG(rh)*LOG(rhoa/1.D6) + 1.0636473034653114D-5*t**2*LOG(rh)*LOG(rhoa/1.D6) +  &
+       &   5.8687098466515866D-9*t**3*LOG(rh)*LOG(rhoa/1.D6) + (-5.2028866094191509D-3*LOG(rh)*LOG(rhoa/1.D6))/x +  &
+       &   7.6971988880587231D-4*LOG(rh)**2*LOG(rhoa/1.D6) - 2.4605575820433763D-5*t*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &   2.3818484400893008D-7*t**2*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &   -8.8474102392445200D-10*t**3*LOG(rh)**2*LOG(rhoa/1.D6) +  &
+       &   (-1.6640566678168968D-4*LOG(rh)**2*LOG(rhoa/1.D6))/x - 7.7390093776705471D-2*LOG(rhoa/1.D6)**2 +  &
+       &   5.8220163188828482D-4*t*LOG(rhoa/1.D6)**2 + 1.2291679321523287D-6*t**2*LOG(rhoa/1.D6)**2 +  &
+       &   -7.4690997508075749D-9*t**3*LOG(rhoa/1.D6)**2 + (-5.6357941220497648D-3*LOG(rhoa/1.D6)**2)/x +  &
+       &   -4.7170109625089768D-3*LOG(rh)*LOG(rhoa/1.D6)**2 + 6.9828868534370193D-5*t*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &   -3.1738912157036403D-7*t**2*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &   2.3975538706787416D-10*t**3*LOG(rh)*LOG(rhoa/1.D6)**2 +  &
+       &   (4.2304213386288567D-4*LOG(rh)*LOG(rhoa/1.D6)**2)/x + 1.3696520973423231D-3*LOG(rhoa/1.D6)**3 +  &
+       &   -1.6863387574788199D-5*t*LOG(rhoa/1.D6)**3 + 2.7959499278844516D-8*t**2*LOG(rhoa/1.D6)**3 +  &
+       &   3.9423927013227455D-11*t**3*LOG(rhoa/1.D6)**3 + (8.6136359966337272D-5*LOG(rhoa/1.D6)**3)/x
+
+  ntotal=EXP(ntotal)
+
+  rc=EXP(-22.378268374023630D0 + 0.44462953606125100D0*x + 0.33499495707849131D0*LOG(ntotal))
+
+  jnuc=EXP(jnuc)
+
+  if(jnuc < 1.D-7) then
+     print *,'Warning: nucleation rate < 1e-7/cm3s, using 0.0/cm3s,'
+     jnuc = 0.0D0
+  endif
+
+  jnuc = jnuc*1.D6 !1/(m^3s)
+
+  nac =x*ntotal
+
+  if (nac .lt. 1.D0) then
+     print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting x=1'
+     x=1.D0
+  endif
+
+  RETURN
+
+END SUBROUTINE newnuklefit
+
+
+!*****************************************************************************
+SUBROUTINE heteronuk(TAIR,ra,mk0i,ACTOT)
+
+  use donnees
+  use free_param
+  IMPLICIT NONE 
+
+  ! inputs/outputs
+  REAL, intent(in) :: TAIR, mk0i, ra
+  REAL, intent(out) :: ACTOT
+
+  ! Local variables
+  INTEGER :: i
+  INTEGER :: AER
+  REAL :: NDnuk(nbin,2)
+  REAL :: PSASAS
+
+  ! Initialization
+  AER = 2
+  ntot_aer = mk0i
+  ACTOT=0.D0 
+
+  call logdist(sig_aer,ntot_aer,ra,rad_cld,NDnuk(:,AER)) ! NDnuk in #
+
+  do i=1,nbin
+     ! Saturation ratio with curvature effect
+     PSASAS = RHOsasat * EXP((2.D0*MSA*ST)/(RGAS*TAIR*RHOSA*rad_cld(i))) 
+     SH2SO4 = PPSA / PSASAS
+   
+     if (SH2SO4 .ge. 1.D0 .and. NDnuk(i,AER) .gt. 0.) then
+        ! ACTOT = ACTOT + NDnuk(i,AER)/(vratio * rad_cld(i))
+        ACTOT = ACTOT + NDnuk(i,AER) ! Total AER number, #
+        NDnuk(i,AER) = 0.D0          ! Now, it's empty !
+     endif
+  enddo
+END SUBROUTINE heteronuk
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/psatsa.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/psatsa.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/psatsa.F90	(revision 1661)
@@ -0,0 +1,293 @@
+!     Saturated sulfuric acid vapor pressure 
+!     over plane sulfuric acid solution.
+!
+!     Source: Zeleznik
+!
+!     Input:  TAIR: Temperature  (K)
+!             WSA:  Weight fraction of H2SO4  [0;1]
+!     Output: H2SO4 vapor pressure 
+!             over sulfuric acid solution    (Pa) )
+!
+!     External functions needed for calculation of activity coefficients
+!****************************************************************
+
+FUNCTION PSASAS_ZELE(TAIR,WSA)                                        
+  
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: TAIR,WSA
+  REAL :: ADOT,BDOT,CDOT
+  REAL :: MMHGPA, PSASAS_ZELE
+  REAL :: pstand,x1,lpar,acidps,act(2)
+  
+  pstand=1.01325D5 !Pa  1 atm pressure
+
+  !     Mole fraction needed for zeleznik
+  x1=(wsa/98.08D0)/(wsa/98.08D0 + ((1.0-wsa)/18.106D0))
+
+  call zeleznik(x1,tair,act)
+  
+  !     Pure acid satur vapor pressure
+  lpar= -11.695D0+LOG(pstand) ! Zeleznik
+
+  acidps=1.0/360.15D0-1.0/tair+0.38D0/545.0D0 &
+       & *(1.0+LOG(360.15D0/tair)-360.15D0/tair)
+  
+  acidps = 10156.0D0*acidps +lpar
+  acidps = EXP(acidps)    !Pa
+
+  !     Sat.vap.pres over mixture (flat surface) in Pa:
+  psasas_zele=act(2)*acidps
+
+
+
+  RETURN 
+END FUNCTION PSASAS_ZELE
+
+!****************************************************************
+SUBROUTINE Zeleznik(x,T,act)
+    
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !     Water and sulfuric acid activities in liquid
+  !     aqueous solutions.
+  !     Frank J. Zeleznik, Thermodynnamic properties
+  !     of the aqueous sulfuric acid system to 220K-350K,
+  !     mole fraction 0,...,1
+  !     J. Phys. Chem. Ref. Data, Vol. 20, No. 6,pp.1157, 1991
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
+  
+  IMPLICIT NONE
+  
+  REAL, INTENT(inout) :: x
+  REAL, INTENT(in) :: T
+  REAL, INTENT(out), DIMENSION(2):: act
+  REAL, external :: activitya, activityw
+
+  if (x .gt. 0.99D0) then
+     x=0.99D0
+  endif
+
+  act(2)=activitya(x,T) 
+  act(1)=activityw(x,T)
+  
+END SUBROUTINE Zeleznik
+
+!****************************************************************
+FUNCTION activitya(xal,T)
+
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T,xal
+  REAL :: activitya 
+  REAL, external :: lnAa
+
+  activitya = EXP(lnAa(xal,T)-lnAa(0.999999,T))
+
+END FUNCTION activitya
+  
+!****************************************************************
+FUNCTION activityw(xal,T)
+  
+  IMPLICIT NONE
+  
+  REAL, intent(in) :: T,xal 
+  REAL :: activityw 
+  REAL, external :: lnAw
+  
+  activityw=EXP(lnAw(xal,T)-lnAw(0.000001,T))
+  
+END FUNCTION activityw
+
+!****************************************************************
+FUNCTION lnAa(x1,T)
+  
+  IMPLICIT NONE
+
+  REAL :: lnAa
+  REAL, INTENT(in) :: T,x1
+  REAL, external :: m111,m121,m221,m122 
+  REAL, external :: e111,e121,e211,e122,e212,e221
+
+  lnAa=-( &
+       &    (2*m111(T)+e111(T)*(2*log(x1)+1))*x1 &
+       &    +(2*m121(T)+e211(T)*log(1-x1)+e121(T)*(log(x1)+1))*(1-x1) &
+       &    -(m111(T)+e111(T)*(log(x1)+1))*x1*x1 &
+       &    -(2*m121(T)+e121(T)*(log(x1)+1)+e211(T)*(log(1-x1)+1) &
+       &    -(2*m122(T)+e122(T)*log(x1) &
+       &           +e212(T)*log(1-x1))*(1-x1))*x1*(1-x1) &
+       &    -(m221(T)+e221(T)*(log(1-x1)+1))*(1-x1)**2 &
+       &    -x1*(1-x1)*( &
+       &                  (6*m122(T)+e122(T)*(3*log(x1)+1) &
+       &                          +e212(T)*(3*log(1-x1)+1) &
+       &                   )*x1*(1-x1) &
+       &                -(2*m122(T)+e122(T)*(log(x1)+1) &
+       &                                   +e212(T)*log(1-x1) &
+       &                    )*(1-x1)) &
+       &     )
+
+END FUNCTION lnAa
+
+!****************************************************************
+FUNCTION lnAw(x1,T)
+  
+  IMPLICIT NONE
+  
+  REAL, intent(in) :: T,x1
+  REAL :: lnAw
+  REAL, external :: m111,m121,m221,m122
+  REAL, external :: e111,e121,e211,e122,e212,e221
+  
+  lnAw=-( &
+       &  (2*m121(T)+e121(T)*log(x1)+e211(T)*(log(1-x1)+1))*x1 &
+       &  +(2*m221(T)+e221(T)*(2*log(1-x1)+1))*(1-x1) &
+       &  -(m111(T)+e111(T)*(log(x1)+1))*x1*x1 &
+       & -(2*m121(T)+e121(T)*(log(x1)+1) &
+       &            +e211(T)*(log(1-x1)+1))*x1*(1-x1) &
+       &        -(m221(T)+e221(T)*(log(1-x1)+1))*(1-x1)**2 &
+       &   +x1*(2*m122(T)+e122(T)*log(x1)+e212(T)*log(1-x1))*x1*(1-x1) &
+       &  +x1*(1-x1)*((2*m122(T)+e122(T)*log(x1) &
+       &                        +e212(T)*(log(1-x1)+1))*x1 &
+       &               -(6*m122(T)+e122(T)*(3*log(x1)+1) &
+       &                        +e212(T)*(3*log(1-x1)+1))*(1-x1)*x1) &
+       &     )
+
+END FUNCTION lnAw
+!****************************************************************
+FUNCTION m111(T)
+        
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: m111
+    
+  m111=-23.524503387D0 +  &
+       &    0.0406889449841D0*T -  & 
+       &    0.151369362907D-4*T**2+2961.44445015D0/T + &
+       &    0.492476973663D0*log(T) 
+
+END FUNCTION m111
+
+!****************************************************************
+FUNCTION m121(T)
+  
+  IMPLICIT NONE
+  REAL, INTENT(in) :: T
+  REAL :: m121  
+
+  m121=1114.58541077D0-1.1833078936D0*T - &
+       &    0.00209946114412D0*T**2-246749.842271D0/T + &
+       &    34.1234558134D0*log(T)
+
+END FUNCTION m121
+
+!****************************************************************
+FUNCTION m221(T)
+  
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: m221
+  
+  m221=-80.1488100747D0-0.0116246143257D0*T  &
+       &    +0.606767928954D-5*T**2+3092.72150882D0/T  &
+       &    +12.7601667471D0*log(T)
+
+END FUNCTION m221
+
+!****************************************************************
+FUNCTION m122(T)
+
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: m122
+  
+  m122=888.711613784D0-2.50531359687D0*T + &
+       &    0.000605638824061D0*T**2-196985.296431D0/T + &
+       &    74.550064338D0*log(T)
+
+END FUNCTION m122
+
+!****************************************************************
+FUNCTION e111(T)
+  
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: e111
+  
+  e111=2887.31663295D0-3.32602457749D0*T &
+       &    -0.2820472833D-2*T**2-528216.112353D0/T & 
+       &    +0.68699743564D0*log(T)
+
+END FUNCTION e111
+
+!****************************************************************
+FUNCTION e121(T)
+    
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: e121
+  
+  e121=-370.944593249D0-0.690310834523D0*T &
+       &    +0.56345508422D-3*T**2-3822.52997064D0/T &
+       &    +94.2682037574D0*log(T)
+
+END FUNCTION e121
+  
+!****************************************************************
+FUNCTION e211(T)
+ 
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: e211
+  
+  e211=38.3025318809D0-0.0295997878789D0*T &
+       &    +0.120999746782D-4*T**2-3246.97498999D0/T &
+       &    -3.83566039532D0*log(T)
+
+END FUNCTION e211
+
+!****************************************************************
+FUNCTION e221(T)
+  
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: e221
+  
+  e221=2324.76399402D0-0.141626921317D0*T &
+       &    -0.00626760562881D0*T**2-450590.687961D0/T &
+       &    -61.2339472744D0*log(T)
+
+END FUNCTION e221
+  
+!****************************************************************
+FUNCTION e122(T)
+  
+  IMPLICIT NONE
+  
+  REAL, INTENT(in) :: T
+  REAL :: e122
+  
+  e122=-1633.85547832D0-3.35344369968D0*T &
+       &    +0.00710978119903D0*T**2+198200.003569D0/T &
+       &    +246.693619189D0*log(T)
+
+END FUNCTION e122
+
+!****************************************************************
+FUNCTION e212(T)
+  
+  IMPLICIT NONE
+  
+  REAL :: e212
+  REAL, INTENT(in) :: T
+  
+  e212=1273.75159848D0+1.03333898148D0*T &
+       &    +0.00341400487633D0*T**2+195290.667051D0/T &
+       &    -431.737442782D0*log(T)
+
+END FUNCTION e212
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/real_16.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/real_16.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/real_16.F90	(revision 1661)
@@ -0,0 +1,6 @@
+! Module to have more precision in strings
+
+MODULE real16
+  INTEGER, PARAMETER :: REAL_16 = SELECTED_REAL_KIND (p=14,r=100)
+END MODULE real16
+      
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/sed_and_prod_mad.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/sed_and_prod_mad.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/sed_and_prod_mad.F90	(revision 1661)
@@ -0,0 +1,538 @@
+!
+! All parameter variable should be modified regarding the sudied system.
+!
+!
+! All vectors arguments of the subroutines defined here should be defined from TOP of
+! the atmosphere to the Ground.
+!
+! There should be one more vertical level than layers. Layer thickness vector should be
+! defined on the number of layer. The last item dzlay(nla), where nla is the number of layer,
+! is arbitrary and can be set to dzlay(nla-1). Usually dzlay is computed from zlay:
+!
+!    dzlay(1:nla-1) = zlay(1:nla-1)-zlay(2:nla)
+!    dzlay(nla) = dzlay(nla-1)
+!
+! Level thickness (dzlev) is also defined on the number of layer and can be computed as follow:
+!
+!    dzlev(1:nla) = zlev(1:nla)-zlev(2:nle)
+!
+! Where nle is number of vertical level (i.e. nla+1).
+!
+!
+! eta_g and lambda_g functions should be modified regarding the studied atmosphere. The current parameters
+! stands for an N2 atmosphere.
+!
+! eta_g    --> air viscosity at given temperature.
+! lambda_g --> air mean free path at given temperature and pressure.
+!
+! By J.Burgalat
+!
+! ft = Theoretical Settling velocity at each vertical levels with Fiadero correction
+
+
+!============================================================================
+! MOMENT RELATED METHODS
+!============================================================================
+FUNCTION get_r0_1(M0,M3) RESULT(ret)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  !! Compute the mean radius of the size distribution of the first mode.
+  !!
+  !! $$ r_{0,1} = \left(\dfrac{M_{3}}{M_{0}}/ \alpha_{1}(3) \right)^{1/3} $$
+  REAL, INTENT(in) :: M0
+  !! 0th order moment of the size-distribution
+  REAL, INTENT(in) :: M3
+  !! 3rd order moment of the size-distribution
+  REAL             :: ret, alpha_k
+  !! Mean radius of the mode 1
+  ret = (m3/m0 / alpha_k(3.D0,sigma1))**0.333333D0 !SG: ok+
+END FUNCTION get_r0_1
+
+
+!*****************************************************************************
+FUNCTION get_r0_2(M0,M3) RESULT(ret)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  !! Compute the mean radius of the size distribution of the first mode.
+  !!
+  !! $$ r_{0,2} = \left(\dfrac{M_{3}}{M_{0}}/ \alpha_{2}(3) \right)^{1/3} $$
+  REAL, INTENT(in) :: M0
+  !! 0th order moment of the size-distribution
+  REAL, INTENT(in) :: M3
+  !! 3rd order moment of the size-distribution
+  REAL             :: ret, alpha_k
+  !! Mean radius of the mode 2
+  ret = (m3/m0 / alpha_k(3.D0,sigma2))**0.333333D0
+END FUNCTION get_r0_2 !SG: ok ++
+
+
+!============================================================================
+! ATMOSPHERE RELATED METHODS
+!============================================================================
+FUNCTION effg(z) RESULT(ret)
+  !! Compute effective gravitational acceleration.
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  REAL, INTENT(in) :: z !! Altitude in meters
+  REAL :: ret           !! Effective gravitational acceleration in \(m.s^{-2}\)
+  ret = g0 * (rpla/(rpla+z))**2
+  RETURN
+END FUNCTION effg
+
+
+!============================================================================
+!                 PRODUCTION PROCESS RELATED METHOD
+!============================================================================
+SUBROUTINE aer_production(dt,nlay,plev,zlev,zlay,dm0_1,dm3_1)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  !! Compute the production of aerosols moments.
+  !!
+  !! The method computes the tendencies of M0 and M3 of the CCN precursor.
+  !! Production values are distributed along a normal law in altitude, centered  at
+  !! p_prod pressure level with a fixed sigma of 20km.
+  !!
+  !! First M3 tendency is computed and M0 is retrieved using the inter-moments relation
+  !! of the first mode of drop size-distribution with a fixed mean radius (r_aer).
+  REAL, INTENT(in) :: dt
+  INTEGER, INTENT(in) :: nlay
+  REAL, INTENT(in),  DIMENSION(nlay+1) :: plev    !! Pressure at each vertical level (Pa).
+  REAL, INTENT(in),  DIMENSION(nlay+1) :: zlev    !! Altitude of each vertical level (m).
+  REAL, INTENT(in),  DIMENSION(nlay)   :: zlay    !! Altitude at the center of each vertical layer (m).
+  REAL, INTENT(out), DIMENSION(nlay)   :: dm0_1   !! Tendency of M0 (\(m^{-3}\)).
+  REAL, INTENT(out), DIMENSION(nlay)   :: dm3_1   !! Tendency of M3 (\(m^{3}.m^{-3}\)).
+  INTEGER               :: i,nla,nle
+  REAL, DIMENSION(nlay) :: dzlev
+  REAL                  :: zprod,cprod, alpha_k
+
+  REAL, PARAMETER :: fnorm = 1.D0/(dsqrt(2.D0*pi)*sigz)
+  REAL, PARAMETER :: znorm = dsqrt(2.D0)*sigz
+
+  nle = SIZE(zlev) 
+  nla = nlay+1
+  dzlev = zlev(1:nle-1)-zlev(2:nle) !distance between two levels, in meter
+  zprod = -1.0D0 ! initialization
+  
+  ! locate production altitude
+  DO i=1, nla-1
+     IF (plev(i) .lt. p_aer.AND.plev(i+1) .ge. p_aer) THEN
+        zprod = zlay(i) ; EXIT ! the altitude of production is determined here
+     ENDIF
+  ENDDO
+  IF (zprod < 0.D0) THEN ! test
+     WRITE(*,'(a)') "In aer_prod, cannot find production altitude"
+     call EXIT(11)
+  ENDIF
+
+  dm3_1(:)= tx_prod *0.75D0/pi *dt / rho_aer / 2.D0 / dzlev(1:nla) * &
+       (erf((zlev(1:nla)-zprod)/znorm) - &
+       erf((zlev(2:nla+1)-zprod)/znorm))
+
+  dm0_1(:) = dm3_1(:)/(r_aer**3*alpha_k(3.D0,sig_aer))
+
+END SUBROUTINE aer_production
+
+
+!============================================================================
+! SEDIMENTATION PROCESS RELATED METHODS
+!============================================================================
+SUBROUTINE let_me_fall_in_peace(dt,nlay,dzlay,mk,ft,dmk)
+  !! Compute the tendency of the moment through sedimentation process.
+  !!
+  !!
+  !! The method computes the time evolution of the \(k^{th}\) order moment through sedimentation:
+  !!
+  !! $$ \dfrac{dM_{k}}{dt} = \dfrac{\Phi_{k}}{dz} $$
+  !!
+  !! The equation is resolved using a [Crank-Nicolson algorithm](http://en.wikipedia.org/wiki/Crank-Nicolson_method).
+  !!
+  !! Sedimentation algorithm is quite messy. It appeals to the dark side of the Force and uses evil black magic spells
+  !! from ancient times. It is based on \cite{toon1988b,fiadeiro1977,turco1979} and is an update of the algorithm
+  !! originally implemented in the LMDZ-Titan 2D GCM.
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  REAL, INTENT(in)  :: nlay, dt
+  REAL, INTENT(in), DIMENSION(nlay)  :: dzlay !! Atmospheric thickness between the center of 2 adjacent layers (\(m\))
+  REAL, INTENT(in), DIMENSION(nlay)  :: mk    !! \(k^{th}\) order moment to sediment (in \(m^{k}\)).
+  REAL, INTENT(in), DIMENSION(nlay+1):: ft    !! Downward sedimentation flux  (effective velocity of the moment).
+  REAL, INTENT(out), DIMENSION(nlay) :: dmk   !! Tendency of \(k^{th}\) order moment (in \(m^{k}.m^{-3}\)).
+  INTEGER                            :: i,nla,nle
+  REAL, DIMENSION(nlay) :: as,bs,cs,mko
+
+  nla = SIZE(mk,DIM=1) ; nle = nla+1
+
+  mko(1:nla) = 0.D0 !initialization
+  cs(1:nla) = ft(2:nla+1) - dzlay(1:nla)/dt  
+  IF (ANY(cs > 0.D0)) THEN
+     ! implicit case
+     as(1:nla) = ft(1:nla)
+     bs(1:nla) = -(ft(2:nle)+dzlay(1:nla)/dt)
+     cs(1:nla) = -dzlay(1:nla)/dt*mk(1:nla)
+     ! (Tri)diagonal matrix inversion
+     mko(1) = cs(1)/bs(1) ! at the top
+     DO i=2,nla 
+        mko(i) = (cs(i)-mko(i-1)*as(i))/bs(i) 
+     ENDDO
+  ELSE
+     ! explicit case
+     as(1:nla)=-dzlay(1:nla)/dt
+     bs(1:nla)=-ft(1:nla)
+     ! boundaries
+     mko(1)=cs(1)*mk(1)/as(1)
+     mko(nla)=(bs(nla)*mk(nla-1)+cs(nla)*mk(nla))/as(nla)
+     ! interior
+     mko(2:nla-1)=(bs(2:nla-1)*mk(1:nla-2) + &
+          cs(2:nla-1)*mk(2:nla-1)   &
+          )/as(2:nla-1)
+  ENDIF
+  dmk = mko - mk
+
+  RETURN
+END SUBROUTINE let_me_fall_in_peace
+
+
+!*****************************************************************************
+SUBROUTINE get_weff(dt,nlay,plev,zlev,dzlay,btemp,mk,k,rc,sig,wth,corf)
+!     call get_weff(plev,zlev,dzlay,btemp,m0ccn,0.D0,r0,sig,wth,fdcor)
+  !! Get the effective settling velocity for aerosols moments.
+  !!
+  !! This method computes the effective settling velocity of the \(k^{th}\) order moment of aerosol
+  !! tracers. The basic settling velocity (\(v^{eff}_{M_{k}}\)) is computed using the following
+  !! equation:
+  !!
+  !! $$
+  !! \begin{eqnarray*}
+  !! \Phi^{sed}_{M_{k}} &=& \int_{0}^{\infty} n(r) r^{k} \times w(r) dr
+  !!                     == M_{k}  \times v^{eff}_{M_{k}} \\
+  !!     v^{eff}_{M_{k} &=& \dfrac{2 \rho g r_{c}^{\dfrac{3D_{f}-3}{D_{f}}}}
+  !!     {r_{m}^{D_{f}-3}/D_{f}} \times \alpha(k)} \times \left( \alpha \right(
+  !!     \frac{D_{f}(k+3)-3}{D_{f}}\left) + \dfrac{A_{kn}\lambda_{g}}{r_{c}^{
+  !!     3/D_{f}}} \alpha \right( \frac{D_{f}(k+3)-6}{D_{f}}\left)\left)
+  !! \end{eqnarray*}
+  !! $$
+  !!
+  !! \(v^{eff}_{M_{k}\) is then corrected to reduce numerical diffusion of the sedimentation algorithm
+  !! as defined in \cite{toon1988b}.
+  !!
+  !! @warning
+  !! Both __df__, __rc__ and __afun__ must be consistent with each other otherwise wrong values will
+  !! be computed.
+
+  use free_param
+  use donnees
+  
+  IMPLICIT NONE
+  REAL, INTENT(in)         ::  dt, nlay
+  REAL, INTENT(in), DIMENSION(nlay+1)          :: plev
+  !! Pressure at each level (Pa).
+  REAL, INTENT(in), DIMENSION(nlay+1)          :: zlev
+  !! Altitude at each level (m).
+  REAL, INTENT(in), DIMENSION(nlay)            :: dzlay
+  !! Altitude at the center of each layer (Pa).
+  REAL, INTENT(in), DIMENSION(nlay)            :: btemp
+  !! Temperature at each level (T).
+  REAL, INTENT(in), DIMENSION(nlay)            :: mk
+  !! Moment of order __k__ (\(m^{k}.m^{-3}\)).
+  REAL, INTENT(in), DIMENSION(nlay)            :: rc
+  !! Characteristic radius associated to the moment at each vertical __levels__.
+  REAL, INTENT(in)                          :: k, sig
+  !! Fractal dimension of the aersols.
+  REAL, INTENT(out), DIMENSION(nlay+1)           :: wth
+  !! Theoretical Settling velocity at each vertical __levels__ (\( wth \times corf = weff\)).
+  REAL, INTENT(out), DIMENSION(nlay+1), OPTIONAL :: corf
+  !! _Fiadero_ correction factor applied to the theoretical settling velocity at each vertical __levels__.
+  INTEGER                             :: i,nla,nle
+  REAL                       :: af1,af2,ar1,ar2
+  REAL                       :: csto,cslf,ratio,wdt,dzb
+  REAL                       :: rb2ra, VISAIR, FPLAIR, alpha_k, effg
+  REAL, DIMENSION(nlay+1) :: zcorf
+  ! ------------------
+  write(*,*)'yupitururu0'
+  nla = SIZE(mk,DIM=1) 
+  nle = nla+1
+
+  write(*,*)'yupitururu1'
+  wth(:) = 0.D0 
+  zcorf(:) = 1.D0
+  
+  ar1 = (3.D0*df -3.D0)/df    
+  ar2 = (3.D0*df -6.D0)/df
+  af1 = (df*(k+3.D0)-3.D0)/df 
+  af2 = (df*(k+3.D0)-6.D0)/df
+  rb2ra = rmono**((df-3.D0)/df)
+  write(*,*)'yupitururu2'
+  DO i=2,nla
+     IF (rc(i-1) <= 0.D0) CYCLE
+     dzb = (dzlay(i)+dzlay(i-1))/2.D0
+     csto = 2.D0*rho_aer*effg(zlev(i))/(9.D0*VISAIR(btemp(i)))
+  write(*,*)'yupitururu3'
+     ! ***** WARNING ******
+     ! The 1st order slip flow correction is hidden here :
+     !    (rc(i-1)**ar1 * afun(af1) + cslf/rb2ra * rc(i-1)**ar2 * afun(af2))
+     ! wth is simple the classical settling velocity of particle due to gravity (Stokes law).
+     ! It may be enhanced using a Taylor series of the slip flow correction around a given (modal) radius
+     cslf = akn * FPLAIR(btemp(i),plev(i))
+     wth(i) = -csto/(rb2ra*alpha_k(k,sig)) * (rc(i-1)**ar1 * alpha_k(af1,sig) + cslf/rb2ra * rc(i-1)**ar2 * alpha_k(af2,sig))
+     ! now correct velocity to reduce numerical diffusion
+     IF (.NOT.no_fiadero_w) THEN
+        IF (mk(i) <= 0.D0) THEN
+           ratio = fiadero_max
+        ELSE
+           ratio = MAX(MIN(mk(i-1)/mk(i),fiadero_max),fiadero_min)
+        ENDIF
+        ! apply correction
+        IF ((ratio <= 0.9D0 .OR. ratio >= 1.1D0) .AND. wth(i) /= 0.D0) THEN
+           wdt = wth(i)*dt
+           zcorf(i) = dzb/wdt * (exp(-wdt*log(ratio)/dzb)-1.D0) / (1.D0-ratio)
+        ENDIF
+     ENDIF
+  ENDDO
+  ! last value (ground) set to first layer value: arbitrary :)
+  wth(i) = wth(i-1)
+  zcorf(i) = zcorf(i-1)
+  IF (PRESENT(corf)) corf(:) = zcorf(:)
+  RETURN
+END SUBROUTINE get_weff
+
+
+!*****************************************************************************
+SUBROUTINE aer_sedimentation(dt,nlay,m0,m3,plev,zlev,dzlay,btemp,dm0,dm3,aer_flux)
+  !! Interface to sedimentation algorithm.
+  !!
+  !! The subroutine computes the evolution of each moment of the aerosols tracers
+  !! through sedimentation process and returns their tendencies for a timestep.
+  !!
+  !! It is assumed that the aerosols size-distribution is the same as the mode 1 of cloud drops.
+  
+  use free_param
+  use donnees
+  
+  IMPLICIT NONE
+
+  REAL, INTENT(in) :: dt, nlay
+  REAL, INTENT(in), DIMENSION(nlay)   :: m0
+  !! 0th order moment of the CCN precursors (\(m^{-3}\)).
+  REAL, INTENT(in), DIMENSION(nlay)   :: m3
+  !! 3rd order moment of the CCN precursors (\(m^{3}.m^{-3}\))
+  REAL, INTENT(in), DIMENSION(nlay+1) :: plev
+  !! Pressure at each level (Pa).
+  REAL, INTENT(in), DIMENSION(nlay+1) :: zlev
+  !! Altitude at each level (m).
+  REAL, INTENT(in), DIMENSION(nlay)   :: dzlay
+  !! Altitude at the center of each layer (Pa).
+  REAL, INTENT(in), DIMENSION(nlay)   :: btemp
+  !! Temperature at each level (T).
+  REAL, INTENT(out), DIMENSION(nlay)  :: dm0
+  !! Tendency of the 0th order moment of the CCN precursors (\(m^{-3}\)).
+  REAL, INTENT(out), DIMENSION(nlay)  :: dm3
+  !! Tendency of the 3rd order moment of the CCN precursors (\(m^{3}.m^{-3}\)).
+  REAL, INTENT(out), DIMENSION(nlay+1):: aer_flux
+  !! Aerosol mass (downard) flux
+  REAL, DIMENSION(nlay+1):: ft,fdcor,wth
+  REAL, DIMENSION(nlay)  :: m0vsed,m3vsed,r0
+  REAL                   :: m,n,p,get_r0_1
+  REAL, PARAMETER        :: fac = 4.D0/3.D0 * pi
+  INTEGER                :: nla,nle,i
+  
+  aer_flux(:) = 0.D0
+  nla = size(m0,dim=1) 
+  nle = nla+1
+
+  DO i=1,nlay
+     r0(i) = get_r0_1(m0(i),m3(i))
+  ENDDO
+
+  ! Compute sedimentation process based on control flag
+  ! wsed_m0 = true, force all aerosols moments to fall at M0 settling velocity
+  ! use M0ccn to compute settling velocity
+  IF (wsed_m0) THEN  
+     ! M0
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m0,0.D0,r0,sig_aer,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:)  ; m0vsed(:) = ft(1:nla)
+     call let_me_fall_in_peace(dt,nlay,dzlay,m0,-ft,dm0)
+     ! M3
+     m3vsed(:) = ft(1:nla)
+     call let_me_fall_in_peace(dt,nlay,dzlay,m3,-ft,dm3)
+     ! get sedimentation flux
+     aer_flux(:) = fac * rho_aer * ft(:) * dm3
+     write(*,*)'sedimentation- aerosol flux: ', aer_flux
+
+  ! wsed_m3 = true, force all aerosols moments to fall at M3 settling velocity
+  ! use M3ccn to compute settling velocity
+  ELSEIF (wsed_m3) THEN 
+     ! M3
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m3,3.D0,r0,sig_aer,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:)  ; m3vsed(:) = ft(1:nla)
+     call let_me_fall_in_peace(dt,nlay,dzlay,m3,-ft,dm3)
+     ! M0
+     m0vsed(:) = ft(1:nla)
+     call let_me_fall_in_peace(dt,nlay,dzlay,m0,-ft,dm0)
+     ! get sedimentation flux
+     aer_flux(:) = fac * rho_aer * ft(:) * m3
+     write(*,*)'sedimentation- aerosol flux: ', aer_flux
+
+  ! m_wsed_m0 = false and m_wsed_m3 = false, computes the effective settling velocity for each moments
+  ELSE 
+     ! M0
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m0,0.D0,r0,sig_aer,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:)  ; m0vsed(:) = ft(1:nla)
+     call let_me_fall_in_peace(dt,nlay,dzlay,m0,-ft,dm0)
+     ! M3
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m3,3.D0,r0,sig_aer,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:)  ; m3vsed(:) = ft(1:nla)
+     call let_me_fall_in_peace(dt,nlay,dzlay,m3,-ft,dm3)
+     ! get sedimentation flux
+     aer_flux(:) = fac * rho_aer * ft(:) * m3
+     write(*,*)'sedimentation- aerosol flux: ', aer_flux
+  ENDIF
+  RETURN
+END SUBROUTINE aer_sedimentation
+
+
+!*****************************************************************************
+SUBROUTINE drop_sedimentation(dt,nlay,M0mode,M3mode,plev,zlev,dzlay,btemp,mode,dm0ccn,dm0,dm3ccn,dm3liq)
+  !! Interface to sedimentation algorithm.
+  !!
+  !! The subroutine computes the evolution of each moment of the cloud drops
+  !! through sedimentation process and returns their tendencies for a timestep.
+  !!
+  !! m0mode,m3ccn should be vector defined on the vertical structure (top to ground).
+  !! m3liq a 2D array with in 1st dimension the vertical distribution (top to ground) and
+  !! in the 2nd the list of condensate.
+  !!
+  !! The global variables wsed_m0 and wsed_m3 control how the settling velocity is 
+  !! applied during the sedimentation process:
+  !!   - If both are .false., m0mode and the sum of m3 (ccn+liquid) are treated separatly.
+  !!   - If mm_wsed_m0 is set to .true., all moments fall at m0mode settling velocity.
+  !!   - Otherwise all moments fall at m3sum settling velocity.
+  !!
+  !! note:
+  !!  drop sedimentation flux is not computed here. It can be done as in aer_sedimentation.
+  !!  However the overall density of cloud drop should be used (that is the density of 
+  !!  CCN + the density of each liquid condensate)
+  !!     cld_flux = fac *ft * (m3ccn * rho_aer + SUM(rho_liq(:) + m3liq(:)))
+  
+  use free_param
+  use donnees
+  
+  IMPLICIT NONE
+
+  REAL, INTENT(in) :: dt, nlay
+  REAL, INTENT(in), DIMENSION(nlay,2) :: M0mode
+  !! 0th order moment (\(m^{-3}\)).
+  REAL, INTENT(in), DIMENSION(nlay,3) :: M3mode
+  !! 3rd order moment (\(m^{-3}\)).
+  REAL, INTENT(in), DIMENSION(nlay+1) :: plev
+  !! Pressure at each level (Pa).
+  REAL, INTENT(in), DIMENSION(nlay+1) :: zlev
+  !! Altitude at each level (m).
+  REAL, INTENT(in), DIMENSION(nlay)   :: dzlay
+  !! Altitude at the center of each layer (Pa).
+  REAL, INTENT(in), DIMENSION(nlay)   :: btemp
+  !! Temperature at each level (T).
+  INTEGER, INTENT(in)                 :: mode
+  !! Size-distribution mode.
+  REAL, INTENT(out), DIMENSION(nlay)  :: dm0
+  !! Tendency of the 0th order moment of droplets (\(m^{-3}\)).
+  REAL, INTENT(out), DIMENSION(nlay)  :: dm0ccn
+  !! Tendency of the 0th order moment of the CCN (\(m^{-3}\)).
+  REAL, INTENT(out), DIMENSION(nlay)  :: dm3ccn
+  !! Tendency of the 3rd order moment of the CCN (\(m^{3}.m^{-3}\)).
+  REAL, INTENT(out), DIMENSION(nlay,2):: dm3liq
+  !! Tendency of the 3rd order moments of each condensate (\(m^{3}.m^{-3}\)).
+  REAL, DIMENSION(nlay+1):: ft, fdcor, wth
+  REAL, DIMENSION(nlay)  :: r0, m3sum
+  REAL                   :: m, n, p, sig, get_r0_1, get_r0_2
+  REAL, PARAMETER        :: fac = 4.D0/3.D0 * pi
+  INTEGER                :: i, nla, nle, nc
+
+  nla = nlay
+  nle = nla + 1 ; nc = nlay
+
+  m3sum(:) = 0.D0
+  DO i=1,nla
+     m3sum(:) = M3mode(i,1) + M3mode(i,2) + M3mode(i,3) ! liq1 + liq2 + ccn
+  ENDDO
+
+  IF (mode == 2) THEN
+     sig = sigma2
+     DO i=1,nla
+        r0(i) = get_r0_2(M0mode(i,1),m3sum(i))
+     ENDDO
+  ELSE
+     sig = sigma1
+     DO i=1,nla
+        r0(i) = get_r0_1(M0mode(i,1),m3sum(i))
+     ENDDO
+  ENDIF
+
+  ! Compute sedimentation process based on control flag
+  ! wsed_m0 = true, force all aerosols moments to fall at M0 settling velocity
+  ! use M0mode to compute settling velocity
+  IF (wsed_m0) THEN
+     ! use M0mode to compute settling velocity
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,M0mode(:,1),0.D0,r0,sig,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:)
+
+     ! apply the sedimentation process to all other moments 
+     call let_me_fall_in_peace(dt,nlay,dzlay,M0mode(:,1),-ft,dm0)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M0mode(:,2),-ft,dm0ccn)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,3),-ft,dm3ccn)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,2),-ft,dm3liq(:,2))
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,1),-ft,dm3liq(:,1))
+
+  ! Compute sedimentation process based on control flag
+  ! wsed_m3 = true, force all aerosols moments to fall at M3 settling velocity
+  ! use M3ccn to compute settling velocity
+  ELSEIF (wsed_m3) THEN
+     ! use M3ccn + M3liq = m3sum to compute settling velocity
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m3sum,3.D0,r0,sig,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:) 
+
+     ! apply the sedimentation process to all other moments 
+     call let_me_fall_in_peace(dt,nlay,dzlay,M0mode(:,1),-ft,dm0)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M0mode(:,2),-ft,dm0ccn)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,3),-ft,dm3ccn)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,2),-ft,dm3liq(:,2))
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,1),-ft,dm3liq(:,1))
+
+  ELSE
+     ! M0mode and M3sum fall independently
+     ! M0
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m0mode,0.D0,r0,sig,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M0mode(:,1),-ft,dm0)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M0mode(:,2),-ft,dm0ccn)
+
+     ! M3
+     call get_weff(dt,nlay,plev,zlev,dzlay,btemp,m3sum,3.D0,r0,sig,wth,fdcor)
+     ft(:) = wth(:) * fdcor(:) 
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,3),-ft,dm3ccn)
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,2),-ft,dm3liq(:,2))
+     call let_me_fall_in_peace(dt,nlay,dzlay,M3mode(:,1),-ft,dm3liq(:,1))
+  ENDIF
+
+  RETURN
+END SUBROUTINE drop_sedimentation
+
+!END MODULE SED_AND_PROD
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/thermo.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/thermo.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/thermo.F90	(revision 1661)
@@ -0,0 +1,259 @@
+
+!  FUNCTION    FPLAIR     Mean free path of air molecules (m)
+!  FUNCTION    VISAIR     Dynamic viscosity of air
+!  FUNCTION    DFWVA      Diffusivity of water vapor in air
+!  FUNCTION    STSAS      Surface tension of H2SO4 solution/vapor
+!  FUNCTION    ROSAS      Density of liquid sulfuric acid solution
+!  FUNCTION    waterps    Saturation vapour pressure of pure water
+!  FUNCTION    CDTAIR     Thermal conduvtivity of air
+
+
+!*****************************************************************************
+FUNCTION FPLAIR(T,P)
+
+  ! Molecular mean free path of air molecules
+  ! Source: Seinfield's book (2006,p.399)
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  REAL :: FPLAIR, T, P, VISAIR
+
+  FPLAIR=sqrt((PI*RGAS*T)/(2.0D0*MAIR))*(VISAIR(T)/P)
+  
+  RETURN
+
+END FUNCTION FPLAIR
+
+
+!*****************************************************************************
+FUNCTION VISAIR(T)
+
+  ! Dynamic viscosity of air.
+  ! Source: Jones 1942
+
+  ! Input:  TAIR:   Temperature (K)
+  ! Output: VISAIR: Dynamic viscosity of air  (kg/(m s))=(Pa s)
+  
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+  
+  REAL :: T, VISAIR
+  REAL :: AA, SS, T0
+
+  AA = (5.27D0-3.0D0)/(5.27D0 -1.0D0)
+  SS = -0.435D0
+  T0 = 200.0D0 
+
+  VISAIR=1015.0D0*((T/T0)**(0.5D0))*(T0**(AA)+SS)/(T**(AA)+SS) 
+  VISAIR=VISAIR*1.D-8 
+  
+  RETURN
+
+END FUNCTION VISAIR
+
+
+!*****************************************************************************
+FUNCTION DFWVA(T,P)
+
+  !     Diffusivity of water vapor in air.
+  !     Source: Prupacher & Klett:Microphysics of clouds and precipitation,
+  !                               (1980), 13-3, p. 413
+  !     The relation D = E0 (T/T0)**n (P0/P); n=1.94 has been used.
+  
+  !     Input:  TAIR: Temperature (K);  Range:  [180,273]
+  !             PAIR: Pressure (Pa)
+  !     Output: Diffusivity of water vapor in air  (m**2/sec)
+  
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  REAL :: E0, D1, P0, T0, T, P, DFWVA
+
+  PARAMETER(E0=0.211D-4,P0=1.01325D+5,T0=273.15D0,D1=E0*P0)
+  
+  DFWVA=D1*((T/T0)**1.94D0)/P
+  
+  RETURN
+
+END FUNCTION DFWVA
+
+
+!*****************************************************************************
+FUNCTION STSAS(T,xmass) 
+  !     Input:  T: Temperature (K)
+  !             xmass: Mass fraction of H2SO4  [0;1]
+  !     Output: Surface tension of sulfuric acid solution (N/m)
+
+! about 230-323 K , x=0,...,1
+!(valid down to the solid phase limit temp, which depends on molefraction)
+
+  use donnees
+      IMPLICIT NONE
+      REAL :: STSAS
+      REAL, INTENT(IN):: xmass, T
+      REAL :: a, b, T1, Tc, xmole
+
+       IF (T .LT. 305.15) THEN
+
+!low temperature surface tension
+! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari
+! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
+! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
+!and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
+
+          a= 0.11864 + xmass* (-0.11651    &   
+	             + xmass* ( 0.76852    &
+		     + xmass* (-2.40909    &
+		     + xmass*  (2.95434    &
+		     + xmass* (-1.25852)))))
+		     
+          b= -0.00015709 + xmass* (0.00040102   &
+	                 + xmass*(-0.00239950   &
+			 + xmass* (0.007611235  &
+			 + xmass*(-0.00937386   &
+			 + xmass*0.00389722))))
+          STSAS=a+T*b
+
+      ELSE
+
+      xmole = (xmass/MSA)*(1./((xmass/MSA)+(1.-xmass)/MWV))
+      
+! high temperature surface tension
+!H. Vehkam‰ki and M. Kulmala and K.E. J. lehtinen, 2003,
+!Modelling binary homogeneous nucleation of water-sulfuric acid vapours:
+! parameterisation for high temperature emissions, () Environ. Sci. Technol., 37, 3392-3398
+
+      Tc=    647.15*(1.0-xmole)*(1.0-xmole)   &
+         +   900.0 *   xmole   *  xmole       &
+         + 3156.186*   xmole   *(1-xmole)          !critical temperature
+      T1=1.0-T/Tc
+
+      a= 0.2358 + xmole*(-0.529     &
+                + xmole* (4.073     &
+		+ xmole*(-12.6707   &
+		+ xmole* (15.3552   &
+		+ xmole*(-6.3138)))))
+		
+      b= -0.14738 + xmole* (0.6253   &
+                  + xmole*(-5.4808   &
+		  + xmole*(17.2366   &
+		  + xmole*(-21.0487  &
+		  + xmole*(8.719)))))
+      STSAS=(a+b*T1)*T1**(1.256)
+
+      END IF
+      RETURN
+
+END FUNCTION STSAS
+
+
+!*****************************************************************************
+FUNCTION ROSAS(T,xmass)
+
+!
+! calculates the density of the liquid in kg/m^3
+! xmass=mass fraction of h2so4, T in kelvins
+! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari
+! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
+! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
+!and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
+
+! about 220-373 K , x=0,...,1
+!(valid down to the solid phase limit temp, which depends on molefraction)
+
+      IMPLICIT NONE
+      REAL :: ROSAS
+      REAL, INTENT(IN) :: T, xmass
+      REAL ::  a,b,c
+
+
+      a= 0.7681724 + xmass* (2.1847140         &
+                   + xmass* (7.1630022         &
+                   + xmass* (-44.31447         &
+                   + xmass* (88.75606          &
+                   + xmass*(-75.73729          &
+                   + xmass*  23.43228 )))))
+
+      b= 1.808225e-3 + xmass* (-9.294656e-3       &
+                     + xmass* (-0.03742148        &
+                     + xmass* (0.2565321          &
+                     + xmass* (-0.5362872         &
+                     + xmass* (0.4857736          &
+                     + xmass* (-0.1629592))))))
+     
+      c= -3.478524e-6 + xmass* (1.335867e-5      &
+                      + xmass* (5.195706e-5      &
+                      + xmass*(-3.717636e-4      &
+                      + xmass* (7.990811e-4      &
+                      + xmass*(-7.458060e-4      &
+                      + xmass*  2.58139e-4)))))
+     
+      ROSAS= a+T*(b+c*T) ! g/cm^3
+      ROSAS= ROSAS*1.0e3 !kg/m^3
+      
+      RETURN
+END FUNCTION ROSAS
+
+
+!****************************************************************
+FUNCTION waterps(t)
+
+  !     Saturation vapour pressure of pure water in Pa
+  !     temperature t in K
+
+  !     for 0 to 100C: Wexler 1976
+  !     for <0C (validity range 123-332K): Murphy and Koop 2005
+
+  use free_param
+  use donnees
+
+  IMPLICIT NONE
+
+  REAL:: waterps, t,w
+
+  if(t .ge. 273.15D0) then
+     waterps=exp(-2991.2729D0*(t**(-2.))-6017.0128D0/t+18.87643854D0 &
+          &        -0.028354721D0*t+0.17838301D-4*t**2.-0.84150417D-9*t**3. &
+          &        +0.44412543D-12*t**4.+2.858487D0*LOG(t))
+  else if(t .lt. 273.15D0) then
+     waterps=exp(54.842763D0-6763.22D0/t-4.210D0*LOG(t)+0.000367D0*t &
+          &        + tanh(0.0415D0*(t- 218.8D0))*(53.878D0- 1331.22D0/t &
+          &        - 9.44523D0*LOG(t) + 0.014025D0*t))
+  else
+     stop 'no good temperatures in waterps!'
+  endif
+
+END FUNCTION waterps
+
+
+!****************************************************************
+FUNCTION CDTAIR(T)
+
+  !     Thermal conduvtivity of air
+  !     Source: Prupacher & Klett:Microphysics of clouds and precipitation,
+  !                               (1980), p 418, 13-16
+  !     Formula used:             CDTAIR=4.381276E-3+7.117560E-5*TAIR
+  
+  !     Input:  TAIR:     Air temperature (K)
+  !     Output:           Thermal conductivity of air (J/(m sec K))
+  
+  use free_param
+  use donnees
+  
+  IMPLICIT NONE
+
+  REAL :: CDTAIR, T
+
+  CDTAIR=4.381276D-3+7.117560D-5*T
+
+  RETURN
+
+END FUNCTION CDTAIR
+
Index: /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/wsa_new.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/wsa_new.F90	(revision 1661)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/wsa_new.F90	(revision 1661)
@@ -0,0 +1,1295 @@
+
+!     SUBROUTINE     WSA_ROSA_NEW
+!     SUBROUTINE     ITERWV          WSA pour un WV
+!     SUBROUTINE     BRACWV          Bracket de ITERWV
+!     SUBROUTINE     BRACWSA         Bracket de KEEQ
+!     FUNCTION       IRFRMWV         Iterative Root Finder Ridder's Method for WV
+!     FUNCTION       IRFRMSA         Iterative Root Finder Ridder's Method for SA
+!     FUNCTION       KEEQ            Kelvin Equation EQuality
+!     FUNCTION       WVCOND          H2O Condensation with WSA, T, P and H2SO4tot
+
+
+!----------------------------------------------------------------------------
+SUBROUTINE  WSA_ROSA_NEW(TAIR,PAIR,RADIUS,WSAS,MSAD)
+
+  !*     This subroutine calculates the acid mass fraction, density, and
+  !*     mass of sulfuric acid in a single aerosol droplet of a specified 
+  !*     radius in equilibrium with ambient water vapor partial pressure 
+  !*     and temperature.
+  !*
+  !*     The calculation is performed by iteration of
+  !*        ln(PPWV) - [(2Mh2o sigma)/(R T r rho) - ln(ph2osa)] = 0
+  !*     using the secant method. Vapor pressures by Gmitro and Vermeulen
+  !*     (PWVSAS_GV) are used.  
+  !* Zeleznik valid only up to 350 K
+  !*
+  !*     Input/output variables:
+  !*     REAL(KIND=4)  RADIUS,TAIR,PPWV,WSAS,RHOSA,MSA
+  !*
+  !*     Input:       
+  !*         RADIUS:  m         Radius of aerosol droplet
+  !*         TAIR:    K         Temperature of ambient air 
+  !*         PPWV:    Pa        Partial pressure of ambient water vapor 
+  !*
+  !*     Output:
+  !*         WSAS:              mass fraction of sulfuric acid. [0.1;1]
+  !*         RHOSA:  kg/m**3   Density of sulfuric acid solution droplet
+  !*         MSAD:     kg        Mass of sulfuric acid in droplet
+  !*     modified from
+  !*     PROGRAM PSC_MODEL_E
+  !*     by A. Määttänen & Slimane Bekki
+  !*     subroutine for LMDZ+photochemistry VENUS
+  !*     by A. Stolzenbach
+  !*
+  !*     Modified by S.Guilbon for microphysical module to Venus GCM
+  !*
+
+  USE donnees
+  USE free_param
+
+  IMPLICIT NONE
+
+  ! Inputs
+  REAL, intent(in) :: RADIUS, TAIR, PAIR
+  ! Outputs
+  REAL, intent(out) :: WSAS, MSAD
+  ! Auxilary variables:
+  REAL :: mrt_wv, mrt_sa
+  REAL :: N_H2SO4, N_H2O
+  REAL :: H2SO4_liq, H2O_liq
+  REAL :: CONCM
+  REAL :: MCONDTOT
+  REAL :: RMODE
+  REAL :: WSAFLAG
+  REAL :: power
+  !     Ridder's Method variables:
+  REAL :: WVMIN, WVMAX, WVACC
+
+  INTEGER :: NBROOT
+
+  INTEGER :: MAXITE
+  PARAMETER(MAXITE=20)
+
+  INTEGER :: NBRAC
+  PARAMETER(NBRAC=5)
+
+  INTEGER :: FLAG
+
+  ! External functions needed:
+  REAL :: IRFRMWV
+
+  ! Physical constants:
+  REAL :: MH2O
+
+  ! External functions needed:
+  REAL ::  PWVSAS_GV,STSAS,ROSAS
+  ! PWVSAS_GV:   Natural logaritm of water vapor pressure over
+  !                      sulfuric acid solution
+  ! STSAS:       Surface tension of sulfuric acid solution
+  ! ROSAS:       Density of sulfuric acid solution
+
+  !     Auxiliary local variables:
+  REAL :: DELW,DELLP,C1,C2,W0,W1,W2,F0,F1,WGUESS,LPPWV,RO
+  REAL :: psatwv,watact
+  INTEGER :: ITERAT 
+  write(*,*)'WSA ROSA NEW', RADIUS
+  MH2O=MWV
+
+  C1=2.0D0*MH2O/RGAS
+  C2=4.0D0*PI/3.0D0
+
+  mrt_sa=ppsa/pair
+  mrt_wv=ppwv/pair
+
+  ! Initialisation des bornes pour WV
+  WVMIN=1.D-35
+  WVMAX=mrt_wv
+
+  ! Accuracy de WVeq
+  WVACC=WVMAX*1.0D-3
+
+  !  BRACWV borne la fonction f(WV) - WV = 0
+  !  de WV=0  WV=WVtot on cherche l'intervalle o f(WV) - WV = 0
+  !  avec prcisment f(WVliq de WSA<=WVinput) + WVinput - WVtot = 0 
+  !  Elle fait appel  la fct/ssrtine ITERWV()
+  CALL BRACWV(TAIR,PAIR,WVMIN,WVMAX,NBRAC,RADIUS,mrt_wv,mrt_sa,FLAG,WSAFLAG,NBROOT)
+
+  SELECT CASE(FLAG)
+
+  CASE(1) 
+     ! Cas NROOT=1 ou NROOT>1 mais dans un intervalle restreint WVTOT (cas courant)         
+     ! IRFRMWV Ridder's method pour trouver, sur [WVmin,WVmax], WVo tel que f(WVo) - WVo = 0 
+     ! Elle fait appel  la fct/ssrtine ITERWV()
+
+     WSAS=IRFRMWV(TAIR,PAIR,WVMIN,WVMAX,WVACC,MAXITE,RADIUS,mrt_wv,mrt_sa,NBROOT)
+     RHOSA = ROSAS(TAIR,WSAS)
+     MSAD = C2*WSAS*RHOSA*RADIUS**3
+
+  CASE(2)
+     ! Cas NROOT=0 mais proche de 0 
+     WSAS=WSAFLAG      
+     RHOSA=ROSAS(TAIR,WSAS)
+     MSAD=C2*WSAS*RHOSA*RADIUS**3
+     !     ATTENTION ce IF ne sert a rien en fait, juste a retenir une situation
+     !     ubuesque dans mon code ou sans ce IF les valeurs de rho_droplets sont
+     !     incohrentes avec TT et WH2SO4 (a priori lorsque NTOT=0) 
+     !     Juste le fait de METTRE un IF fait que rho_droplet a la bonne valeur
+     !     donne par ROSAS (cf test externe en Python), sinon, la valeur est trop
+     !     basse (de l'ordre de 1000 kg/m3) et correspond parfois  la valeur avec
+     !     WSA=0.1 (pas totalement sr) 
+     !     En tous cas, incohrent avec ce qui est attendue pour le WSA et T donn
+     !     La version avec le IF (rho<1100 & WSA>0.1) est CORRECTE, rho_droplet a 
+     !     la bonne valeur (tests externes Python confirment)
+
+     IF ((RHOSA.LT.1100.0D0).AND. (WSAS.GT.0.1D0))THEN
+        PRINT*,'PROBLEM RHO_DROPLET'
+        PRINT*,'rho_droplet',RHOSA
+        PRINT*,'T',TAIR,'WSA',WSAS
+        PRINT*,'ROSAS',ROSAS(TAIR, WSAS)
+        PRINT*,'FLAG',FLAG,'NROOT',NBROOT
+        STOP
+     ENDIF
+
+  CASE(3)
+     write(*,*)'Case 0 NROOT'  
+     RHOSA=0.0D+0
+     WSAS=0.0D+0
+     MSAD=0.0D+0
+
+  END SELECT
+
+
+
+  RETURN 
+
+END SUBROUTINE WSA_ROSA_NEW
+
+
+!*****************************************************************************                              
+SUBROUTINE ITERWV(TAIR,PAIR,WV,WVLIQ,WVEQOUT,WVTOT,WSAOUT,SATOT,RADIUS)
+  !* Cette routine est la solution par itration afin de trouver WSA pour un WV,
+  !* et donc LPPWV, donn. Ce qui nous donne egalement le WV correspondant au 
+  !* WSA solution   
+  !* For VenusGCM by A. Stolzenbach 07/2014 
+  !* OUTPUT: WVEQ et WSAOUT
+
+  USE donnees
+  USE free_param
+  IMPLICIT NONE
+
+  REAL, INTENT(IN) :: TAIR, PAIR
+  REAL, INTENT(IN) :: WV, WVTOT, SATOT, RADIUS 
+  REAL, INTENT(OUT) :: WVEQOUT, WSAOUT, WVLIQ
+
+  REAL :: LPPWV
+
+  REAL :: WSAMIN, WSAMAX, WSAACC
+  PARAMETER(WSAACC=0.01D0)
+
+  INTEGER :: MAXITSA, NBRACSA, NBROOT
+  PARAMETER(MAXITSA=20)
+  PARAMETER(NBRACSA=5)
+
+  LOGICAl :: FLAG1,FLAG2
+
+  ! External Function      
+  REAL :: IRFRMSA, WVCOND
+
+  IF (RADIUS.LT.1D-30) THEN
+     PRINT*,'RMODE == 0 FLAG 3', RADIUS
+     STOP
+  ENDIF
+
+  ! Initialisation WSA=[0.1,1.0]      
+  WSAMIN = 0.1D0
+  WSAMAX = 1.0D0
+  LPPWV = LOG(PAIR*WV)
+
+  ! Appel Bracket de KEEQ         
+  CALL BRACWSA(WSAMIN,WSAMAX,NBRACSA,RADIUS,TAIR,LPPWV,FLAG1,FLAG2,NBROOT)
+
+  IF ((.NOT.FLAG1).AND.(.NOT.FLAG2).AND.(NBROOT.EQ.1)) THEN          
+
+     WSAOUT=IRFRMSA(TAIR,PAIR,WSAMIN,WSAMAX,WSAACC,MAXITSA,RADIUS,LPPWV,NBROOT)
+
+!!$     ! AM uncommented the two following lines to avoid problems with nucleation
+!!$     IF (WSAOUT.GT.1.0) WSAOUT=0.999999
+!!$     IF (WSAOUT.LT.0.1) WSAOUT=0.1
+!!$     write(*,*) 'in 1 wsaout 2', WSAOUT
+
+     ! Si BRACWSA ne trouve aucun ensemble solution KEEQ=0 on fixe WSA a 0.9999 ou 0.1
+  ELSE
+     IF (FLAG1.AND.(.NOT.FLAG2)) WSAOUT = 0.999999D0
+     IF (FLAG2.AND.(.NOT.FLAG1)) WSAOUT = WSAMIN
+     IF (FLAG1.AND.FLAG2) THEN
+        PRINT*,'FLAGs BARCWSA tous TRUE'
+        STOP
+     ENDIF
+  ENDIF
+
+  !     WVEQ output correspondant a WVliq lie a WSA calcule
+  WVLIQ=WVCOND(WSAOUT,TAIR,PAIR,SATOT)
+  WVEQOUT=(WVLIQ+WV)/WVTOT-1.0D0
+
+END SUBROUTINE ITERWV
+
+
+!*****************************************************************************                             
+SUBROUTINE BRACWV(TAIR,PAIR,XA,XB,N,RADIUS,WVTOT,SATOT,FLAGWV,WSAFLAG,NROOT)
+
+  !* Bracket de ITERWV
+  !* From Numerical Recipes     
+  !* Adapted for VenusGCM A. Stolzenbach 07/2014 
+  !* X est WVinput
+  !* OUTPUT: XA et XB      
+
+  USE donnees
+  USE free_param
+
+  IMPLICIT NONE
+
+  REAL, INTENT(IN) :: WVTOT,SATOT,RADIUS,TAIR, PAIR
+  INTEGER, INTENT(IN) :: N
+
+  REAL, INTENT(INOUT) :: XA,XB
+  REAL, INTENT(OUT) :: WSAFLAG
+
+  INTEGER :: I,J
+
+  INTEGER, INTENT(OUT) :: NROOT
+
+  REAL :: FP, FC, X, WVEQ, WVLIQ, WSAOUT
+  REAL :: XMAX,XMIN,WVEQACC
+
+  INTEGER, INTENT(OUT) :: FLAGWV
+  write(*,*)'BRACWV', RADIUS
+  ! WVEQACC est le seuil auquel on accorde un WSA correct meme
+  ! si il ne fait pas partie d'une borne. Utile quand le modele
+  ! s'approche de 0 mais ne l'atteint pas.
+  WVEQACC = 1.0D-3  
+  FLAGWV = 1
+  NROOT = 0
+
+!     25/11/2016
+!     On change ordre on va du max au min
+  X = XB
+  XMAX = XB
+  XMIN = XA
+
+  ! CAS 1 On borne la fonction (WVEQ=0)
+  CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,RADIUS)
+
+  FP=WVEQ
+
+  DO I=N-1,1,-1
+     X=(1.-DLOG(DBLE(N-I))/DLOG(DBLE(N)))*XMAX
+
+     CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,RADIUS)
+
+     FC=WVEQ
+
+     IF ((FP*FC).LT.0.D0) THEN  
+        NROOT=NROOT+1
+        ! Si NROOT>1 on place la borne sup output  la borne min du calcul en i             
+        IF (NROOT.GT.1) THEN
+           XB=(1.-LOG(DBLE(I+1))/LOG(DBLE(N)))*XMAX
+        ENDIF
+
+        IF (I.EQ.1) THEN
+           XA=XMIN
+        ELSE
+           XA=X
+        ENDIF
+        RETURN
+     ENDIF
+     FP=FC
+  ENDDO
+
+  ! CAS 2 on refait la boucle pour tester si WVEQ est proche de 0 
+  ! avec le seuil WVEQACC
+  IF (NROOT.EQ.0) THEN
+     X=XMAX
+
+     CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,RADIUS)
+
+     DO J=N-1,1,-1
+        X=(1.-LOG(DBLE(N-J))/LOG(DBLE(N)))*XMAX
+        !             write(*,*) 'BRACWV, bf 4th ITERWV (cas 2) '
+        CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,RADIUS)
+
+        IF (ABS(WVEQ).LE.WVEQACC) THEN
+           WSAFLAG=WSAOUT
+           FLAGWV=2
+           RETURN
+        ENDIF
+     ENDDO
+
+     !     CAS 3 Pas de borne, WVEQ jamais proche de 0          
+     FLAGWV=3
+     RETURN
+  ENDIF
+
+END SUBROUTINE BRACWV
+
+
+!*****************************************************************************
+SUBROUTINE BRACWSA(XA,XB,N,RADIUS,TAIR,LPPWVINP,FLAGH,FLAGL,NROOT)
+
+  !* Bracket de KEEQ
+  !* From Numerical Recipes     
+  !* Adapted for Venus GCM A. Stolzenbach 07/2014 
+
+  USE donnees
+  USE free_param
+  IMPLICIT NONE
+
+  !     External functions needed:
+  REAL :: KEEQ
+
+  REAL, INTENT(IN) :: RADIUS,TAIR,LPPWVINP 
+  INTEGER, INTENT(IN) :: N
+
+  REAL, INTENT(INOUT) :: XA,XB
+
+  INTEGER, INTENT(OUT) ::  NROOT
+
+  INTEGER :: I, J
+
+  REAL :: DX, FP, FC, X
+
+  LOGICAL, INTENT(OUT) :: FLAGH,FLAGL
+
+  FLAGL=.FALSE.
+  FLAGH=.FALSE.    
+  NROOT=0
+  DX=(XB-XA)/N
+  X=XB
+  FP=KEEQ(RADIUS,X,LPPWVINP)
+
+  DO I=N,1,-1
+     X=X-DX
+
+     FC=KEEQ(RADIUS,X,LPPWVINP)
+
+     IF ((FP*FC).LE.0.) THEN
+        NROOT=NROOT+1
+        XA=X
+        XB=X+DX
+        RETURN
+     ENDIF
+
+     FP=FC
+  ENDDO
+
+  IF (NROOT.EQ.0) THEN
+     ! Test determine la tendance globale KEEQ sur [WSAMIN,WSAMAX]        
+     IF ((ABS(KEEQ(TAIR,RADIUS,XA,LPPWVINP))- &
+          &    ABS(KEEQ(TAIR,RADIUS,XB,LPPWVINP))).GT.0.0) FLAGH=.TRUE.
+     ! On fixe flag low TRUE pour WSA = 0.1
+     IF ((ABS(KEEQ(TAIR,RADIUS,XA,LPPWVINP))- &
+          &    ABS(KEEQ(TAIR,RADIUS,XB,LPPWVINP))).LT.0.0) FLAGL=.TRUE.
+  ENDIF
+
+END SUBROUTINE BRACWSA
+
+
+!*****************************************************************************
+FUNCTION IRFRMWV(TAIR,PAIR,X1,X2,XACC,MAXIT,RADIUS,WVTOT,SATOT,NROOT)
+
+  !* Iterative Root Finder Ridder's Method for Water Vapor calculus
+  !* From Numerical Recipes
+  !* Adapted for VenusGCM A. Stolzenbach 07/2014
+
+  !* Les iterations sur [X1,X2] sont [WV1,WV2]
+  !* la variable X est WV
+  !* IRFRMWV sort en OUTPUT : WSALOC pour ITERWV=0 (ou WVEQ=0)
+
+  USE donnees
+  USE free_param
+  IMPLICIT NONE
+
+  REAL, INTENT(IN) :: TAIR, PAIR
+  REAL, INTENT(IN) :: X1, X2
+  REAL, INTENT(IN) :: XACC
+  REAL :: IRFRMWV 
+  INTEGER, INTENT(IN) :: MAXIT,NROOT
+
+  ! LOCAL VARIABLES
+  REAL :: XL, XH, XM, XNEW, X
+  REAL :: WSALOC, WVEQ, WVLIQ
+  REAL :: FL, FH, FM, FNEW
+  REAL :: ANS, S, FSIGN
+  INTEGER i
+  LOGICAL :: FLAGH,FLAGL
+
+  ! External variables needed:
+  REAL, INTENT(IN) :: WVTOT,SATOT
+  REAL, INTENT(IN) :: RADIUS
+
+  ! Initialisation
+  X=X1
+  CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS) 
+  FL=WVEQ
+  X=X2
+  CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+  FH=WVEQ
+
+  ! Test Bracketed values 
+  IF (((FL.LT.0.).AND.(FH.GT.0.)).OR. &
+       &   ((FL.GT.0.).AND.(FH.LT.0.))) &
+       &  THEN
+     XL=X1
+     XH=X2
+     ANS=-1.D38
+
+     DO i=1, MAXIT
+        XM=0.5D0*(XL+XH)
+        CALL ITERWV(TAIR,PAIR,XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+        FM=WVEQ
+        S=SQRT(FM*FM-FL*FH)
+
+        IF (S.EQ.0.0) THEN
+           IRFRMWV=WSALOC
+           RETURN
+        ENDIF
+
+        IF (FL.GT.FH) THEN
+           FSIGN=1.0D0
+        ELSE
+           FSIGN=-1.0D0
+        ENDIF
+
+        XNEW=XM+(XM-XL)*(FSIGN*FM/S) 
+
+        IF (ABS(XNEW-ANS).LE.XACC) THEN
+           IRFRMWV=WSALOC
+           RETURN
+        ENDIF
+
+        ANS=XNEW
+        CALL ITERWV(TAIR,PAIR,ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+        FNEW=WVEQ
+
+        IF (FNEW.EQ.0.D0) THEN
+           IRFRMWV=WSALOC
+           RETURN
+        ENDIF
+
+        IF (SIGN(FM, FNEW).NE.FM) THEN
+           XL=XM
+           FL=FM
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
+           XL=ANS
+           FL=FNEW
+        ELSE
+           PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
+           PRINT*,'you shall not PAAAAAASS'
+           STOP
+        ENDIF
+     ENDDO
+     PRINT*,'Paaaaas bien MAXIT atteint'
+     PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
+     PRINT*,'you shall not PAAAAAASS'
+     XL=X1
+     XH=X2
+     !         ANS=-9.99e99
+     ANS=-1.D38
+
+     DO i=1, MAXIT
+        XM=0.5D0*(XL+XH)
+        CALL ITERWV(TAIR,PAIR,XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+        FM=WVEQ
+        S=SQRT(FM*FM-FL*FH)
+        IF (FL.GT.FH) THEN
+           FSIGN=1.0D0
+        ELSE
+           FSIGN=-1.0D0
+        ENDIF
+
+        XNEW=XM+(XM-XL)*(FSIGN*FM/S)     
+
+        ANS=XNEW
+        CALL ITERWV(TAIR,PAIR,ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+        FNEW=WVEQ
+        PRINT*,'WVliq',WVLIQ,'WVtot',WVTOT,'WVeq',WVEQ
+        PRINT*,'WSA',WSALOC,'SAtot',SATOT
+        PRINT*,'T',TAIR,'P',PAIR
+
+        IF (SIGN(FM, FNEW).NE.FM) THEN
+           XL=XM
+           FL=FM
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
+           XL=ANS
+           FL=FNEW
+        ELSE
+           PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
+           PRINT*,'you shall not PAAAAAASS TWIIICE???'
+           STOP
+        ENDIF
+     ENDDO
+     STOP
+  ELSE
+     PRINT*,'IRFRMWV must be bracketed'
+     PRINT*,'NROOT de BRACWV', NROOT
+     IF (ABS(FL).LT.XACC) THEN
+        PRINT*,'IRFRMWV FL == 0',FL 
+        PRINT*,'X1',X1,'X2',X2,'FH',FH
+        CALL ITERWV(TAIR,PAIR,X1,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+        IRFRMWV=WSALOC
+        RETURN
+     ENDIF
+     IF (ABS(FH).LT.XACC) THEN
+        PRINT*,'IRFRMWV FH == 0',FH
+        PRINT*,'X1',X1,'X2',X2,'FL',FL
+        CALL ITERWV(TAIR,PAIR,X2,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,RADIUS)
+        IRFRMWV=WSALOC
+        RETURN
+     ENDIF
+     IF ((ABS(FL).GT.XACC).AND.(ABS(FH).GT.XACC)) THEN 
+        PRINT*,'STOP dans IRFRMWV avec rien == 0'
+        PRINT*,'X1',X1,'X2',X2
+        PRINT*,'Fcalc',FL,FH
+        PRINT*,'T',TAIR,'P',PAIR,'R',RADIUS
+        STOP   
+     ENDIF
+     IF ((ABS(FL).LT.XACC).AND.(ABS(FH).LT.XACC)) THEN 
+        PRINT*,'STOP dans IRFRMWV Trop de solution < WVACC'
+        PRINT*,FL,FH
+        STOP   
+     ENDIF
+
+  end IF
+END FUNCTION IRFRMWV
+
+!*****************************************************************************                             
+FUNCTION IRFRMSA(TAIR,PAIR,X1,X2,XACC,MAXIT,RADIUS,LPPWV,NB)
+
+  !* Iterative Root Finder Ridder's Method for Sulfuric Acid calculus
+  !* From Numerical Recipes
+  !* Adapted for VenusGCM A. Stolzenbach 07/2014
+  !*
+  !* Les iterations sur [X1,X2] sont [WSA1,WSA2]
+  !* la variable X est WSA
+  !* IRFRMSA sort en OUTPUT : WSA pour KEEQ=0
+
+  use donnees
+  use free_param
+  IMPLICIT NONE
+
+  REAL, INTENT(IN) :: TAIR, PAIR
+  REAL, INTENT(IN) :: X1, X2
+  REAL, INTENT(IN) :: XACC 
+  INTEGER, INTENT(IN) :: MAXIT, NB
+
+  !     LOCAL VARIABLES
+  REAL :: IRFRMSA
+  REAL :: XL, XH, XM, XNEW
+  REAL :: Fl, FH, FM, FNEW
+  REAL :: ANS, S, FSIGN
+  INTEGER i
+
+  !     External variables needed:
+  REAL, INTENT(IN) :: LPPWV
+  REAL, INTENT(IN) :: RADIUS
+
+  !     External functions needed:
+  REAL :: KEEQ
+
+  !     Initialisation
+  FL=KEEQ(TAIR,RADIUS,X1,LPPWV)
+  FH=KEEQ(TAIR,RADIUS,X2,LPPWV)
+
+  !     Test Bracketed values 
+  IF (((FL.LT.0.D0).AND.(FH.GT.0.D0)).OR.((FL.GT.0.D0).AND.(FH.LT.0.D0)))  THEN
+
+     XL=X1
+     XH=X2
+
+     ANS=-1.D38
+
+     DO i=1, MAXIT
+        XM=0.5D0*(XL+XH)
+        FM=KEEQ(TAIR,RADIUS,XM,LPPWV)
+
+        S=SQRT(FM*FM-FL*FH)
+
+        IF (S.EQ.0.D0) THEN
+           IRFRMSA=ANS
+           RETURN
+        ENDIF
+
+        IF (FL.GT.FH) THEN
+           FSIGN=1.0D0
+        ELSE
+           FSIGN=-1.0D0
+        ENDIF
+
+        XNEW=XM+(XM-XL)*(FSIGN*FM/S) 
+
+        IF (ABS(XNEW-ANS).LE.XACC) THEN
+           IRFRMSA=ANS
+
+           RETURN
+        ENDIF
+
+        ANS=XNEW
+        FNEW=KEEQ(TAIR,RADIUS,ANS,LPPWV)
+
+        IF (FNEW.EQ.0.D0) THEN
+           IRFRMSA=ANS
+           RETURN
+        ENDIF
+
+        IF (SIGN(FM, FNEW).NE.FM) THEN
+           XL=XM
+           FL=FM
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
+           XL=ANS
+           FL=FNEW
+        ELSE
+           PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
+           PRINT*,'you shall not PAAAAAASS'
+           STOP
+        ENDIF
+
+     ENDDO
+     PRINT*,'Paaaaas bien MAXIT atteint'
+     PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
+     PRINT*,'you shall not PAAAAAASS'
+     XL=X1
+     XH=X2
+     PRINT*,'Borne XL',XL,'XH',XH
+
+     ANS=-1.D38
+
+     DO i=1, MAXIT
+        XM=0.5D0*(XL+XH)
+        FM=KEEQ(TAIR,RADIUS,XM,LPPWV)
+        S=SQRT(FM*FM-FL*FH)
+
+        IF (FL.GT.FH) THEN
+           FSIGN=1.0D0
+        ELSE
+           FSIGN=-1.0D0
+        ENDIF
+
+        XNEW=XM+(XM-XL)*(FSIGN*FM/S)  
+        ANS=XNEW
+        FNEW=KEEQ(TAIR,RADIUS,ANS,LPPWV)
+        PRINT*,'KEEQ result',FNEW,'T',TAIR,'R',RADIUS
+        IF (SIGN(FM, FNEW).NE.FM) THEN
+           XL=XM
+           FL=FM
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
+           XH=ANS
+           FH=FNEW
+        ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
+           XL=ANS
+           FL=FNEW
+        ELSE
+           PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
+           PRINT*,'you shall not PAAAAAASS'
+           STOP
+        ENDIF
+     ENDDO
+     STOP
+
+  ELSE
+     PRINT*,'IRFRMSA must be bracketed'
+     IF (FL.EQ.0.D0) THEN
+        PRINT*,'IRFRMSA FL == 0',Fl
+        IRFRMSA=X1
+        RETURN
+     ENDIF
+     IF (FH.EQ.0.D0) THEN
+        PRINT*,'IRFRMSA FH == 0',FH
+        IRFRMSA=X2
+        RETURN
+     ENDIF
+     IF ((FL.NE.0.).AND.(FH.NE.0.)) THEN
+        PRINT*,'IRFRMSA FH and FL neq 0: ', FL, FH
+        PRINT*,'X1',X1,'X2',X2 
+        PRINT*,'Kind F', KIND(FL), KIND(FH)
+        PRINT*,'Kind X', KIND(X1), KIND(X2)
+        PRINT*,'Logical: ',(SIGN(FL,FH).NE.FL)
+        PRINT*,'Logical: ',(SIGN(FH,FL).NE.FH)
+        PRINT*,'nb root BRACWSA',NB
+        STOP
+     ENDIF
+
+  ENDIF
+
+END function IRFRMSA
+
+!*****************************************************************************
+FUNCTION KEEQ(TAIR,RADIUS,WX,LPPWV)
+
+  !* Kelvin Equation EQuality
+  !* ln(PPWV_eq) - (2Mh2o sigma)/(R T r rho) - ln(ph2osa) = 0
+
+  use donnees
+  use free_param
+  IMPLICIT NONE
+
+  REAL, INTENT(IN) :: RADIUS,WX,LPPWV,TAIR
+
+  ! Physical constants:
+  REAL :: MH2O, KEEQ
+
+  !     External functions needed:
+  REAL :: PWVSAS_GV, STSAS, ROSAS
+  !     PWVSAS_GV:      Natural logaritm of water vapor pressure over
+  !                  sulfuric acid solution
+  !     STSAS:       Surface tension of sulfuric acid solution
+  !     ROSAS:       Density of sulfuric acid solution
+  !
+  !     Auxiliary local variables:
+  REAL :: C1
+
+  MH2O= MWV
+  C1=2.0D0*MH2O/RGAS
+
+  KEEQ=LPPWV-C1*STSAS(TAIR,WX)/(TAIR*RADIUS*ROSAS(TAIR,WX))- &
+       &     PWVSAS_GV(TAIR,WX)
+
+END FUNCTION KEEQ
+
+
+!*****************************************************************************
+FUNCTION WVCOND(WX,T,P,SAt)
+
+  !* Condensation de H2O selon WSA, T et P et H2SO4tot
+
+  !* Adapted for VenusGCM A. Stolzenbach 07/2014
+  !     INPUT:
+  !     SAt  : VMR of total H2SO4
+  !     WX: aerosol H2SO4 weight fraction (fraction)
+  !     T: temperature (K)
+  !     P: pressure (Pa)
+  !     OUTPUT: 
+  !	WVCOND : VMR H2O condense
+
+  !      USE chemparam_mod
+
+  use donnees
+  use free_param
+
+  IMPLICIT NONE
+
+  REAL, INTENT(IN) :: SAt, WX
+  REAL, INTENT(IN) :: T, P
+
+  !     working variables
+  REAL :: WVCOND
+  REAL :: SA, WV, KBOLTZ
+  REAL :: DND2,pstand,lpar,acidps
+  REAL :: x1, satpacid
+  REAL, DIMENSION(2):: act
+  REAL :: CONCM
+  REAL :: NH2SO4
+  REAL :: H2OCOND, H2SO4COND
+
+  KBOLTZ=KBZ
+  CONCM= (P)/(KBOLTZ*T) !air number density, molec/m3? CHECK UNITS!
+
+  NH2SO4=SAt*CONCM
+  pstand=1.01325D+5 !Pa  1 atm pressure
+
+  x1=(WX/MSA)/(WX/MSA + ((1.-WX)/MWV))
+
+  CALL zeleznik(x1,T,act)
+
+  !pure acid satur vapor pressure
+  lpar= -11.695D0 + LOG(pstand) ! Zeleznik
+  acidps = 1/360.15D0 - 1.0/T + 0.38D0/545.D0*(1.0+LOG(360.15D0/T)-360.15D0/T)
+  acidps = 10156.D0*acidps + lpar
+  acidps = EXP(acidps)    !Pa
+
+  !acid sat.vap.PP over mixture (flat surface):
+  satpacid=act(2)*acidps ! Pa 
+
+  !       Conversion from Pa to N.D #/m3
+  DND2=satpacid/(KBOLTZ*T)
+  !	H2SO4COND N.D #/m3 condensee ssi H2SO4>H2SO4sat
+  IF (NH2SO4.GT.DND2) THEN
+     H2SO4COND=NH2SO4-DND2
+     !	calcul de H2O cond correspondant a H2SO4 cond
+     H2OCOND=H2SO4COND*MSA*(1.0D0-WX)/(MWV*WX)
+     !	Si on a H2SO4<H2SO4sat on ne condense rien, VMR = 1.0E-30 
+  ELSE
+     H2OCOND=1.0D-30*CONCM
+  END IF
+
+  !*****************************************************
+  !     ATTENTION: Ici on ne prends pas en compte 
+  !                si H2O en defaut!
+  !                On veut la situation thorique
+  !                 l'equilibre
+  !*****************************************************	     	
+  !	Test si H2O en defaut H2Ocond>H2O dispo
+  !	IF ((H2OCOND.GT.NH2O).AND.(NH2SO4.GE.DND2)) THEN
+  !	On peut alors condenser tout le H2O dispo
+  !	H2OCOND=NH2O
+  !	On met alors egalement a jour le H2SO4 cond correspondant au H2O cond
+  !	H2SO4COND=H2OCOND*18.0153*WSA/(98.078*(1.0-WSA))
+  !      END IF
+
+  !     Calcul de H2O condense VMR          
+  WVCOND=H2OCOND/CONCM
+
+END FUNCTION WVCOND
+
+
+!*****************************************************************************
+FUNCTION PWVSAS_GV(T,W)
+
+  !*     Natural logaritm of saturated water vapor pressure over plane
+  !*     sulfuric acid solution.
+  !*
+  !*     Source: J.I.Gmitro & T.Vermeulen: A.I.Ch.E.J.  10,740,1964.
+  !*             W.F.Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
+  !*
+  !*     The formula of Gmitro & Vermeulen for saturation pressure
+  !*     is used:
+  !*                 ln(p) = A ln(298/T) + B/T + C + DT
+  !*     with values of A,B,C and D given by Gmitro & Vermeulen,
+  !*     and calculated from partial molal properties given by Giauque et al.
+  !* 
+  !*     Input:  T: Temperature (K)
+  !*             W: Weight fraction of H2SO4  [0;1] 
+  !*     Output: Natural logaritm of water vapor pressure 
+  !*             over sulfuric acid solution   ( ln(Pa) )
+  !*
+  !*     External functions needed for calculation of partial molal 
+  !*     properties of pure components at 25 C as function of W.
+
+  use donnees
+      IMPLICIT NONE
+
+      REAL :: CPH2O,ALH2O,FFH2O,LH2O
+!     CPH2O:  Partial molal heat capacity of sulfuric acid solution.
+!     ALH2O:  Temparature derivative of CPH2O
+!     FFH2O:  Partial molal free energy of sulfuric acid solution.
+!     LH2O:   Partial molal enthalpy of sulfuric acid
+!
+!
+!
+      REAL, INTENT(IN) :: T,W
+      REAL :: PWVSAS_GV
+      REAL :: ADOT,BDOT,CDOT,DDOT
+      REAL :: MMHGPA
+      REAL :: K1,K2
+      REAL :: A,B,C,Dd,CP,L,F,ALFA
+!     Physical constants given by Gmitro & Vermeulen:
+      PARAMETER(                   &
+              ADOT=-3.67340,       &
+              BDOT=-4143.5,        &
+              CDOT=10.24353,       &
+              DDOT=0.618943d-3)
+      PARAMETER(                   &
+!     Natural logarith of conversion factor between atm. and Pa:     
+           MMHGPA=11.52608845,     &
+           K1=298.15,              &
+           K2=K1*K1/2.0)
+!
+      INTEGER :: KLO,KHI,K,I,NPOINT
+      PARAMETER(NPOINT=110)
+      REAL, DIMENSION(NPOINT) :: WTAB(NPOINT)
+      DATA (WTAB(I),I=1,NPOINT)/   &
+     0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,   &
+     0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,   &
+     0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,   &
+     0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,   &
+     0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,   &
+     0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,   &
+     0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,   &
+     0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,   &
+     0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,   &
+     0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,   &
+     0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,   &
+     0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,   &
+     0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,   &
+     0.99908,0.99927,0.99945,0.99963,0.99982,1.0000/
+!
+      KLO=1
+      KHI=NPOINT
+ 1    IF(KHI-KLO.GT.1) THEN
+          K=(KHI+KLO)/2
+          IF(WTAB(K).GT.MAX(WTAB(1),W)) THEN
+              KHI=K
+          ELSE
+              KLO=K
+          ENDIF
+          GOTO 1
+      ENDIF
+!
+      CP=CPH2O(W,KHI,KLO)
+      F=-FFH2O(W,KHI,KLO)
+      L=-LH2O(W,KHI,KLO)
+      ALFA=ALH2O(W,KHI,KLO)
+!
+      A=ADOT+(CP-K1*ALFA)/RGAS
+      B=BDOT+(L-K1*CP+K2*ALFA)/RGAS
+      C=CDOT+(CP+(F-L)/K1)/RGAS
+      Dd=DDOT-ALFA/(2.0d0*RGAS)
+!
+!     WRITE(*,*) 'TAIR= ',T,'  WSA= ',W
+!     WRITE(*,*) 'CPH2O(W)= ',CP
+!     WRITE(*,*) 'ALFAH2O(W)= ',ALFA
+!     WRITE(*,*) 'FFH2O(W)= ',F
+!     WRITE(*,*) 'LH2O(W)= ',L
+!
+      PWVSAS_GV=A*DLOG(K1/T)+B/T+C+Dd*T+MMHGPA
+      
+      END FUNCTION PWVSAS_GV
+
+
+!*****************************************************************************
+REAL FUNCTION CPH2O(W,khi_in,klo_in)
+
+!     Relative partial molal heat capacity of water (cal/(deg mole) in 
+!     sulfuric acid solution, as a function of H2SO4 weight fraction [0;1],
+!     calculated by cubic spline fitting.
+!
+!     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
+
+      IMPLICIT NONE
+
+      INTEGER :: NPOINT,I
+      PARAMETER(NPOINT=109)
+      REAL, DIMENSION(NPOINT) :: WTAB(NPOINT),CPHTAB(NPOINT),  &
+                                 Y2(NPOINT),YWORK(NPOINT)
+      REAL, INTENT(IN):: W
+      INTEGER, INTENT(IN):: khi_in,klo_in
+      INTEGER :: khi,klo
+      REAL :: CPH
+      LOGICAL :: FIRST
+      DATA (WTAB(I),I=1,NPOINT)/   &
+     0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,   &
+     0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,   &
+     0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,   &
+     0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,   &
+     0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,   &
+     0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,   &
+     0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,   &
+     0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,   &
+     0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,   &
+     0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,   &
+     0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,   &
+     0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,   &
+     0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,   &
+     0.99908,0.99927,0.99945,0.99963,0.99982/
+      DATA (CPHTAB(I),I=1,NPOINT)/   &
+      17.996, 17.896, 17.875, 17.858, 17.840, 17.820, 17.800, 17.791,   &
+      17.783, 17.777, 17.771, 17.769, 17.806, 17.891, 18.057, 18.248,   &
+      18.429, 18.567, 18.613, 18.640, 18.660, 18.660, 18.642, 18.592,   &
+      18.544, 18.468, 18.348, 18.187, 17.995, 17.782, 17.562, 17.352,   &
+      17.162, 16.993, 16.829, 16.657, 16.581, 16.497, 16.405, 16.302,   &
+      16.186, 16.053, 15.901, 15.730, 15.540, 15.329, 15.101, 14.853,   &
+      14.586, 14.296, 13.980, 13.638, 13.274, 12.896, 12.507, 12.111,   &
+      11.911, 11.711, 11.514, 11.320, 11.130, 10.940, 10.760, 10.570,   &
+      10.390, 10.200, 10.000, 9.8400, 9.7600, 9.7900, 9.9500, 10.310,   &
+      10.950, 11.960, 13.370, 15.060, 16.860, 18.550, 20.000, 21.170,   &
+      22.030, 22.570, 22.800, 22.750, 22.420, 21.850, 21.120, 20.280,   &
+      19.360, 18.350, 17.220, 15.940, 14.490, 12.840, 10.800, 9.8000,   &
+      7.8000, 3.8000,0.20000,-5.4000,-7.0000,-8.8000,-10.900,-13.500,   &
+     -17.000,-22.000,-29.000,-40.000,-59.000/
+      DATA FIRST/.TRUE./
+      SAVE FIRST,WTAB,CPHTAB,Y2
+!
+      IF(FIRST) THEN
+          FIRST=.FALSE.
+          CALL SPLINE(WTAB,CPHTAB,NPOINT,YWORK,Y2)
+      ENDIF
+
+      if(khi_in.GT.NPOINT) then
+         khi=NPOINT
+         klo=NPOINT-1
+      else
+         khi=khi_in
+         klo=klo_in
+      endif
+
+      CALL SPLINT(WTAB(khi),WTAB(klo),CPHTAB(khi),CPHTAB(klo),Y2(khi),Y2(klo),W,CPH)
+      CPH2O=CPH
+      
+      END FUNCTION CPH2O
+
+
+!*******************************************************************************
+REAL FUNCTION FFH2O(W,khi,klo)
+
+!     Relative partial molal free energy water (cal/mole) in 
+!     sulfuric acid solution, as a function of H2SO4 weight fraction [0;1],
+!     calculated by cubic spline fitting.
+
+!     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
+
+      IMPLICIT NONE
+
+      INTEGER :: NPOINT,I
+      PARAMETER(NPOINT=110)
+      REAL, DIMENSION(NPOINT) :: WTAB,FFTAB,Y2,YWORK
+      REAL, INTENT(IN) :: W
+      INTEGER, INTENT(IN):: khi,klo
+      REAL :: FF
+      LOGICAL :: FIRST
+      DATA (WTAB(I),I=1,NPOINT)/   &
+     0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,   &
+     0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,   &
+     0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,   &
+     0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,   &
+     0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,   &
+     0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,   &
+     0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,   &
+     0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,   &
+     0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,   &
+     0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,   &
+     0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,   &
+     0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,   &
+     0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,   &
+     0.99908,0.99927,0.99945,0.99963,0.99982, 1.0000/
+      DATA (FFTAB(I),I=1,NPOINT)/   &
+     0.00000, 22.840, 25.810, 29.250, 33.790, 39.970, 48.690, 54.560,   &
+      61.990, 71.790, 85.040, 103.70, 130.70, 145.20, 163.00, 184.50,   &
+      211.50, 245.60, 266.40, 290.10, 317.40, 349.00, 385.60, 428.40,   &
+      452.50, 478.80, 507.50, 538.80, 573.30, 611.60, 653.70, 700.50,   &
+      752.60, 810.60, 875.60, 948.60, 980.60, 1014.3, 1049.7, 1087.1,   &
+      1126.7, 1168.7, 1213.5, 1261.2, 1312.0, 1366.2, 1424.3, 1486.0,   &
+      1551.8, 1622.3, 1697.8, 1778.5, 1864.9, 1956.8, 2055.8, 2162.0,   &
+      2218.0, 2276.0, 2337.0, 2400.0, 2466.0, 2535.0, 2607.0, 2682.0,   &
+      2760.0, 2842.0, 2928.0, 3018.0, 3111.0, 3209.0, 3311.0, 3417.0,   &
+      3527.0, 3640.0, 3757.0, 3878.0, 4002.0, 4130.0, 4262.0, 4397.0,   &
+      4535.0, 4678.0, 4824.0, 4973.0, 5128.0, 5287.0, 5454.0, 5630.0,   &
+      5820.0, 6031.0, 6268.0, 6541.0, 6873.0, 7318.0, 8054.0, 8284.0,   &
+      8579.0, 8997.0, 9295.0, 9720.0, 9831.0, 9954.0, 10092., 10248.,   &
+      10423., 10618., 10838., 11099., 11460., 12014./
+      DATA FIRST/.TRUE./
+      SAVE FIRST,WTAB,FFTAB,Y2
+!
+      IF(FIRST) THEN
+          FIRST=.FALSE.
+          CALL SPLINE(WTAB,FFTAB,NPOINT,YWORK,Y2)
+      ENDIF
+
+      CALL SPLINT(WTAB(khi),WTAB(klo),FFTAB(khi),FFTAB(klo),Y2(khi),Y2(klo),W,FF)
+      FFH2O=FF
+      
+      END FUNCTION FFH2O
+
+
+!*******************************************************************************
+REAL FUNCTION LH2O(W,khi,klo)
+  
+!     Relative partial molal heat content of water (cal/mole) in 
+!     sulfuric acid solution, as a function of H2SO4 weight fraction [0;1],
+!     calculated by cubic spline fitting.
+
+!     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
+
+      IMPLICIT NONE
+
+      INTEGER :: NPOINT,I
+      PARAMETER(NPOINT=110)
+      REAL, DIMENSION(NPOINT) ::  WTAB,LTAB,Y2,YWORK
+      REAL, INTENT(IN) :: W
+      INTEGER, INTENT(IN):: khi,klo
+      REAL :: L
+      LOGICAL :: FIRST
+      DATA (WTAB(I),I=1,NPOINT)/   &
+     0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,   &
+     0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,   &
+     0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,   &
+     0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,   &
+     0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,   &
+     0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,   &
+     0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,   &
+     0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,   &
+     0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,   &
+     0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,   &
+     0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,   &
+     0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,   &
+     0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,   &
+     0.99908,0.99927,0.99945,0.99963,0.99982, 1.0000/
+      DATA (LTAB(I),I=1,NPOINT)/   &
+     0.00000, 5.2900, 6.1000, 7.1800, 8.7800, 11.210, 15.290, 18.680,   &
+      23.700, 31.180, 42.500, 59.900, 89.200, 106.70, 128.60, 156.00,   &
+      190.40, 233.80, 260.10, 290.00, 324.00, 362.50, 406.50, 456.10,   &
+      483.20, 512.40, 543.60, 577.40, 613.80, 653.50, 696.70, 744.50,   &
+      797.20, 855.80, 921.70, 995.70, 1028.1, 1062.3, 1098.3, 1136.4,   &
+      1176.7, 1219.3, 1264.7, 1313.0, 1364.3, 1418.9, 1477.3, 1539.9,   &
+      1607.2, 1679.7, 1757.9, 1842.7, 1934.8, 2035.4, 2145.5, 2267.0,   &
+      2332.0, 2401.0, 2473.0, 2550.0, 2631.0, 2716.0, 2807.0, 2904.0,   &
+      3007.0, 3118.0, 3238.0, 3367.0, 3507.0, 3657.0, 3821.0, 3997.0,   &
+      4186.0, 4387.0, 4599.0, 4819.0, 5039.0, 5258.0, 5476.0, 5694.0,   &
+      5906.0, 6103.0, 6275.0, 6434.0, 6592.0, 6743.0, 6880.0, 7008.0,   &
+      7133.0, 7255.0, 7376.0, 7497.0, 7618.0, 7739.0, 7855.0, 7876.0,   &
+      7905.0, 7985.0, 8110.0, 8415.0, 8515.0, 8655.0, 8835.0, 9125.0,   &
+      9575.0, 10325., 11575., 13500., 15200., 16125./
+      DATA FIRST/.TRUE./
+      SAVE FIRST,WTAB,LTAB,Y2
+!
+      IF(FIRST) THEN
+          FIRST=.FALSE.
+          CALL SPLINE(WTAB,LTAB,NPOINT,YWORK,Y2)
+      ENDIF
+
+      CALL SPLINT(WTAB(khi),WTAB(klo),LTAB(khi),LTAB(klo),Y2(khi),Y2(klo),W,L)
+      LH2O=L
+      
+      END FUNCTION LH2O
+
+
+!*******************************************************************************
+REAL FUNCTION ALH2O(W,khi_in,klo_in)
+
+!     Relative partial molal temperature derivative of heat capacity (water) 
+!     in sulfuric acid solution, (cal/deg**2), calculated by 
+!     cubic spline fitting.
+
+!     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
+
+      IMPLICIT NONE
+
+      INTEGER :: NPOINT,I
+      PARAMETER(NPOINT=96)
+      REAL, DIMENSION(NPOINT) :: WTAB,ATAB,Y2,YWORK
+      REAL, INTENT(IN) :: W
+      INTEGER, INTENT(IN):: khi_in,klo_in
+      INTEGER :: khi,klo
+      REAL :: A
+      LOGICAL :: FIRST
+      DATA (WTAB(I),I=1,NPOINT)/   &
+     0.29517,0.31209,                                                   &
+     0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,   &
+     0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,   &
+     0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,   &
+     0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,   &
+     0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,   &
+     0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,   &
+     0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,   &
+     0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,   &
+     0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,   &
+     0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,   &
+     0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,   &
+     0.99908,0.99927,0.99945,0.99963,0.99982, 1.0000/
+      DATA (ATAB(I),I=1,NPOINT)/   &
+      0.0190, 0.0182, 0.0180, 0.0177, 0.0174, 0.0169, 0.0167, 0.0164,   &
+      0.0172, 0.0212, 0.0239, 0.0264, 0.0276, 0.0273, 0.0259, 0.0238,   &
+      0.0213, 0.0190, 0.0170, 0.0155, 0.0143, 0.0133, 0.0129, 0.0124,   &
+      0.0120, 0.0114, 0.0106, 0.0097, 0.0084, 0.0067, 0.0047, 0.0024,   &
+     -0.0002,-0.0031,-0.0063,-0.0097,-0.0136,-0.0178,-0.0221,-0.0263,   &
+     -0.0303,-0.0340,-0.0352,-0.0360,-0.0362,-0.0356,-0.0343,-0.0321,   &
+     -0.0290,-0.0251,-0.0201,-0.0137,-0.0058, 0.0033, 0.0136, 0.0254,   &
+      0.0388, 0.0550, 0.0738, 0.0962, 0.1198, 0.1300, 0.1208, 0.0790,   &
+      0.0348, 0.0058,-0.0102,-0.0211,-0.0292,-0.0350,-0.0390,-0.0418,   &
+     -0.0432,-0.0436,-0.0429,-0.0411,-0.0384,-0.0346,-0.0292,-0.0220,   &
+     -0.0130,-0.0110,-0.0080,-0.0060,-0.0040,-0.0030,-0.0030,-0.0020,   &
+     -0.0020,-0.0020,-0.0020,-0.0010,-0.0010, 0.0000, 0.0000, 0.0000/
+      DATA FIRST/.TRUE./
+      SAVE FIRST,WTAB,ATAB,Y2
+!
+      IF(FIRST) THEN
+          FIRST=.FALSE.
+          CALL SPLINE(WTAB,ATAB,NPOINT,YWORK,Y2)
+      ENDIF
+
+      if(klo_in.LT.15) then
+         khi=2
+         klo=1
+      else
+         khi=khi_in-14
+         klo=klo_in-14
+      endif
+
+      CALL SPLINT(WTAB(khi),WTAB(klo),ATAB(khi),ATAB(klo),Y2(khi),Y2(klo),W,A)
+      ALH2O=A
+      
+      END FUNCTION ALH2O
+
+!******************************************************************************
+SUBROUTINE SPLINE(X,Y,N,WORK,Y2)
+
+!     Routine to calculate 2.nd derivatives of tabulated function
+!     Y(i)=Y(Xi), to be used for cubic spline calculation.
+
+  IMPLICIT NONE
+
+  INTEGER N,I
+  REAL,intent(in) ::  X(N),Y(N)
+  REAL,intent(out) :: WORK(N),Y2(N)
+  REAL :: SIG,P,QN,UN,YP1,YPN
+
+  YP1=(Y(2)-Y(1))/(X(2)-X(1))
+  YPN=(Y(N)-Y(N-1))/(X(N)-X(N-1))
+
+  IF(YP1.GT.99.0D+30) THEN
+     Y2(1)=0.0
+     WORK(1)=0.0
+  ELSE
+     Y2(1)=-0.5D0
+     WORK(1)=(3.0D0/(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1)
+  ENDIF
+
+  DO I=2,N-1
+     SIG=(X(I)-X(I-1))/(X(I+1)-X(I-1))
+     P=SIG*Y2(I-1)+2.0D0
+     Y2(I)=(SIG-1.0D0)/P
+     WORK(I)=(6.0D0*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1)) &
+     &  /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*WORK(I-1))/P
+  ENDDO
+
+  IF(YPN.GT.99.0D+30) THEN
+     QN=0.0
+     UN=0.0
+  ELSE
+     QN=0.5D0
+     UN=(3.0D0/(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1)))
+  ENDIF
+
+  Y2(N)=(UN-QN*WORK(N-1))/(QN*Y2(N-1)+1.0D0)
+
+  DO I=N-1,1,-1
+     Y2(I)=Y2(I)*Y2(I+1)+WORK(I)
+  ENDDO
+  
+  RETURN
+END SUBROUTINE SPLINE
+
+
+!******************************************************************************
+     SUBROUTINE SPLINT(XAhi,XAlo,YAhi,YAlo,Y2Ahi,Y2Alo,X,Y)
+
+!     Cubic spline calculation
+
+      IMPLICIT NONE
+
+      REAL, INTENT(IN) :: XAhi,XAlo,YAhi,YAlo,Y2Ahi,Y2Alo
+      REAL, INTENT(IN) :: X
+      REAL, INTENT(OUT) :: Y
+      REAL :: H,A,B
+!
+      H=XAhi-XAlo
+      A=(XAhi-X)/H
+      B=(X-XAlo)/H
+      Y=A*YAlo+B*YAhi+((A**3-A)*Y2Alo+(B**3-B)*Y2Ahi)*(H**2)/6.0d0
+!
+
+      END SUBROUTINE SPLINT
Index: /trunk/LMDZ.VENUS/libf/phyvenus/conf_phys.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/conf_phys.F90	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/conf_phys.F90	(revision 1661)
@@ -334,4 +334,16 @@
   ok_cloud = .FALSE.
   call getin('ok_cloud',ok_cloud)
+
+!
+!Config Key  = cl_scheme
+!Config Desc =
+!Config Def  = 2
+!Config Help =
+!
+! 1   = Simple microphysics (Aurelien Stolzenbach's PhD)
+! 2   = Full microphysics (momentum scheme, Sabrina Guilbon's PhD)
+
+  cl_scheme = 2
+  call getin('cl_scheme',cl_scheme)
 
 !
Index: /trunk/LMDZ.VENUS/libf/phyvenus/ini_histins.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/ini_histins.h	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/ini_histins.h	(revision 1661)
@@ -141,5 +141,5 @@
      .                "ins(X)", zsto,zout)
 c
-          if (ok_cloud) THEN
+          if (ok_cloud.and.(cl_scheme.eq.1)) THEN
 
           if (nb_mode.GE.1) THEN 
@@ -235,5 +235,5 @@
 		ENDIF
 		
-          if (ok_sedim) THEN
+          if (ok_sedim.and.(cl_scheme.eq.1)) THEN
 c
          CALL histdef(nid_ins, "d_tr_sed_H2SO4", "var mmr from sedim",
@@ -257,4 +257,5 @@
 c
 		ENDIF
+
       ENDIF !lev_histins.GE.2
 c
Index: /trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_venus.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_venus.F	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_venus.F	(revision 1661)
@@ -34,5 +34,5 @@
 !----------------------------------------------------------------------------
 !     Thermodynamic functions:
-      REAL :: RHODROPLET
+      REAL :: ROSAS
 !----------------------------------------------------------------------------
 !     Auxilary variables:
@@ -134,6 +134,5 @@
      &    mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),NBROOT)
 
-          rho_droplet(ilon,ilev)=RHODROPLET(WH2SO4(ilon,ilev),
-     &    TT(ilon,ilev))
+          rho_droplet(ilon,ilev)=ROSAS(TT(ilon,ilev),WH2SO4(ilon,ilev))
 
 !          IF (rho_droplet(ilon,ilev).LT.1100.) THEN
@@ -141,6 +140,5 @@
 !            PRINT*,'rho_droplet',rho_droplet(ilon,ilev)
 !            PRINT*,'T',TT(ilon,ilev),'WSA',WH2SO4(ilon,ilev)
-!            PRINT*,'RHODROPLET',RHODROPLET(WH2SO4(ilon,ilev),
-!     &      TT(ilon,ilev))
+!            PRINT*,'RHODROPLET',ROSAS(TT(ilon,ilev),WH2SO4(ilon,ilev))
 !            PRINT*,'FLAG',FLAG,'NROOT',NBROOT
 !            STOP
@@ -204,6 +202,5 @@
           WH2SO4(ilon,ilev)=WSAFLAG
 
-          rho_droplet(ilon,ilev)=RHODROPLET(WH2SO4(ilon,ilev),
-     &    TT(ilon,ilev))
+          rho_droplet(ilon,ilev)=ROSAS(TT(ilon,ilev),WH2SO4(ilon,ilev))
 
 !     ATTENTION ce IF ne sert a rien en fait, juste a retenir une situation
@@ -211,5 +208,5 @@
 !     incoherentes avec TT et WH2SO4 (a priori lorsque NTOT=0)
 !     Juste le fait de METTRE un IF fait que rho_droplet a la bonne valeur
-!     donne par RHODROPLET (cf test externe en Python), sinon, la valeur est trop
+!     donne par ROSAS (cf test externe en Python), sinon, la valeur est trop
 !     basse (de l'ordre de 1000 kg/m3) et correspond parfois a la valeur avec
 !     WSA=0.1 (pas totalement sur)
@@ -223,6 +220,5 @@
             PRINT*,'rho_droplet',rho_droplet(ilon,ilev)
             PRINT*,'T',TT(ilon,ilev),'WSA',WH2SO4(ilon,ilev)
-            PRINT*,'RHODROPLET',RHODROPLET(WH2SO4(ilon,ilev),
-     &      TT(ilon,ilev))
+            PRINT*,'RHODROPLET',ROSAS(TT(ilon,ilev),WH2SO4(ilon,ilev))
             PRINT*,'FLAG',FLAG,'NROOT',NBROOT
             STOP
@@ -298,1187 +294,4 @@
 
 
-!*****************************************************************************
-!*    SUBROUTINE ITERWV()
-      SUBROUTINE ITERWV(WV,WVLIQ,WVEQOUT,WVTOT,WSAOUT,SATOT,
-     + TAIR,PAIR,RADIUS)
-!*****************************************************************************
-!* Cette routine est la solution par iteration afin de trouver WSA pour un WV,
-!* et donc LPPWV, donne. Ce qui nous donne egalement le WV correspondant au
-!* WSA solution
-!* For VenusGCM by A. Stolzenbach 07/2014
-!* OUTPUT: WVEQ et WSAOUT
-
-      IMPLICIT NONE
-      REAL, INTENT(IN) :: WV, WVTOT, SATOT, TAIR, PAIR, RADIUS
-
-      REAl, INTENT(OUT) :: WVEQOUT, WSAOUT, WVLIQ
-
-      REAL :: WSAMIN, WSAMAX, WSAACC
-      PARAMETER(WSAACC=0.01)
-
-      REAL :: LPPWV
-
-      INTEGER :: MAXITSA, NBRACSA, NBROOT
-      PARAMETER(MAXITSA=20)
-      PARAMETER(NBRACSA=5)
-
-      LOGICAl :: FLAG1,FLAG2
-
-!     External Function
-      REAl :: IRFRMSA, WVCOND
-
-      IF (RADIUS.LT.1E-30) THEN
-        PRINT*,'RMODE == 0 FLAG 3'
-        STOP
-      ENDIF
-!     Initialisation WSA=[0.1,1.0]
-      WSAMIN=0.1
-      WSAMAX=1.0
-
-      LPPWV=DLOG(PAIR*WV)
-
-!     Appel Bracket de KEEQ
-      CALL BRACWSA(WSAMIN,WSAMAX,NBRACSA,RADIUS,TAIR,
-     &     LPPWV,FLAG1,FLAG2,NBROOT)
-
-      IF ((.NOT.FLAG1).AND.(.NOT.FLAG2).AND.(NBROOT.EQ.1)) THEN
-!          Appel Ridder's Method
-
-        WSAOUT=IRFRMSA(WSAMIN,WSAMAX,WSAACC,MAXITSA,
-     &  RADIUS,TAIR,PAIR,LPPWV,NBROOT)
-!              IF (WSAOUT.EQ.1.0) WSAOUT=0.999999
-!              IF (WSAOUT.LT.0.1) WSAOUT=0.1
-
-!       Si BRACWSA ne trouve aucun ensemble solution KEEQ=0 on fixe WSA a 0.9999 ou 0.1
-      ELSE
-        IF (FLAG1.AND.(.NOT.FLAG2)) WSAOUT=0.999999
-        IF (FLAG2.AND.(.NOT.FLAG1)) WSAOUT=WSAMIN
-        IF (FLAG1.AND.FLAG2) THEN
-          PRINT*,'FLAGs BRACWSA tous TRUE'
-          STOP
-        ENDIF
-      ENDIF
-
-
-!     WVEQ output correspondant a WVliq lie a WSA calcule
-      WVLIQ=WVCOND(WSAOUT,TAIR,PAIR,SATOT)
-      WVEQOUT=(WVLIQ+WV)/WVTOT-1.0
-
-      END SUBROUTINE ITERWV
-
-
-!*****************************************************************************
-!*    SUBROUTINE BRACWV()
-      SUBROUTINE BRACWV(XA,XB,N,RADIUS,WVTOT,SATOT,TAIR,PAIR,
-     +           FLAGWV,WSAFLAG,NROOT)
-!*****************************************************************************
-!* Bracket de ITERWV
-!* From Numerical Recipes
-!* Adapted for VenusGCM A. Stolzenbach 07/2014
-!* X est WVinput
-!* OUTPUT: XA et XB
-
-      IMPLICIT NONE
-
-      REAL, INTENT(IN) :: WVTOT,SATOT,RADIUS,TAIR,PAIR
-      INTEGER, INTENT(IN) :: N
-
-      REAL, INTENT(INOUT) :: XA,XB
-      REAL, INTENT(OUT) :: WSAFLAG
-
-      INTEGER :: I,J
-
-      INTEGER, INTENT(OUT) :: NROOT
-
-      REAL :: FP, FC, X, WVEQ, WVLIQ, WSAOUT
-      REAL :: XMAX,XMIN,WVEQACC
-
-      INTEGER, INTENT(OUT) :: FLAGWV
-
-!     WVEQACC est le seuil auquel on accorde un WSA correct meme
-!     si il ne fait pas partie d'une borne. Utile quand le modele
-!     s'approche de 0 mais ne l'atteint pas.
-      WVEQACC=1.0E-3
-
-      FLAGWV=1
-
-      NROOT=0
-
-!     25/11/2016
-!     On change ordre on va du max au min
-      X=XB
-      XMAX=XB
-      XMIN=XA
-
-!     CAS 1 On borne la fonction (WVEQ=0)
-
-      CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,TAIR,PAIR,RADIUS)
-      FP=WVEQ
-
-      DO I=N-1,1,-1
-         X=(1.-DLOG(REAL(N-I))/DLOG(REAL(N)))*XMAX
-         CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,TAIR,PAIR,RADIUS)
-         FC=WVEQ
-
-          IF ((FP*FC).LT.0.0) THEN
-            NROOT=NROOT+1
-!           Si NROOT>1 on place la borne sup output  la borne min du calcul en i
-            IF (NROOT.GT.1) THEN
-               XB=(1.-DLOG(REAL(I+1))/DLOG(REAL(N)))*XMAX
-            ENDIF
-
-            IF (I.EQ.1) THEN
-              XA=XMIN
-            ELSE
-              XA=X
-            ENDIF
-            RETURN
-         ENDIF
-         FP=FC
-      ENDDO
-
-!     CAS 2 on refait la boucle pour tester si WVEQ est proche de 0
-!     avec le seuil WVEQACC
-      IF (NROOT.EQ.0) THEN
-         X=XMAX
-         CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,
-     +   TAIR,PAIR,RADIUS)
-          DO J=N-1,1,-1
-             X=(1.-DLOG(REAL(N-J))/DLOG(REAL(N)))*XMAX
-             CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,
-     +       TAIR,PAIR,RADIUS)
-
-             IF (ABS(WVEQ).LE.WVEQACC) THEN
-                WSAFLAG=WSAOUT
-                FLAGWV=2
-                RETURN
-             ENDIF
-          ENDDO
-
-!     CAS 3 Pas de borne, WVEQ jamais proche de 0
-          FLAGWV=3
-          RETURN
-       ENDIF
-
-      END SUBROUTINE BRACWV
-
-!*****************************************************************************
-!*    SUBROUTINE BRACWSA()
-      SUBROUTINE BRACWSA(XA,XB,N,RADIUS,TAIR,LPPWVINP,FLAGH,FLAGL,
-     +           NROOT)
-!*****************************************************************************
-!* Bracket de KEEQ
-!* From Numerical Recipes
-!* Adapted for VenusGCM A. Stolzenbach 07/2014
-
-      IMPLICIT NONE
-
-!----------------------------------------------------------------------------
-!     External functions needed:
-      REAl KEEQ
-!----------------------------------------------------------------------------
-
-      REAL, INTENT(IN) :: RADIUS,TAIR,LPPWVINP
-      INTEGER, INTENT(IN) :: N
-
-      REAL, INTENT(INOUT) :: XA,XB
-
-      INTEGER, INTENT(OUT) ::  NROOT
-
-      INTEGER :: I, J
-
-      REAL :: DX, FP, FC, X
-
-      LOGICAL, INTENT(OUT) :: FLAGH,FLAGL
-
-
-      FLAGL=.FALSE.
-      FLAGH=.FALSE.
-      NROOT=0
-      DX=(XB-XA)/N
-      X=XB
-      FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
-
-      DO I=N,1,-1
-         X=X-DX
-         FC=KEEQ(RADIUS,TAIR,X,LPPWVINP)
-
-         IF ((FP*FC).LE.0.) THEN
-            NROOT=NROOT+1
-            XA=X
-            XB=X+DX
-            RETURN
-!            IF (NROOT.GT.1) THEN
-!               PRINT*,'On a plus d1 intervalle KEEQ=0'
-!               PRINT*,'Probleme KEEQ=0 => 1 racine en theorie'
-!               X=X-(I*DX)
-!               FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
-!               PRINT*,'KEEQ(WSA)',FP,X,TAIR
-!               DO J=1,N
-!                 X=X+DX
-!                FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
-!                PRINT*,'KEEQ(WSA)',FP,X
-!               ENDDO
-!               STOP
-!            ENDIF
-         ENDIF
-
-         FP=FC
-      ENDDO
-
-      IF (NROOT.EQ.0) THEN
-!         PRINT*,'On a 0 intervalle KEEQ=0'
-!         PRINT*,'Probleme KEEQ=0 => 1 racine en theorie'
-!         PRINT*,'XA',XA,'KEEQ',KEEQ(RADIUS,TAIR,XA,LPPWVINP)
-!         PRINT*,'XB',XB,'KEEQ',KEEQ(RADIUS,TAIR,XB,LPPWVINP)
-!         PRINT*,'TT',TAIR
-!         PRINT*,'RADIUS',RADIUS
-!         PRINT*,'NBRAC',N
-!         STOP
-
-!         X=XA
-!         FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
-!         PRINT*,'KEEQ(WSA)',FP,X,TAIR
-!         DO I=1,N
-!           X=X+DX
-!           FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
-!           PRINT*,'KEEQ(WSA)',FP,X,TAIR
-!         ENDDO
-
-
-!        Test determine la tendance globale KEEQ sur [WSAMIN,WSAMAX]
-         IF ((ABS(KEEQ(RADIUS,TAIR,XA,LPPWVINP))-
-     &    ABS(KEEQ(RADIUS,TAIR,XB,LPPWVINP))).GT.0.0) FLAGH=.TRUE.
-!        On fixe flag low TRUE pour WSA = 0.1
-         IF ((ABS(KEEQ(RADIUS,TAIR,XA,LPPWVINP))-
-     &    ABS(KEEQ(RADIUS,TAIR,XB,LPPWVINP))).LT.0.0) FLAGL=.TRUE.
-!        STOP
-      ENDIF
-
-      END SUBROUTINE BRACWSA
-
-
-!*****************************************************************************
-!*     REAL FUNCTION WVCOND()
-      REAL FUNCTION WVCOND(WSA,T,P,SAt)
-!*****************************************************************************
-!* Condensation de H2O selon WSA, T et P et H2SO4tot
-!*
-!* Adapted for VenusGCM A. Stolzenbach 07/2014
-!     INPUT:
-!     SAt  : VMR of total H2SO4
-!     WSA: aerosol H2SO4 weight fraction (fraction)
-!     T: temperature (K)
-!     P: pressure (Pa)
-!     OUTPUT:
-!	WVCOND : VMR H2O condense
-
-!      USE chemparam_mod
-
-      IMPLICIT NONE
-
-      REAL, INTENT(IN) :: SAt, WSA
-      REAL, INTENT(IN) :: T, P
-
-!     working variables
-      REAL SA, WV
-      REAL  DND2,pstand,lpar,acidps
-      REAL  x1, satpacid
-      REAL , DIMENSION(2):: act
-      REAL  CONCM
-      REAL  NH2SO4
-      REAL  H2OCOND, H2SO4COND
-
-
-      CONCM= (P)/(1.3806488E-23*T) !air number density, molec/m3? CHECK UNITS!
-
-	NH2SO4=SAt*CONCM
-
-      pstand=1.01325E+5 !Pa  1 atm pressure
-
-        x1=(WSA/98.08)/(WSA/98.08 + ((1.-WSA)/18.0153))
-
-        CALL zeleznik(x1,T,act)
-
-!pure acid satur vapor pressure
-        lpar= -11.695+DLOG(pstand) ! Zeleznik
-        acidps=1/360.15-1.0/T+0.38/545.
-     & *(1.0+DLOG(360.15/T)-360.15/T)
-        acidps = 10156.0*acidps +lpar
-        acidps = DEXP(acidps)    !Pa
-
-!acid sat.vap.PP over mixture (flat surface):
-        satpacid=act(2)*acidps ! Pa
-
-!       Conversion from Pa to N.D #/m3
-        DND2=satpacid/(1.3806488E-23*T)
-
-!	H2SO4COND N.D #/m3 condensee ssi H2SO4>H2SO4sat
-	IF (NH2SO4.GT.DND2) THEN
-	H2SO4COND=NH2SO4-DND2
-!	calcul de H2O cond correspondant a H2SO4 cond
-	H2OCOND=H2SO4COND*98.078*(1.0-WSA)/(18.0153*WSA)
-
-!	Si on a H2SO4<H2SO4sat on ne condense rien, VMR = 1.0E-30
-	ELSE
-	H2OCOND=1.0E-30*CONCM
-	END IF
-
-!*****************************************************
-!     ATTENTION: Ici on ne prends pas en compte
-!                si H2O en defaut!
-!                On veut la situation theorique
-!                a l'equilibre
-!*****************************************************
-!	Test si H2O en defaut H2Ocond>H2O dispo
-!	IF ((H2OCOND.GT.NH2O).AND.(NH2SO4.GE.DND2)) THEN
-
-!	On peut alors condenser tout le H2O dispo
-!	H2OCOND=NH2O
-!	On met alors egalement a jour le H2SO4 cond correspondant au H2O cond
-!	H2SO4COND=H2OCOND*18.0153*WSA/(98.078*(1.0-WSA))
-
-!      END IF
-
-!     Calcul de H2O condense VMR
-      WVCOND=H2OCOND/CONCM
-
-      END FUNCTION WVCOND
-
-!*****************************************************************************
-!*     REAL FUNCTION IRFRMWV()
-      REAL	FUNCTION IRFRMWV(X1,X2,XACC,MAXIT,RADIUS,TAIR,PAIR,
-     + WVTOT,SATOT,NROOT)
-!*****************************************************************************
-!* Iterative Root Finder Ridder's Method for Water Vapor calculus
-!* From Numerical Recipes
-!* Adapted for VenusGCM A. Stolzenbach 07/2014
-!*
-!* Les iterations sur [X1,X2] sont [WV1,WV2]
-!* la variable X est WV
-!* IRFRMWV sort en OUTPUT : WSALOC pour ITERWV=0 (ou WVEQ=0)
-
-      IMPLICIT NONE
-
-      REAL, INTENT(IN) ::    X1, X2
-      REAL, INTENT(IN) ::    XACC
-      INTEGER, INTENT(IN) :: MAXIT,NROOT
-
-!     LOCAL VARIABLES
-      REAL :: XL, XH, XM, XNEW, X
-      REAL :: WSALOC, WVEQ, WVLIQ
-      REAL :: FL, FH, FM, FNEW
-      REAL :: ANS, S, FSIGN
-      INTEGER i
-
-!     External variables needed:
-      REAL, INTENT(IN) :: TAIR,PAIR
-      REAL, INTENT(IN) :: WVTOT,SATOT
-      REAL, INTENT(IN) :: RADIUS
-
-
-!     Initialisation
-      X=X1
-      CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,TAIR,PAIR,RADIUS)
-      FL=WVEQ
-      X=X2
-      CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,TAIR,PAIR,RADIUS)
-      FH=WVEQ
-
-!     Test Bracketed values
-      IF (((FL.LT.0.).AND.(FH.GT.0.)).OR.
-     &   ((FL.GT.0.).AND.(FH.LT.0.)))
-     &  THEN
-         XL=X1
-         XH=X2
-         ANS=-9.99e99
-
-         DO i=1, MAXIT
-            XM=0.5*(XL+XH)
-            CALL ITERWV(XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
-     &       TAIR,PAIR,RADIUS)
-            FM=WVEQ
-            S=SQRT(FM*FM-FL*FH)
-
-            IF (S.EQ.0.0) THEN
-               IRFRMWV=WSALOC
-               RETURN
-            ENDIF
-
-            IF (FL.GT.FH) THEN
-               FSIGN=1.0
-            ELSE
-               FSIGN=-1.0
-            ENDIF
-
-            XNEW=XM+(XM-XL)*(FSIGN*FM/S)
-
-            IF (ABS(XNEW-ANS).LE.XACC) THEN
-               IRFRMWV=WSALOC
-               RETURN
-            ENDIF
-
-            ANS=XNEW
-            CALL ITERWV(ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
-     &       TAIR,PAIR,RADIUS)
-            FNEW=WVEQ
-
-            IF (FNEW.EQ.0.0) THEN
-               IRFRMWV=WSALOC
-               RETURN
-            ENDIF
-
-            IF (SIGN(FM, FNEW).NE.FM) THEN
-               XL=XM
-               FL=FM
-               XH=ANS
-               FH=FNEW
-               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
-                  XH=ANS
-                  FH=FNEW
-               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
-                  XL=ANS
-                  FL=FNEW
-               ELSE
-                  PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
-                  PRINT*,'you shall not PAAAAAASS'
-                  STOP
-            ENDIF
-         ENDDO
-         PRINT*,'Paaaaas bien MAXIT atteint'
-         PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
-         PRINT*,'you shall not PAAAAAASS'
-         XL=X1
-         XH=X2
-         ANS=-9.99e99
-
-         DO i=1, MAXIT
-            XM=0.5*(XL+XH)
-            CALL ITERWV(XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
-     &       TAIR,PAIR,RADIUS)
-            FM=WVEQ
-            S=SQRT(FM*FM-FL*FH)
-            IF (FL.GT.FH) THEN
-               FSIGN=1.0
-            ELSE
-               FSIGN=-1.0
-            ENDIF
-
-            XNEW=XM+(XM-XL)*(FSIGN*FM/S)
-
-            ANS=XNEW
-            CALL ITERWV(ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
-     &       TAIR,PAIR,RADIUS)
-            FNEW=WVEQ
-            PRINT*,'WVliq',WVLIQ,'WVtot',WVTOT,'WVeq',WVEQ
-            PRINT*,'WSA',WSALOC,'SAtot',SATOT
-            PRINT*,'T',TAIR,'P',PAIR
-
-            IF (SIGN(FM, FNEW).NE.FM) THEN
-               XL=XM
-               FL=FM
-               XH=ANS
-               FH=FNEW
-               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
-                  XH=ANS
-                  FH=FNEW
-               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
-                  XL=ANS
-                  FL=FNEW
-               ELSE
-                  PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
-                  PRINT*,'you shall not PAAAAAASS TWIIICE???'
-                  STOP
-            ENDIF
-         ENDDO
-         STOP
-      ELSE
-         PRINT*,'IRFRMWV must be bracketed'
-         PRINT*,'NROOT de BRACWV', NROOT
-         IF (ABS(FL).LT.XACC) THEN
-         PRINT*,'IRFRMWV FL == 0',FL
-         PRINT*,'X1',X1,'X2',X2,'FH',FH
-           CALL ITERWV(X1,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
-     &      TAIR,PAIR,RADIUS)
-           IRFRMWV=WSALOC
-         RETURN
-         ENDIF
-         IF (ABS(FH).LT.XACC) THEN
-         PRINT*,'IRFRMWV FH == 0',FH
-         PRINT*,'X1',X1,'X2',X2,'FL',FL
-           CALL ITERWV(X2,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
-     &      TAIR,PAIR,RADIUS)
-           IRFRMWV=WSALOC
-         RETURN
-         ENDIF
-         IF ((ABS(FL).GT.XACC).AND.(ABS(FH).GT.XACC)) THEN
-           PRINT*,'STOP dans IRFRMWV avec rien == 0'
-           PRINT*,'X1',X1,'X2',X2
-           PRINT*,'Fcalc',FL,FH
-           PRINT*,'T',TAIR,'P',PAIR,'R',RADIUS
-           STOP
-         ENDIF
-         IF ((ABS(FL).LT.XACC).AND.(ABS(FH).LT.XACC)) THEN
-           PRINT*,'STOP dans IRFRMWV Trop de solution < WVACC'
-           PRINT*,FL,FH
-           STOP
-         ENDIF
-
-
-      ENDIF
-!  FIN Test Bracketed values
-
-      END FUNCTION IRFRMWV
-
-!*****************************************************************************
-!*     REAL FUNCTION IRFRMSA()
-      REAL	FUNCTION IRFRMSA(X1,X2,XACC,MAXIT,RADIUS,TAIR,PAIR,LPPWV,
-     +               NB)
-!*****************************************************************************
-!* Iterative Root Finder Ridder's Method for Sulfuric Acid calculus
-!* From Numerical Recipes
-!* Adapted for VenusGCM A. Stolzenbach 07/2014
-!*
-!* Les iterations sur [X1,X2] sont [WSA1,WSA2]
-!* la variable X est WSA
-!* IRFRMSA sort en OUTPUT : WSA pour KEEQ=0
-
-      IMPLICIT NONE
-
-      REAL, INTENT(IN) ::    X1, X2
-      REAL, INTENT(IN) ::    XACC
-      INTEGER, INTENT(IN) :: MAXIT, NB
-
-!     LOCAL VARIABLES
-      REAL XL, XH, XM, XNEW
-      REAL Fl, FH, FM, FNEW
-      REAL ANS, S, FSIGN
-      INTEGER i
-
-!     External variables needed:
-      REAL, INTENT(IN) :: TAIR,PAIR
-      REAL, INTENT(IN) :: LPPWV
-      REAL, INTENT(IN) :: RADIUS
-
-!     External functions needed:
-      REAL KEEQ
-
-
-
-!     Initialisation
-      FL=KEEQ(RADIUS,TAIR,X1,LPPWV)
-      FH=KEEQ(RADIUS,TAIR,X2,LPPWV)
-
-!     Test Bracketed values
-      IF (((FL.LT.0.).AND.(FH.GT.0.)).OR.((FL.GT.0.).AND.(FH.LT.0.)))
-     &  THEN
-         XL=X1
-         XH=X2
-         ANS=-9.99e99
-
-         DO i=1, MAXIT
-            XM=0.5*(XL+XH)
-            FM=KEEQ(RADIUS,TAIR,XM,LPPWV)
-            S=SQRT(FM*FM-FL*FH)
-
-            IF (S.EQ.0.0) THEN
-               IRFRMSA=ANS
-               RETURN
-            ENDIF
-
-            IF (FL.GT.FH) THEN
-               FSIGN=1.0
-            ELSE
-               FSIGN=-1.0
-            ENDIF
-
-            XNEW=XM+(XM-XL)*(FSIGN*FM/S)
-
-            IF (ABS(XNEW-ANS).LE.XACC) THEN
-               IRFRMSA=ANS
-               RETURN
-            ENDIF
-
-            ANS=XNEW
-            FNEW=KEEQ(RADIUS,TAIR,ANS,LPPWV)
-
-            IF (FNEW.EQ.0.0) THEN
-               IRFRMSA=ANS
-               RETURN
-            ENDIF
-
-            IF (SIGN(FM, FNEW).NE.FM) THEN
-               XL=XM
-               FL=FM
-               XH=ANS
-               FH=FNEW
-               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
-                  XH=ANS
-                  FH=FNEW
-               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
-                  XL=ANS
-                  FL=FNEW
-               ELSE
-                  PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
-                  PRINT*,'you shall not PAAAAAASS'
-                  STOP
-            ENDIF
-         ENDDO
-         PRINT*,'Paaaaas bien MAXIT atteint'
-         PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
-         PRINT*,'you shall not PAAAAAASS'
-         XL=X1
-         XH=X2
-         PRINT*,'Borne XL',XL,'XH',XH
-         ANS=-9.99e99
-
-         DO i=1, MAXIT
-            XM=0.5*(XL+XH)
-            FM=KEEQ(RADIUS,TAIR,XM,LPPWV)
-            S=SQRT(FM*FM-FL*FH)
-
-            IF (FL.GT.FH) THEN
-               FSIGN=1.0
-            ELSE
-               FSIGN=-1.0
-            ENDIF
-
-            XNEW=XM+(XM-XL)*(FSIGN*FM/S)
-
-            ANS=XNEW
-            FNEW=KEEQ(RADIUS,TAIR,ANS,LPPWV)
-            PRINT*,'KEEQ result',FNEW,'T',TAIR,'R',RADIUS
-            IF (SIGN(FM, FNEW).NE.FM) THEN
-               XL=XM
-               FL=FM
-               XH=ANS
-               FH=FNEW
-               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
-                  XH=ANS
-                  FH=FNEW
-               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
-                  XL=ANS
-                  FL=FNEW
-               ELSE
-                  PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
-                  PRINT*,'you shall not PAAAAAASS'
-                  STOP
-            ENDIF
-         ENDDO
-         STOP
-      ELSE
-         PRINT*,'IRFRMSA must be bracketed'
-         IF (FL.EQ.0.0) THEN
-           PRINT*,'IRFRMSA FL == 0',Fl
-           IRFRMSA=X1
-           RETURN
-         ENDIF
-         IF (FH.EQ.0.0) THEN
-           PRINT*,'IRFRMSA FH == 0',FH
-           IRFRMSA=X2
-           RETURN
-         ENDIF
-         IF ((FL.NE.0.).AND.(FH.NE.0.)) THEN
-           PRINT*,'IRFRMSA FH and FL neq 0: ', FL, FH
-           PRINT*,'X1',X1,'X2',X2
-           PRINT*,'Kind F', KIND(FL), KIND(FH)
-           PRINT*,'Kind X', KIND(X1), KIND(X2)
-           PRINT*,'Logical: ',(SIGN(FL,FH).NE.FL)
-           PRINT*,'Logical: ',(SIGN(FH,FL).NE.FH)
-           PRINT*,'nb root BRACWSA',NB
-           STOP
-         ENDIF
-
-      ENDIF
-!  FIN Test Bracketed values
-
-      END function IRFRMSA
-
-!*****************************************************************************
-!*     REAL FUNCTION KEEQ()
-      REAL	FUNCTION KEEQ(RADIUS,TAIR,WSA,LPPWV)
-!*****************************************************************************
-!* Kelvin Equation EQuality
-!* ln(PPWV_eq) - (2Mh2o sigma)/(R T r rho) - ln(ph2osa) = 0
-!*
-
-      IMPLICIT NONE
-
-      REAL, INTENT(IN) :: RADIUS,TAIR,WSA,LPPWV
-
-!     Physical constants:
-      REAL   MH2O
-      REAL   RGAS
-      PARAMETER(
-!       Molar weight of water (kg/mole)
-     +          MH2O=18.0153d-3,
-!       Universal gas constant (J/(mole K))
-     +          RGAS=8.314462175d0)
-!
-!     External functions needed:
-      REAL   PWVSAS_GV,SIGMADROPLET,RHODROPLET
-!     PWVSAS_GV:      Natural logaritm of water vapor pressure over
-!                  sulfuric acid solution
-!     SIGMADROPLET:       Surface tension of sulfuric acid solution
-!     RHODROPLET:       Density of sulfuric acid solution
-!
-!     Auxiliary local variables:
-      REAL   C1
-
-      PARAMETER(
-     +        C1=2.0d0*MH2O/RGAS)
-
-
-      KEEQ=LPPWV-C1*SIGMADROPLET(WSA,TAIR)/
-     &     (TAIR*RADIUS*RHODROPLET(WSA,TAIR))-
-     &     PWVSAS_GV(TAIR,WSA)
-
-      END FUNCTION KEEQ
-
-*****************************************************************************
-*     REAL FUNCTION PWVSAS_GV(TAIR,WSA)                                        
-      REAL FUNCTION PWVSAS_GV(TAIR,WSA)
-*****************************************************************************
-*
-*     Natural logaritm of saturated water vapor pressure over plane
-*     sulfuric acid solution.
-*
-*     Source: J.I.Gmitro & T.Vermeulen: A.I.Ch.E.J.  10,740,1964.
-*             W.F.Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
-*
-*     The formula of Gmitro & Vermeulen for saturation pressure
-*     is used:
-*                 ln(p) = A ln(298/T) + B/T + C + DT
-*     with values of A,B,C and D given by Gmitro & Vermeulen,
-*     and calculated from partial molal properties given by Giauque et al.
-*     
-*     
-*
-*     Input:  TAIR: Temperature (K)
-*             WSA:  Weight fraction of H2SO4  [0;1] 
-*     Output: Natural logaritm of water vapor pressure 
-*             over sulfuric acid solution   ( ln(Pa) )
-*
-*
-*     External functions needed for calculation of partial molal 
-*     properties of pure components at 25 ! as function of W.
-      IMPLICIT NONE
-
-      REAL :: CPH2O,ALH2O,FFH2O,LH2O
-*     CPH2O:  Partial molal heat capacity of sulfuric acid solution.
-*     ALH2O:  Temparature derivative of CPH2O
-*     FFH2O:  Partial molal free energy of sulfuric acid solution.
-*     LH2O:   Partial molal enthalpy of sulfuric acid
-*
-!
-!
-      REAL, INTENT(IN) :: TAIR,WSA
-      REAL :: ADOT,BDOT,CDOT,DDOT
-      REAL :: RGAS,MMHGPA
-      REAL :: K1,K2
-      REAL :: A,B,C,D,CP,L,F,ALFA
-!     Physical constants given by Gmitro & Vermeulen:
-      PARAMETER(
-     +        ADOT=-3.67340,
-     +        BDOT=-4143.5,
-     +        CDOT=10.24353,
-     +        DDOT=0.618943d-3)
-      PARAMETER(
-!     Gas constant (cal/(deg mole)):
-     +        RGAS=1.98726,
-!     Natural logarith of conversion factor between atm. and Pa:     
-     +     MMHGPA=11.52608845, 
-     +     K1=298.15,
-     +     K2=K1*K1/2.0)
-!
-      INTEGER :: KLO,KHI,K,I,NPOINT
-      PARAMETER(NPOINT=110)
-      REAL, DIMENSION(NPOINT) :: WTAB(NPOINT)
-      DATA (WTAB(I),I=1,NPOINT)/
-     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
-     +0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,
-     +0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,
-     +0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,
-     +0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,
-     +0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,
-     +0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,
-     +0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,
-     +0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,
-     +0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,
-     +0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,
-     +0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,
-     +0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,
-     +0.99908,0.99927,0.99945,0.99963,0.99982,1.0000/
-!
-      KLO=1
-      KHI=NPOINT
- 1    IF(KHI-KLO.GT.1) THEN
-          K=(KHI+KLO)/2
-          IF(WTAB(K).GT.MAX(WTAB(1),WSA)) THEN
-              KHI=K
-          ELSE
-              KLO=K
-          ENDIF
-          GOTO 1
-      ENDIF
-!
-      CP=CPH2O(WSA,KHI,KLO)
-      F=-FFH2O(WSA,KHI,KLO)
-      L=-LH2O(WSA,KHI,KLO)
-      ALFA=ALH2O(WSA,KHI,KLO)
-!
-      A=ADOT+(CP-K1*ALFA)/RGAS
-      B=BDOT+(L-K1*CP+K2*ALFA)/RGAS
-      C=CDOT+(CP+(F-L)/K1)/RGAS
-      D=DDOT-ALFA/(2.0d0*RGAS)
-!
-!     WRITE(*,*) 'TAIR= ',TAIR,'  WSA= ',WSA
-!     WRITE(*,*) 'CPH2O(WSA)= ',CP
-!     WRITE(*,*) 'ALFAH2O(WSA)= ',ALFA
-!     WRITE(*,*) 'FFH2O(WSA)= ',F
-!     WRITE(*,*) 'LH2O(WSA)= ',L
-!
-      PWVSAS_GV=A*DLOG(K1/TAIR)+B/TAIR+C+D*TAIR+MMHGPA
-      
-      END FUNCTION PWVSAS_GV
-*******************************************************************************
-*     REAL FUNCTION CPH2O(W)
-      REAL FUNCTION CPH2O(W,khi_in,klo_in)
-*******************************************************************************
-*
-*     Relative partial molal heat capacity of water (cal/(deg mole) in 
-*     sulfuric acid solution, as a function of H2SO4 weight fraction [0;1],
-*     calculated by cubic spline fitting.
-*
-*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
-*
-      IMPLICIT NONE
-
-      INTEGER :: NPOINT,I
-      PARAMETER(NPOINT=109)
-      REAL, DIMENSION(NPOINT) :: WTAB(NPOINT),CPHTAB(NPOINT),
-     +              Y2(NPOINT),YWORK(NPOINT)
-      REAL, INTENT(IN):: W
-      INTEGER, INTENT(IN):: khi_in,klo_in
-      INTEGER :: khi,klo
-      REAL :: CPH
-      LOGICAL :: FIRST
-      DATA (WTAB(I),I=1,NPOINT)/
-     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
-     +0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,
-     +0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,
-     +0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,
-     +0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,
-     +0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,
-     +0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,
-     +0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,
-     +0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,
-     +0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,
-     +0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,
-     +0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,
-     +0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,
-     +0.99908,0.99927,0.99945,0.99963,0.99982/
-      DATA (CPHTAB(I),I=1,NPOINT)/
-     + 17.996, 17.896, 17.875, 17.858, 17.840, 17.820, 17.800, 17.791,
-     + 17.783, 17.777, 17.771, 17.769, 17.806, 17.891, 18.057, 18.248,
-     + 18.429, 18.567, 18.613, 18.640, 18.660, 18.660, 18.642, 18.592,
-     + 18.544, 18.468, 18.348, 18.187, 17.995, 17.782, 17.562, 17.352,
-     + 17.162, 16.993, 16.829, 16.657, 16.581, 16.497, 16.405, 16.302,
-     + 16.186, 16.053, 15.901, 15.730, 15.540, 15.329, 15.101, 14.853,
-     + 14.586, 14.296, 13.980, 13.638, 13.274, 12.896, 12.507, 12.111,
-     + 11.911, 11.711, 11.514, 11.320, 11.130, 10.940, 10.760, 10.570,
-     + 10.390, 10.200, 10.000, 9.8400, 9.7600, 9.7900, 9.9500, 10.310,
-     + 10.950, 11.960, 13.370, 15.060, 16.860, 18.550, 20.000, 21.170,
-     + 22.030, 22.570, 22.800, 22.750, 22.420, 21.850, 21.120, 20.280,
-     + 19.360, 18.350, 17.220, 15.940, 14.490, 12.840, 10.800, 9.8000,
-     + 7.8000, 3.8000,0.20000,-5.4000,-7.0000,-8.8000,-10.900,-13.500,
-     +-17.000,-22.000,-29.000,-40.000,-59.000/
-      DATA FIRST/.TRUE./
-      SAVE FIRST,WTAB,CPHTAB,Y2
-!
-      IF(FIRST) THEN
-          FIRST=.FALSE.
-          CALL SPLINE(WTAB,CPHTAB,NPOINT,YWORK,Y2)
-      ENDIF
-
-      if(khi_in.GT.NPOINT) then
-         khi=NPOINT
-         klo=NPOINT-1
-      else
-         khi=khi_in
-         klo=klo_in
-      endif
-
-      CALL SPLINT(WTAB(khi),WTAB(klo),CPHTAB(khi),CPHTAB(klo),
-     .              Y2(khi),Y2(klo),W,CPH)
-      CPH2O=CPH
-      
-      END FUNCTION CPH2O
-!
-*******************************************************************************
-      REAL FUNCTION FFH2O(W,khi,klo)
-*     REAL FUNCTION FFH2O(W)
-*******************************************************************************
-*
-*     Relative partial molal free energy water (cal/mole) in 
-*     sulfuric acid solution, as a function of H2SO4 weight fraction [0;1],
-*     calculated by cubic spline fitting.
-*
-*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
-*
-      IMPLICIT NONE
-
-      INTEGER :: NPOINT,I
-      PARAMETER(NPOINT=110)
-      REAL, DIMENSION(NPOINT) :: WTAB,FFTAB,Y2,YWORK
-      REAL, INTENT(IN) :: W
-      INTEGER, INTENT(IN):: khi,klo
-      REAL :: FF
-      LOGICAL :: FIRST
-      DATA (WTAB(I),I=1,NPOINT)/
-     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
-     +0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,
-     +0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,
-     +0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,
-     +0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,
-     +0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,
-     +0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,
-     +0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,
-     +0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,
-     +0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,
-     +0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,
-     +0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,
-     +0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,
-     +0.99908,0.99927,0.99945,0.99963,0.99982, 1.0000/
-      DATA (FFTAB(I),I=1,NPOINT)/
-     +0.00000, 22.840, 25.810, 29.250, 33.790, 39.970, 48.690, 54.560,
-     + 61.990, 71.790, 85.040, 103.70, 130.70, 145.20, 163.00, 184.50,
-     + 211.50, 245.60, 266.40, 290.10, 317.40, 349.00, 385.60, 428.40,
-     + 452.50, 478.80, 507.50, 538.80, 573.30, 611.60, 653.70, 700.50,
-     + 752.60, 810.60, 875.60, 948.60, 980.60, 1014.3, 1049.7, 1087.1,
-     + 1126.7, 1168.7, 1213.5, 1261.2, 1312.0, 1366.2, 1424.3, 1486.0,
-     + 1551.8, 1622.3, 1697.8, 1778.5, 1864.9, 1956.8, 2055.8, 2162.0,
-     + 2218.0, 2276.0, 2337.0, 2400.0, 2466.0, 2535.0, 2607.0, 2682.0,
-     + 2760.0, 2842.0, 2928.0, 3018.0, 3111.0, 3209.0, 3311.0, 3417.0,
-     + 3527.0, 3640.0, 3757.0, 3878.0, 4002.0, 4130.0, 4262.0, 4397.0,
-     + 4535.0, 4678.0, 4824.0, 4973.0, 5128.0, 5287.0, 5454.0, 5630.0,
-     + 5820.0, 6031.0, 6268.0, 6541.0, 6873.0, 7318.0, 8054.0, 8284.0,
-     + 8579.0, 8997.0, 9295.0, 9720.0, 9831.0, 9954.0, 10092., 10248.,
-     + 10423., 10618., 10838., 11099., 11460., 12014./
-      DATA FIRST/.TRUE./
-      SAVE FIRST,WTAB,FFTAB,Y2
-!
-      IF(FIRST) THEN
-          FIRST=.FALSE.
-          CALL SPLINE(WTAB,FFTAB,NPOINT,YWORK,Y2)
-      ENDIF
-
-      CALL SPLINT(WTAB(khi),WTAB(klo),FFTAB(khi),FFTAB(klo),
-     .              Y2(khi),Y2(klo),W,FF)
-      FFH2O=FF
-      
-      END FUNCTION FFH2O
-!
-*******************************************************************************
-      REAL FUNCTION LH2O(W,khi,klo)
-*     REAL FUNCTION LH2O(W)
-*******************************************************************************
-*
-*     Relative partial molal heat content of water (cal/mole) in 
-*     sulfuric acid solution, as a function of H2SO4 weight fraction [0;1],
-*     calculated by cubic spline fitting.
-*
-*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
-*
-      IMPLICIT NONE
-
-      INTEGER :: NPOINT,I
-      PARAMETER(NPOINT=110)
-      REAL, DIMENSION(NPOINT) ::  WTAB,LTAB,Y2,YWORK
-      REAL, INTENT(IN) :: W
-      INTEGER, INTENT(IN):: khi,klo
-      REAL :: L
-      LOGICAL :: FIRST
-      DATA (WTAB(I),I=1,NPOINT)/
-     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
-     +0.17882,0.19482,0.21397,0.23728,0.26629,0.27999,0.29517,0.31209,
-     +0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,
-     +0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,
-     +0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,
-     +0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,
-     +0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,
-     +0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,
-     +0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,
-     +0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,
-     +0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,
-     +0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,
-     +0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,
-     +0.99908,0.99927,0.99945,0.99963,0.99982, 1.0000/
-      DATA (LTAB(I),I=1,NPOINT)/
-     +0.00000, 5.2900, 6.1000, 7.1800, 8.7800, 11.210, 15.290, 18.680,
-     + 23.700, 31.180, 42.500, 59.900, 89.200, 106.70, 128.60, 156.00,
-     + 190.40, 233.80, 260.10, 290.00, 324.00, 362.50, 406.50, 456.10,
-     + 483.20, 512.40, 543.60, 577.40, 613.80, 653.50, 696.70, 744.50,
-     + 797.20, 855.80, 921.70, 995.70, 1028.1, 1062.3, 1098.3, 1136.4,
-     + 1176.7, 1219.3, 1264.7, 1313.0, 1364.3, 1418.9, 1477.3, 1539.9,
-     + 1607.2, 1679.7, 1757.9, 1842.7, 1934.8, 2035.4, 2145.5, 2267.0,
-     + 2332.0, 2401.0, 2473.0, 2550.0, 2631.0, 2716.0, 2807.0, 2904.0,
-     + 3007.0, 3118.0, 3238.0, 3367.0, 3507.0, 3657.0, 3821.0, 3997.0,
-     + 4186.0, 4387.0, 4599.0, 4819.0, 5039.0, 5258.0, 5476.0, 5694.0,
-     + 5906.0, 6103.0, 6275.0, 6434.0, 6592.0, 6743.0, 6880.0, 7008.0,
-     + 7133.0, 7255.0, 7376.0, 7497.0, 7618.0, 7739.0, 7855.0, 7876.0,
-     + 7905.0, 7985.0, 8110.0, 8415.0, 8515.0, 8655.0, 8835.0, 9125.0,
-     + 9575.0, 10325., 11575., 13500., 15200., 16125./
-      DATA FIRST/.TRUE./
-      SAVE FIRST,WTAB,LTAB,Y2
-!
-      IF(FIRST) THEN
-          FIRST=.FALSE.
-          CALL SPLINE(WTAB,LTAB,NPOINT,YWORK,Y2)
-      ENDIF
-
-      CALL SPLINT(WTAB(khi),WTAB(klo),LTAB(khi),LTAB(klo),
-     .              Y2(khi),Y2(klo),W,L)
-      LH2O=L
-      
-      END FUNCTION LH2O
-*******************************************************************************
-      REAL FUNCTION ALH2O(W,khi_in,klo_in)
-*     REAL FUNCTION ALH2O(W)
-*******************************************************************************
-*
-*     Relative partial molal temperature derivative of heat capacity (water) 
-*     in sulfuric acid solution, (cal/deg**2), calculated by 
-*     cubic spline fitting.
-*
-*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
-*
-      IMPLICIT NONE
-
-      INTEGER :: NPOINT,I
-      PARAMETER(NPOINT=96)
-      REAL, DIMENSION(NPOINT) :: WTAB,ATAB,Y2,YWORK
-      REAL, INTENT(IN) :: W
-      INTEGER, INTENT(IN):: khi_in,klo_in
-      INTEGER :: khi,klo
-      REAL :: A
-      LOGICAL :: FIRST
-      DATA (WTAB(I),I=1,NPOINT)/
-     +0.29517,0.31209,
-     +0.33107,0.35251,0.36430,0.37691,0.39043,0.40495,0.42059,0.43749,
-     +0.44646,0.45580,0.46555,0.47572,0.48634,0.49745,0.50908,0.52126,
-     +0.53405,0.54747,0.56159,0.57646,0.58263,0.58893,0.59537,0.60195,
-     +0.60868,0.61557,0.62261,0.62981,0.63718,0.64472,0.65245,0.66037,
-     +0.66847,0.67678,0.68530,0.69404,0.70300,0.71220,0.72164,0.73133,
-     +0.73628,0.74129,0.74637,0.75152,0.75675,0.76204,0.76741,0.77286,
-     +0.77839,0.78399,0.78968,0.79545,0.80130,0.80724,0.81327,0.81939,
-     +0.82560,0.83191,0.83832,0.84482,0.85143,0.85814,0.86495,0.87188,
-     +0.87892,0.88607,0.89334,0.90073,0.90824,0.91588,0.92365,0.93156,
-     +0.93959,0.94777,0.95610,0.96457,0.97319,0.98196,0.99090,0.99270,
-     +0.99452,0.99634,0.99725,0.99817,0.99835,0.99853,0.99872,0.99890,
-     +0.99908,0.99927,0.99945,0.99963,0.99982, 1.0000/
-      DATA (ATAB(I),I=1,NPOINT)/
-     + 0.0190, 0.0182, 0.0180, 0.0177, 0.0174, 0.0169, 0.0167, 0.0164,
-     + 0.0172, 0.0212, 0.0239, 0.0264, 0.0276, 0.0273, 0.0259, 0.0238,
-     + 0.0213, 0.0190, 0.0170, 0.0155, 0.0143, 0.0133, 0.0129, 0.0124,
-     + 0.0120, 0.0114, 0.0106, 0.0097, 0.0084, 0.0067, 0.0047, 0.0024,
-     +-0.0002,-0.0031,-0.0063,-0.0097,-0.0136,-0.0178,-0.0221,-0.0263,
-     +-0.0303,-0.0340,-0.0352,-0.0360,-0.0362,-0.0356,-0.0343,-0.0321,
-     +-0.0290,-0.0251,-0.0201,-0.0137,-0.0058, 0.0033, 0.0136, 0.0254,
-     + 0.0388, 0.0550, 0.0738, 0.0962, 0.1198, 0.1300, 0.1208, 0.0790,
-     + 0.0348, 0.0058,-0.0102,-0.0211,-0.0292,-0.0350,-0.0390,-0.0418,
-     +-0.0432,-0.0436,-0.0429,-0.0411,-0.0384,-0.0346,-0.0292,-0.0220,
-     +-0.0130,-0.0110,-0.0080,-0.0060,-0.0040,-0.0030,-0.0030,-0.0020,
-     +-0.0020,-0.0020,-0.0020,-0.0010,-0.0010, 0.0000, 0.0000, 0.0000/
-      DATA FIRST/.TRUE./
-      SAVE FIRST,WTAB,ATAB,Y2
-!
-      IF(FIRST) THEN
-          FIRST=.FALSE.
-          CALL SPLINE(WTAB,ATAB,NPOINT,YWORK,Y2)
-      ENDIF
-
-      if(klo_in.LT.15) then
-         khi=2
-         klo=1
-      else
-         khi=khi_in-14
-         klo=klo_in-14
-      endif
-
-      CALL SPLINT(WTAB(khi),WTAB(klo),ATAB(khi),ATAB(klo),
-     .              Y2(khi),Y2(klo),W,A)
-      ALH2O=A
-      
-      END FUNCTION ALH2O
-!******************************************************************************
-      SUBROUTINE SPLINE(X,Y,N,WORK,Y2)
-!******************************************************************************
-!     Routine to calculate 2.nd derivatives of tabulated function
-!     Y(i)=Y(Xi), to be used for cubic spline calculation.
-!
-      IMPLICIT NONE
-
-      INTEGER, INTENT(IN) :: N
-      INTEGER :: I
-      REAL, DIMENSION(N), INTENT(IN) :: X,Y
-      REAL, DIMENSION(N), INTENT(OUT) :: Y2,WORK
-      REAL   SIG,P,QN,UN,YP1,YPN
-
-!AM Venus: Let's check the values
-!      write(*,*) 'In spline, N ', N
-
-      YP1=(Y(2)-Y(1))/(X(2)-X(1))
-      YPN=(Y(N)-Y(N-1))/(X(N)-X(N-1))
-      IF(YP1.GT.99.0E+30) THEN
-          Y2(1)=0.0
-          WORK(1)=0.0
-      ELSE
-          Y2(1)=-0.5d0
-          WORK(1)=(3.0d0/(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1)
-      ENDIF
-      DO I=2,N-1
-!         write(*,*) 'In spline, I ', I
-          SIG=(X(I)-X(I-1))/(X(I+1)-X(I-1))
-          P=SIG*Y2(I-1)+2.0d0
-          Y2(I)=(SIG-1.0d0)/P
-          WORK(I)=(6.0d0*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1))
-     +             /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*WORK(I-1))/P
-      ENDDO
-      IF(YPN.GT.99.0E+30) THEN
-          QN=0.0
-          UN=0.0
-      ELSE
-          QN=0.5d0
-          UN=(3.0d0/(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1)))
-      ENDIF
-      Y2(N)=(UN-QN*WORK(N-1))/(QN*Y2(N-1)+1.0d0)
-      DO I=N-1,1,-1
-!         write(*,*) 'In spline, I ', I
-          Y2(I)=Y2(I)*Y2(I+1)+WORK(I)
-      ENDDO
-!
-      END SUBROUTINE SPLINE
-
-!******************************************************************************
-      SUBROUTINE SPLINT(XAhi,XAlo,YAhi,YAlo,Y2Ahi,Y2Alo,X,Y)
-!******************************************************************************
-!     Cubic spline calculation
-
-      IMPLICIT NONE
-
-      REAL, INTENT(IN) :: XAhi,XAlo,YAhi,YAlo,Y2Ahi,Y2Alo
-      REAL, INTENT(IN) :: X
-      REAL, INTENT(OUT) :: Y
-      REAL :: H,A,B
-!
-      H=XAhi-XAlo
-      A=(XAhi-X)/H
-      B=(X-XAlo)/H
-      Y=A*YAlo+B*YAhi+
-     +        ((A**3-A)*Y2Alo+(B**3-B)*Y2Ahi)*(H**2)/6.0d0
-!
-
-      END SUBROUTINE SPLINT
 !******************************************************************
       SUBROUTINE CALCM_SAT(H2SO4,H2O,WSA,DENSO4,
@@ -1593,258 +406,2 @@
       END SUBROUTINE CALCM_SAT
 
-       SUBROUTINE Zeleznik(x,T,act)
-
-  !+++++++++++++++++++++++++++++++++++++++++++++++++++
-  !     Water and sulfuric acid activities in liquid
-  !     aqueous solutions.
-  !     Frank J. Zeleznik, Thermodynnamic properties
-  !     of the aqueous sulfuric acid system to 220K-350K,
-  !     mole fraction 0,...,1
-  !     J. Phys. Chem. Ref. Data, Vol. 20, No. 6,PP.1157, 1991
-  !+++++++++++++++++++++++++++++++++++++++++++++++++++
-
-         IMPLICIT NONE
-
-         REAL, INTENT(IN) :: x,T
-         REAL :: activitya, activityw
-         REAL, INTENT(OUT), DIMENSION(2):: act
-!         REAL x,T, activitya, activityw
-!         REAL, DIMENSION(2):: act
-
-
-!         write(*,*) 'x, T ', x, T
-
-         act(2)=activitya(x,T)
-         act(1)=activityw(x,T)
-
-!         write(*,*) 'act ', act
-
-       END SUBROUTINE Zeleznik
-
-!start of functions related to zeleznik activities
-
-      REAL FUNCTION m111(T)
-
-       REAL, INTENT(IN) :: T
-       m111=-23.524503387D0
-     &    +0.0406889449841D0*T
-     &    -0.151369362907D-4*T**2+2961.44445015D0/T
-     &    +0.492476973663D0*dlog(T)
-       END FUNCTION m111
-
-      REAL FUNCTION m121(T)
-
-       REAL, INTENT(IN) :: T
-       m121=1114.58541077D0-1.1833078936D0*T
-     &    -0.00209946114412D0*T**2-246749.842271D0/T
-     &    +34.1234558134D0*dlog(T)
-       END FUNCTION m121
-
-       FUNCTION m221(T)
-
-       REAL, INTENT(IN) :: T
-       m221=-80.1488100747D0-0.0116246143257D0*T
-     &    +0.606767928954D-5*T**2+3092.72150882D0/T
-     &    +12.7601667471D0*dlog(T)
-       END FUNCTION m221
-
-      REAL FUNCTION m122(T)
-
-       REAL, INTENT(IN) :: T
-       m122=888.711613784D0-2.50531359687D0*T
-     &    +0.000605638824061D0*T**2-196985.296431D0/T
-     &    +74.550064338D0*dlog(T)
-       END FUNCTION m122
-
-      REAL FUNCTION e111(T)
-
-       REAL, INTENT(IN) :: T
-       e111=2887.31663295D0-3.32602457749D0*T
-     &    -0.2820472833D-2*T**2-528216.112353D0/T
-     &    +0.68699743564D0*dlog(T)
-       END FUNCTION e111
-
-      REAL FUNCTION e121(T)
-
-       REAL, INTENT(IN) :: T
-       e121=-370.944593249D0-0.690310834523D0*T
-     &    +0.56345508422D-3*T**2-3822.52997064D0/T
-     &    +94.2682037574D0*dlog(T)
-       END FUNCTION e121
-
-      REAL FUNCTION e211(T)
-
-       REAL, INTENT(IN) :: T
-       e211=38.3025318809D0-0.0295997878789D0*T
-     &    +0.120999746782D-4*T**2-3246.97498999D0/T
-     &    -3.83566039532D0*dlog(T)
-       END FUNCTION e211
-
-      REAL FUNCTION e221(T)
-
-       REAL, INTENT(IN) :: T
-       e221=2324.76399402D0-0.141626921317D0*T
-     &    -0.00626760562881D0*T**2-450590.687961D0/T
-     &    -61.2339472744D0*dlog(T)
-       END FUNCTION e221
-
-      REAL FUNCTION e122(T)
-
-       REAL, INTENT(IN) :: T
-       e122=-1633.85547832D0-3.35344369968D0*T
-     &    +0.00710978119903D0*T**2+198200.003569D0/T
-     &    +246.693619189D0*dlog(T)
-       END FUNCTION e122
-
-      REAL FUNCTION e212(T)
-
-       REAL, INTENT(IN) :: T
-       e212=1273.75159848D0+1.03333898148D0*T
-     &    +0.00341400487633D0*T**2+195290.667051D0/T
-     &    -431.737442782D0*dlog(T)
-       END FUNCTION e212
-
-      REAL FUNCTION lnAa(x1,T)
-
-       REAL, INTENT(IN) :: T,x1
-       REAL ::
-     &          m111,m121,m221,m122
-     &            ,e111,e121,e211,e122,e212,e221
-       lnAa=-(
-     &    (2*m111(T)+e111(T)*(2*dlog(x1)+1))*x1
-     &    +(2*m121(T)+e211(T)*dlog(1-x1)+e121(T)*(dlog(x1)+1))*(1-x1)
-     &    -(m111(T)+e111(T)*(dlog(x1)+1))*x1*x1
-     &    -(2*m121(T)+e121(T)*(dlog(x1)+1)+e211(T)*(dlog(1-x1)+1)
-     &    -(2*m122(T)+e122(T)*dlog(x1)
-     &           +e212(T)*dlog(1-x1))*(1-x1))*x1*(1-x1)
-     &    -(m221(T)+e221(T)*(dlog(1-x1)+1))*(1-x1)**2
-     &    -x1*(1-x1)*(
-     &                  (6*m122(T)+e122(T)*(3*dlog(x1)+1)
-     &                          +e212(T)*(3*dlog(1-x1)+1)
-     &                   )*x1*(1-x1)
-     &                -(2*m122(T)+e122(T)*(dlog(x1)+1)
-     &                                   +e212(T)*dlog(1-x1)
-     &                    )*(1-x1))
-     &     )
-       END FUNCTION lnAa
-
-      REAL FUNCTION lnAw(x1,T)
-
-       REAL, INTENT(IN) :: T,x1
-       REAL ::
-     &          m111,m121,m221,m122
-     &            ,e111,e121,e211,e122,e212,e221
-       lnAw=-(
-     &  (2*m121(T)+e121(T)*dlog(x1)+e211(T)*(dlog(1-x1)+1))*x1
-     &  +(2*m221(T)+e221(T)*(2*dlog(1-x1)+1))*(1-x1)
-     &  -(m111(T)+e111(T)*(dlog(x1)+1))*x1*x1
-     & -(2*m121(T)+e121(T)*(dlog(x1)+1)
-     &            +e211(T)*(dlog(1-x1)+1))*x1*(1-x1)
-     &        -(m221(T)+e221(T)*(dlog(1-x1)+1))*(1-x1)**2
-     &   +x1*(2*m122(T)+e122(T)*dlog(x1)+e212(T)*dlog(1-x1))*x1*(1-x1)
-     &  +x1*(1-x1)*((2*m122(T)+e122(T)*dlog(x1)
-     &                        +e212(T)*(dlog(1-x1)+1))*x1
-     &               -(6*m122(T)+e122(T)*(3*dlog(x1)+1)
-     &                        +e212(T)*(3*dlog(1-x1)+1))*(1-x1)*x1)
-     &     )
-       END FUNCTION lnAw
-
-      REAL FUNCTION activitya(xal,T)
-
-       REAL, INTENT(IN) :: T,xal
-       REAL :: lnAa
-!       &          ,m111,m121,m221,m122 &
-!       &            ,e111,e121,e211,e122,e212,e221
-
-!       write(*,*) 'in activitya ', xal, T
-       activitya=DEXP(lnAa(xal,T)-lnAa(1.D0-1.D-12,T))
-       END FUNCTION activitya
-
-       FUNCTION activityw(xal,T)
-
-       REAL, INTENT(IN) :: T,xal
-       REAL :: lnAw
-
-       activityw=DEXP(lnAw(xal,T)-lnAw(1.D-12,T))
-       END FUNCTION activityw
-
-! end of functions related to zeleznik activities
-
-
-
-
-      FUNCTION SIGMADROPLET(xmass,t)
-! calculates the surface tension of the liquid in J/m^2
-! xmass=mass fraction of h2so4, t in kelvins
-! about 230-323 K , x=0,...,1
-!(valid down to the solid phase limit temp, which depends on molefraction)
-      IMPLICIT NONE
-      REAL :: SIGMADROPLET
-      REAL, INTENT(IN):: xmass, t
-      REAL :: a, b, t1, tc, xmole
-      REAL, PARAMETER :: Msa=98.078
-      REAL, PARAMETER :: Mwv=18.0153
-
-       IF (t .LT. 305.15) THEN
-!low temperature surface tension
-! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari
-! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
-! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
-!and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
-      a=0.11864+xmass*(-0.11651+xmass*(0.76852+xmass*
-     & (-2.40909+xmass*(2.95434-xmass*1.25852))))
-      b=-0.00015709+xmass*(0.00040102+xmass*(-0.00239950+xmass*
-     & (0.007611235+xmass*(-0.00937386+xmass*0.00389722))))
-      SIGMADROPLET=a+t*b
-      ELSE
-
-      xmole = (xmass/Msa)*(1./((xmass/Msa)+(1.-xmass)/Mwv))
-! high temperature surface tension
-!H. Vehkam‰ki and M. Kulmala and K.E. J. lehtinen, 2003,
-!Modelling binary homogeneous nucleation of water-sulfuric acid vapours:
-! parameterisation for high temperature emissions, () Environ. Sci. Technol., 37, 3392-3398
-
-      tc= 647.15*(1.0-xmole)*(1.0-xmole)+900.0*xmole*xmole+
-     & 3156.186*xmole*(1-xmole) !critical temperature
-      t1=1.0-t/tc
-      a= 0.2358+xmole*(-0.529+xmole*(4.073+xmole*(-12.6707+xmole*
-     & (15.3552+xmole*(-6.3138)))))
-      b=-0.14738+xmole*(0.6253+xmole*(-5.4808+xmole*(17.2366+xmole*
-     & (-21.0487+xmole*(8.719)))))
-      SIGMADROPLET=(a+b*t1)*t1**(1.256)
-      END IF
-
-      RETURN
-      END FUNCTION SIGMADROPLET
-
-      FUNCTION RHODROPLET(xmass,t)
-!
-! calculates the density of the liquid in kg/m^3
-! xmass=mass fraction of h2so4, t in kelvins
-! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari
-! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
-! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
-!and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
-
-! about 220-373 K , x=0,...,1
-!(valid down to the solid phase limit temp, which depends on molefraction)
-
-      IMPLICIT NONE
-      REAL :: RHODROPLET
-      REAL, INTENT(IN) :: xmass, t
-      REAL ::  a,b,c
-
-
-      a=0.7681724+xmass*(2.1847140+xmass*(7.1630022+xmass*
-     & (-44.31447+xmass*
-     & (88.75606+xmass*(-75.73729+xmass*23.43228)))))
-      b=1.808225e-3+xmass*(-9.294656e-3+xmass*(-0.03742148+
-     &  xmass*(0.2565321+xmass*(-0.5362872+xmass*
-     &  (0.4857736-xmass*0.1629592)))))
-      c=-3.478524e-6+xmass*(1.335867e-5+xmass*
-     & (5.195706e-5+xmass*(-3.717636e-4+xmass*
-     & (7.990811e-4+xmass*(-7.458060e-4+xmass*2.58139e-4)))))
-      RHODROPLET=a+t*(b+c*t) ! g/cm^3
-      RHODROPLET= RHODROPLET*1.0e3 !kg/m^3
-      RETURN
-      END FUNCTION RHODROPLET
Index: /trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F	(revision 1661)
@@ -341,5 +341,9 @@
 c Variables tendance sedimentation
 
-      REAL :: d_tr_sed(klon,klev,2)
+      REAL :: m0_mode1(klev,2),m0_mode2(klev,2)
+      REAL :: m3_mode1(klev,3),m3_mode2 (klev,3)
+      REAL :: d_drop_sed(klev),d_ccn_sed(klev,2),d_liq_sed(klev,2)
+      REAL :: aer_flux(klev)
+      REAL :: d_tr_sed(klon,klev,nqmax)
       REAL :: d_tr_ssed(klon)
 c
@@ -640,5 +644,28 @@
 c===============================================
      
-      if ((nlon .EQ. 1) .AND. ok_cloud) then
+c MICROPHY SANS CHIMIE: seulement si full microphy (cl_scheme=2)
+
+      if (ok_chem.and..not.ok_cloud) then
+        print*,"LA CHIMIE A BESOIN DE LA MICROPHYSIQUE"
+        print*,"ok_cloud doit etre = a ok_chem"
+      stop
+      endif
+      if (.not.ok_chem.and.ok_cloud.and.(cl_scheme.eq.1)) then
+        print*,"cl_scheme=1 doesnot work without chemistry"
+      stop
+      endif
+       if (.not.ok_chem.and.ok_cloud.and.(cl_scheme.eq.2)) then
+        print*,"Full microphysics without chemistry"
+c indexation of microphys tracers
+        CALL chemparam_ini() 
+      endif
+    
+c number of microphysical tracers
+      nmicro=0
+      if (ok_cloud .AND. (cl_scheme.eq.1)) nmicro=2
+      if (ok_cloud .AND. (cl_scheme.eq.2)) nmicro=8
+ 
+c CAS 1D POUR MICROPHYS Aurelien
+      if ((nlon .EQ. 1) .AND. ok_cloud .AND. (cl_scheme.eq.1)) then
         PRINT*,'Open profile_cloud_parameters.csv'
         OPEN(66,file='profile_cloud_parameters.csv',
@@ -646,5 +673,5 @@
       endif
 
-      if ((nlon .EQ. 1) .AND. ok_sedim) then
+      if ((nlon .EQ. 1) .AND. ok_sedim .AND. (cl_scheme.eq.1)) then
         PRINT*,'Open profile_cloud_sedim.csv'
         OPEN(77,file='profile_cloud_sedim.csv',
@@ -652,10 +679,12 @@
       endif
            
-      if ((nlon .GT. 1) .AND. (ok_chem.OR.ok_cloud)) then
+c INIT PHOTOCHEMISTRY ! includes the indexation of microphys tracers
+      if ((nlon .GT. 1) .AND. ok_chem) then
 c !!! DONC 3D !!!
         CALL chemparam_ini() 
       endif
          
-      if ((nlon .GT. 1) .AND. ok_cloud) then
+c INIT MICROPHYS SCHEME 1 (AURELIEN)  
+      if ((nlon .GT. 1) .AND. ok_cloud .AND. (cl_scheme.eq.1)) then
 c !!! DONC 3D !!!
         CALL cloud_ini(nlon,nlev)
@@ -889,5 +918,12 @@
 c        CALL WriteField_phy('SAg',tr_seri(:,:,i_h2so4),nlev)
 
+C === SEDIMENTATION ===
+
          if (ok_sedim) then 
+
+c !! Depend on cl_scheme !! 
+
+          if (cl_scheme.eq.1) then 
+c         ================
 
            CALL new_cloud_sedim(
@@ -899,5 +935,5 @@
      I                     t_seri,
      I                 tr_seri,
-     O                     d_tr_sed,
+     O                     d_tr_sed(:,:,1:2),
      O                     d_tr_ssed,
      I                     nqmax,
@@ -933,4 +969,75 @@
       
         Fsedim(:,klev+1) = 0.
+	
+          elseif (cl_scheme.eq.2) then
+c         ====================
+
+           d_tr_sed(:,:,:) = 0.D0
+
+           DO i=1, klon
+
+c Mode 1
+         m0_mode1(:,1)=tr_seri(i,:,i_m0_mode1drop)
+         m0_mode1(:,2)=tr_seri(i,:,i_m0_mode1ccn)
+         m3_mode1(:,1)=tr_seri(i,:,i_m3_mode1sa)
+         m3_mode1(:,2)=tr_seri(i,:,i_m3_mode1w)
+         m3_mode1(:,3)=tr_seri(i,:,i_m3_mode1ccn)
+	 
+         call drop_sedimentation(dtime,klev,m0_mode1,m3_mode1,
+     &        paprs(i,:),zzlev(i,:),zzlay(i,:),t_seri(i,:),
+     &        1,
+     &        d_ccn_sed(:,1),d_drop_sed,d_ccn_sed(:,2),d_liq_sed)
+
+        d_tr_sed(i,:,i_m0_mode1drop)= d_tr_sed(i,:,i_m0_mode1drop)
+     &                              + d_drop_sed
+        d_tr_sed(i,:,i_m0_mode1ccn) = d_tr_sed(i,:,i_m0_mode1ccn)
+     &                              + d_ccn_sed(:,1)
+        d_tr_sed(i,:,i_m3_mode1ccn) = d_tr_sed(i,:,i_m3_mode1ccn)
+     &                              + d_ccn_sed(:,2)
+        d_tr_sed(i,:,i_m3_mode1sa)  = d_tr_sed(i,:,i_m3_mode1sa)
+     &                              + d_liq_sed(:,1)
+        d_tr_sed(i,:,i_m3_mode1w)   = d_tr_sed(i,:,i_m3_mode1w)
+     &                              + d_liq_sed(:,2)
+
+c Mode 2
+         m0_mode2(:,1)=tr_seri(i,:,i_m0_mode2drop)
+         m0_mode2(:,2)=tr_seri(i,:,i_m0_mode2ccn)
+         m3_mode2(:,1)=tr_seri(i,:,i_m3_mode2sa)
+         m3_mode2(:,2)=tr_seri(i,:,i_m3_mode2w)
+         m3_mode2(:,3)=tr_seri(i,:,i_m3_mode2ccn)
+	 
+         call drop_sedimentation(dtime,klev,m0_mode2,m3_mode2,
+     &        paprs(i,:),zzlev(i,:),zzlay(i,:),t_seri(i,:),
+     &        2,
+     &        d_ccn_sed(:,1),d_drop_sed,d_ccn_sed(:,2),d_liq_sed)
+
+        d_tr_sed(i,:,i_m0_mode2drop)= d_tr_sed(i,:,i_m0_mode2drop)
+     &                              + d_drop_sed
+        d_tr_sed(i,:,i_m0_mode2ccn) = d_tr_sed(i,:,i_m0_mode2ccn)
+     &                              + d_ccn_sed(:,1)
+        d_tr_sed(i,:,i_m3_mode2ccn) = d_tr_sed(i,:,i_m3_mode2ccn)
+     &                              + d_ccn_sed(:,2)
+        d_tr_sed(i,:,i_m3_mode2sa)  = d_tr_sed(i,:,i_m3_mode2sa)
+     &                              + d_liq_sed(:,1)
+        d_tr_sed(i,:,i_m3_mode2w)   = d_tr_sed(i,:,i_m3_mode2w)
+     &                              + d_liq_sed(:,2)
+
+c Aer
+        call aer_sedimentation(dtime,klev,tr_seri(i,:,i_m0_aer),
+     &        tr_seri(i,:,i_m3_aer),paprs(i,:),
+     &        zzlev(i,:),zzlay(i,:),t_seri(i,:),
+     &        d_tr_sed(i,:,i_m0_aer),d_tr_sed(i,:,i_m3_aer),aer_flux)
+
+           END DO
+          
+           DO iq=nqmax-nmicro+1,nqmax
+            tr_seri(:,:,iq)  = tr_seri(:,:,iq) + d_tr_sed(:,:,iq)
+            d_tr_sed(:,:,iq) = d_tr_sed(:,:,iq) / dtime
+           END DO
+
+        endif
+c         ====================
+
+C === FIN SEDIMENTATION ===
 
          endif ! ok_sedim
Index: /trunk/LMDZ.VENUS/libf/phyvenus/phytrac_chimie.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/phytrac_chimie.F	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/phytrac_chimie.F	(revision 1661)
@@ -14,5 +14,5 @@
      I                    pdtphys,
      I                    temp,
-     I                    pplev,
+     I                    pplay,
      O                    trac)
 c======================================================================
@@ -29,7 +29,4 @@
       
 #include "clesphys.h" 
-c#include "temps.h"
-c#include "paramet.h"
-c#include "comcstfi.h" !me permet de recuperer mugaz et d'autres constantes comme rad,pi etc
 #include "YOMCST.h"
 c======================================================================
@@ -61,5 +58,5 @@
       real  trac_sav(n_lon,n_lev,nqmax)
       real  trac_sum(n_lon,n_lev)
-      real  pplev(n_lon,n_lev)  ! pression pour le mileu de chaque couche (en Pa)
+      real  pplay(n_lon,n_lev)  ! pression pour le mileu de chaque couche (en Pa)
       real  lon_sun
 
@@ -93,29 +90,21 @@
          PRINT*,'n_lon 1D: ',n_lon
          end if
-                  
-c         if ((n_lon .GT. 1) .AND. ok_chem) then
-c !!! DONC 3D !!!	
-c           CALL chemparam_ini() 
-c         endif
-         
-c         if ((n_lon .GT. 1) .AND. ok_cloud) then
-c !!! DONC 3D !!!
-c         CALL cloud_ini(n_lon,n_lev)
-c         endif
-           
+
+c=============================================================
+c == CASE INIT PHOTOCHEM ==
+c=============================================================
+                             
        IF (reinit_trac) THEN
        PRINT*,'REINIT MIXING RATIO TRACEURS'
 
-c	=============================================================
-c					Passage de Rm à Rv
+c					Passage de Rm a Rv
 c	=============================================================
 c       Necessaire si on reprend les start.nc qui sont en MMR
-
-         DO iq=1,nqmax
+c SEULEMENT LES GAZ
+         DO iq=1,nqmax-nmicro
           trac(:,:,iq)=trac(:,:,iq)*mmean(:,:)/M_tr(iq)
          END DO
 c	=============================================================
           
-c=============================================================
 c		Initialisation des profils traceurs en Rv
 c=============================================================
@@ -146,5 +135,6 @@
 c     On a donc le CO2 qui est le restant d atmosphere Venus  
          trac_sum(:,:)=0.0
-        DO iq=2,nqmax
+c SEULEMENT LES GAZ
+        DO iq=2,nqmax-nmicro
          trac_sum(:,:)= trac_sum(:,:) + trac(:,:,iq) 
         END DO
@@ -154,8 +144,8 @@
 c=============================================================
       
-c	=============================================================
-c					Passage de Rv à Rm
-c	=============================================================
-         DO iq=1,nqmax
+c					Passage de Rv a Rm
+c	=============================================================
+c SEULEMENT LES GAZ
+         DO iq=1,nqmax-nmicro
           trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:)
          END DO
@@ -164,4 +154,30 @@
        ENDIF  !FIN REINIT TRAC
 
+c=============================================================
+c == CASE INIT GAZ when muphy without chemistry ==
+c=============================================================
+                             
+       if (.not.ok_chem.and.ok_cloud.and.(cl_scheme.eq.2)) then
+
+c					Passage de Rm a Rv
+c	=============================================================
+c       Necessaire si on reprend les start.nc qui sont en MMR
+c SEULEMENT LES GAZ
+         DO iq=1,nqmax-nmicro
+          trac(:,:,iq)=trac(:,:,iq)*mmean(:,:)/M_tr(iq)
+         END DO
+c	=============================================================
+          
+        call vapors4muphy_ini(n_lon,n_lev,trac)
+
+c					Passage de Rv a Rm
+c	=============================================================
+c SEULEMENT LES GAZ
+         DO iq=1,nqmax-nmicro
+          trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:)
+         END DO
+c	=============================================================
+    
+      endif
 	
 c-------------
@@ -172,22 +188,28 @@
 
 c	=============================================================
-c					Passage de Rm à Rv
-c	=============================================================
-       DO iq=1,nqmax
-         trac(:,:,iq)=MAX(trac(:,:,iq)*mmean(:,:)/M_tr(iq),1.E-30)
-       END DO
-c	=============================================================
-
-
-c	=============================================================
-c			 Appel Microphysique (sans nucleation)
-c                  Volume Mixing Ratio
-c	=============================================================
-
-         IF (ok_cloud) THEN
-               
+c					Passage de Rm a Rv
+c                                        DES GAZ
+c	=============================================================
+      DO iq=1,nqmax-nmicro
+        trac(:,:,iq)=MAX(trac(:,:,iq)*mmean(:,:)/M_tr(iq),1.E-30)
+      END DO
+c	=============================================================
+
+
+c	=============================================================
+c	    Appel Microphysique (schema simple, these Aurelien Stolzenbach)
+c	=============================================================
+
+      IF (ok_cloud .AND. cl_scheme.eq.1) THEN
+
+c	  Passage de Rm a Rv pour les liq
+         trac(:,:,i_h2so4liq)=MAX(trac(:,:,i_h2so4liq)
+     &                          *mmean(:,:)/M_tr(i_h2so4liq),1.E-30)
+         trac(:,:,i_h2oliq)=MAX(trac(:,:,i_h2oliq)
+     &                          *mmean(:,:)/M_tr(i_h2oliq),1.E-30)
+              
 c      PRINT*,'DEBUT CLOUD'      
 c     On remet tout le RM liq dans la partie gaz
-c     !!! On reforme un nuage à chaque fois !!!
+c     !!! On reforme un nuage a chaque fois !!!
 
       DO ilev=1, n_lev
@@ -203,5 +225,5 @@
 	            
       CALL new_cloud_venus(n_lev, n_lon,
-     e temp,pplev,
+     e temp,pplay,
      e mrtwv,mrtsa,
      e mrwv,mrsa)
@@ -210,5 +232,5 @@
 c	Actualisation des mixing ratio liq et gaz
 c	=========================================
-c	Si la routine new_cloud_venus n'a pas actualisé mrwv et mrsa
+c	Si la routine new_cloud_venus n'a pas actualise mrwv et mrsa
 c	on a alors bien mr=mrt pour sa et wv, donc les parties liq sont=0 hors du nuage
 c	ou si on ne condense pas
@@ -229,6 +251,36 @@
 
 c	=============================================================
-c      PRINT*,'FIN CLOUD'
-      ENDIF
+c      PRINT*,'FIN CLOUD, scheme 1'
+      ENDIF  
+
+c	=============================================================
+c	    Appel Microphysique (schema complet, these Sabrina Guilbon)
+c	=============================================================
+
+      IF (ok_cloud .AND. cl_scheme.eq.2) THEN
+
+c	Boucle sur grille (n_lon) et niveaux (n_lev)
+        DO ilon=1, n_lon       
+         DO ilev=1, n_lev
+
+           CALL MAD_MUPHY(pdtphys,                               ! Timestep
+     &  temp(ilon,ilev),pplay(ilon,ilev),                        ! Temperature and pressure
+     &  trac(ilon,ilev,i_h2o),trac(ilon,ilev,i_h2so4),           ! Mixing ratio of SA and W
+     &  trac(ilon,ilev,i_m0_aer),trac(ilon,ilev,i_m3_aer),       ! Moments of aerosols
+     &  trac(ilon,ilev,i_m0_mode1drop),trac(ilon,ilev,i_m0_mode1ccn),  ! Moments of mode 1
+     &  trac(ilon,ilev,i_m3_mode1sa),trac(ilon,ilev,i_m3_mode1w),      ! Moments of mode 1
+     &  trac(ilon,ilev,i_m3_mode1ccn),                                 ! Moments of mode 1
+     &  trac(ilon,ilev,i_m0_mode2drop),trac(ilon,ilev,i_m0_mode2ccn),  ! Moments of mode 2
+     &  trac(ilon,ilev,i_m3_mode2sa),trac(ilon,ilev,i_m3_mode2w),      ! Moments of mode 2
+     &  trac(ilon,ilev,i_m3_mode2ccn))                                 ! Moments of mode 2
+
+         ENDDO
+        ENDDO
+
+
+c	=============================================================
+c      PRINT*,'FIN CLOUD, scheme 2'
+      ENDIF  
+
             
 c=============================================================
@@ -239,6 +291,6 @@
 c     Ici, la longitude au midi local se deplace vers l'Ouest
 c     c'est le sens terrestre
-c     pour Vénus on prend juste l'opposé de la longitude et on a la rotation 
-c     de Vénus et donc le midi local qui se déplace vers l'Est
+c     pour Venus on prend juste l'oppose de la longitude et on a la rotation 
+c     de Venus et donc le midi local qui se deplace vers l'Est
      
       lon_sun = (0.5 - gmtime) * 2.0 * RPI
@@ -246,4 +298,7 @@
       lat_local = lat * RPI/180.0E+0
        
+      IF (ok_chem) THEN
+
+c      PRINT*,'DEBUT CHEMISTRY'
       DO ilon=1, n_lon
 
@@ -255,13 +310,11 @@
 c      PRINT*,'sza_local :', sza_local     
     
-      IF (ok_chem) THEN
-c      PRINT*,'DEBUT CHEMISTRY'
 c	=============================================================
 c					Appel Photochimie
 c	=============================================================
-c     Pression en hPa => pplev/100.
+c     Pression en hPa => pplay/100.
 	
       CALL new_photochemistry_venus(n_lev, n_lon, pdtphys,
-     e                         pplev(ilon,:)/100.,
+     e                         pplay(ilon,:)/100.,
      e                         temp(ilon,:),
      e                         trac(ilon,:,:),
@@ -269,17 +322,28 @@
      e                         sza_local, nqmax)
 c	=============================================================
+
+      END DO
 c      PRINT*,'FIN CHEMISTRY'
     
-	END IF
+      END IF
+c=============================================================
+
+c	=============================================================
+c					Passage de Rv a Rm
+c	=============================================================
+c                                        DES GAZ
+      DO iq=1,nqmax-nmicro
+		trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:)
 
       END DO
-c	=============================================================
-c					Passage de Rv à Rm
-c	=============================================================
-	DO iq=1,nqmax
-c		trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD
-		trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:)
-
-	END DO
+
+      IF (ok_cloud .AND. cl_scheme.eq.1) THEN
+c	  Passage de Rm a Rv pour les liq
+         trac(:,:,i_h2so4liq)=trac(:,:,i_h2so4liq)*M_tr(i_h2so4liq)
+     &                          /mmean(:,:)
+         trac(:,:,i_h2oliq)=trac(:,:,i_h2oliq)*M_tr(i_h2oliq)
+     &                          /mmean(:,:)
+      ENDIF
+      
 c	=============================================================	
 C      PRINT*,'FIN PHYTRAC'
Index: /trunk/LMDZ.VENUS/libf/phyvenus/write_histins.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/write_histins.h	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/write_histins.h	(revision 1661)
@@ -68,5 +68,5 @@
        call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw)
       
-       IF (ok_cloud) THEN
+       IF (ok_cloud.and.(cl_scheme.eq.1)) THEN
        
        IF (nb_mode.GE.1) THEN
@@ -109,5 +109,6 @@
      & rho_droplet)
 		ENDIF
-       IF (ok_sedim) THEN 
+
+       IF (ok_sedim.and.(cl_scheme.eq.1)) THEN 
       
       call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2SO4",itau_w,
@@ -118,4 +119,5 @@
       call histwrite_phy(nid_ins,.false.,"F_sedim",itau_w,Fsedim)
 		ENDIF             
+
       ENDIF !lev_histins.GE.2
 
Index: /trunk/LMDZ.VENUS/libf/phyvenus/write_histmth.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/write_histmth.h	(revision 1660)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/write_histmth.h	(revision 1661)
@@ -115,5 +115,5 @@
       call histwrite_phy(nid_mth,.false.,"dtcond",itau_w,d_t_conduc)
       call histwrite_phy(nid_mth,.false.,"dumolvis",itau_w,d_u_molvis)
-      call histwrite_phy(nid_mth,.false.,"dvmolvis",itau_w,d_v_molvis)
+      call histwrite_phy(nid_mth,.false.,"dvmolvis",itau_w,-1.*d_v_molvis)
 
 c     call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec)
