 SUBROUTINE m7_dconc (kidia, kfdia, klon, klev, paerml, paernl, pm6dry)
  !
  !    *m7_dconc*  changes aerosol numbers and masses to account for
  !                condensational growth of the mode mean radii
  !  
  !    Authors:
  !    --------
  !    J. Wilson and E. Vignati, JRC (original source)            May 2000
  !    P. Stier, MPI-MET (f90 version, changes, comments)             2001
  !
  !    Purpose:
  !    --------
  !    This routine repartitions aerosol number and mass between the
  !    the modes to account for condensational growth and the formation
  !    of an accumulation mode from the upper tail of the aitken mode.
  !
  !    Interface:
  !    ----------
  !    *m7_dconc* is called from *m7*
  !
  !    Method:
  !    -------
  !    The routine calculates the cumulativ number and mass distribution of the
  !    modes up to the respective mode boundary:
  !
  !                        / x                              _
  !                 N      |       1           1   ln(R)-ln(R)  2
  !    N(0,x) = ---------  |   --------  exp(- - ( ----------- )   ) d ln(R) 
  !             ln(sigma)  |   sqrt(2PI)       2    ln(sigma)
  !                        / 0 
  !                         
  !                         /tx                   2
  !                        |        1            t
  !           =     N      |     --------  exp(- - ) d t 
  !                        |     sqrt(2PI)       2 
  !                        /-inf
  ! 
  !    where:                   
  !
  !                        _
  !               ln(R)-ln(R)
  !    t      =   -----------
  !                ln(sigma)
  !
  !    and:
  !                        _
  !               ln(x)-ln(R)
  !    tx     =   -----------
  !                ln(sigma)
  !    _
  !    R is the Count Mean Radius or the Mass Mean Radius.
  !
  !    Practically, the routine m7_cumnor calculates the fraction of the number and
  !    mass distribution for each mode lying below the respective upper mode boundary (1).
  !    In a next step the net fraction of each mode lying between the upper and lower
  !    mode boundaries are summed up (2) and the numbers and masses exceeding the mode
  !    boundaries are transfered to the neighboring larger mode (3). 
  !    Finally, these quantities are stored in the respective arrays
  !    paernl and paerml (4).
  !    The repartititioning is currently only done for the soluble modes as it is
  !    assumed that insoluble modes are rather transfered to the soluble modes 
  !    and grow as soluble particles.
  !
  !    Externals:
  !    ----------
  !    None
  !
  !--- Parameter list:
  !
  !    paerml(klon ,klev,naermod)= total aerosol mass for each compound 
  !                                [molec. cm-3 for sulfate and ug m-3 for others]
  !    paernl(klon ,klev,nmod)   = aerosol number for each mode [cm-3]  !
  !    sigma(jmod)               = standard deviation of mode jmod [1]
  !    crdiv                     = threshold radii between the different modes [cm]
  !                                crdiv(jmod) is the lower bound and crdiv(jmod+1) is 
  !                                the upper bound of the respective mode
  !
  !--- Local Variables:
  !
  !    zfconn(:,:,jnum,jmod)     = absolute fraction of the number of particles in mode jmod, 
  !                                with CMD=2*pm6dry(jmod) and a geometric standard 
  !                                deviation zrcsig, that are smaller than crdiv(jnum+1).
  !                                I.e. with 0 < CMD < crdiv(jnum+1) [1]
  !    zfconm(:,:,jnum,jmod)     = absolute fraction of the mass in mode jmod, 
  !                                with CMD=2*pm6dry(jmod) and a geometric standard 
  !                                deviation zrcsig, that are smaller than crdiv(jnum+1).
  !                                I.e. with 0 < CMD < crdiv(jnum+1) [1]
  ! 
  !  Modifications:
  !  --------------
  !  20091112: JJMorcrette, Adaptation to ECMWF IFS 
  !

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK    ,DR_HOOK

USE YO_AERO_M7 ,ONLY : sigma, crdiv,          &
  &                    nmod,  naermod, nsol,  &
  &                    iso4ns,iso4ks,  iso4as,&
  &                    ibcks, ibcas,   ibccs, &
  &                    iocks, iocas,   ioccs, &
  &                    issas, isscs,          &
  &                    iduas, iducs,          &
  &                    avo,     wh2so4,       &
  &                    dh2so4,dbc,     doc,   &
  &                    dnacl, ddust,          &
  &                    cmr2ram,cmedr2mmedr

USE YOMCST    ,ONLY : RPI
USE YOMLUN    ,ONLY : NULOUT

  IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN) :: kidia, kfdia, klon, klev

REAL(KIND=JPRB),INTENT(IN) :: & 
  & pm6dry(klon ,klev,nsol)
REAL(KIND=JPRB),INTENT(INOUT) :: & 
  & paerml(klon ,klev,naermod), paernl(klon ,klev,nmod)

  ! Local variables:
  !
INTEGER(KIND=JPIM) :: jmod,          jnum,          jl,           jk

REAL(KIND=JPRB):: zrcsig,        zarg1,         zarg2,        zdpmm,         zdpcm,   &
  &               zarg3,         zdpam,         zcongn,       zcongm,        zdummy,  &
  &               zr1,           zr2,           zttnj,        zavnj,         zmrj,    &
  &               zmt,           znt,           zavmt,        zmcr,                   &
  &               zntnew,        zdm,           zeps

REAL(KIND=JPRB):: zambc2(4),     zambc3(4),     zambc4(4),                            &
  &               zamoc2(4),     zamoc3(4),     zamoc4(4),                            &
  &               zamss3(4),     zamss4(4),                                           &
  &               zamdu3(4),     zamdu4(4)

REAL(KIND=JPRB):: ztotmass(klon ,klev)

REAL(KIND=JPRB):: zsumn(klon ,klev,nmod),       zsumm(klon ,klev,nmod),               &
  &               zsumbc(klon ,klev,3),         zsumoc(klon ,klev,3),                 &
  &               zsumss(klon ,klev,2),         zsumdu(klon ,klev,2)
 
REAL(KIND=JPRB):: zfconn(klon ,klev,nsol,nsol), zfconm(klon ,klev,nsol,nsol)

#include "m7_cumnor.intfb.h"

REAL(KIND=JPRB) :: ZHOOK_HANDLE
!--------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('M7_DCONC',0,ZHOOK_HANDLE)

  !--- 0) Initialisations: ----------------------------------------------------------

!!  zeps=EPSILON(1.0_JPRB)
!  zeps=100._JPRB*TINY(1.0_JPRB)
  zeps=1.E-32_JPRB

  WRITE(NULOUT,FMT='(''m7_dconc ZEPS, NSOL ='',E10.3,I5)') zeps, nsol 

  zsumn(:,:,:)    = 0._JPRB
  zsumm(:,:,:)    = 0._JPRB
  zsumbc(:,:,:)   = 0._JPRB
  zsumoc(:,:,:)   = 0._JPRB
  zsumss(:,:,:)   = 0._JPRB
  zsumdu(:,:,:)   = 0._JPRB

  zfconm(:,:,:,:) = 0._JPRB
  zfconn(:,:,:,:) = 0._JPRB

  !
  !--- 1) Identify how much the mode jmod has grown into the next higher mode -------
  !
  DO jmod=1,nsol-1

     !--- Total mass of the mode in equivalent molecules of sulfate:

     SELECT CASE(jmod)
     CASE(1)
        ztotmass(kidia:kfdia,:) = paerml(kidia:kfdia,:,iso4ns)
     CASE(2)
        ztotmass(kidia:kfdia,:) = paerml(kidia:kfdia,:,iso4ks) + &
          &                      (paerml(kidia:kfdia,:,ibcks)/dbc+paerml(kidia:kfdia,:,iocks)/doc)  &
          &                      *dh2so4/wh2so4*avo*1.E-12_JPRB
     CASE(3)
        ztotmass(kidia:kfdia,:) = paerml(kidia:kfdia,:,iso4as) + &
          &                      (paerml(kidia:kfdia,:,ibcas)/dbc+paerml(kidia:kfdia,:,iocas)/doc+  &
          &                       paerml(kidia:kfdia,:,issas)/dnacl+paerml(kidia:kfdia,:,iduas)/ddust) &
          &                      *dh2so4/wh2so4*avo*1.E-12_JPRB
     END SELECT

     DO jnum=jmod,nsol-1
        DO jk=1,klev
           DO jl=kidia,kfdia
              IF (paernl(jl,jk,jmod)  >  zeps .AND. pm6dry(jl,jk,jmod)  >  0.0_JPRB) THEN

                WRITE(NULOUT,FMT='(''m7_dconc_1 '',4I5,2E12.5)') jnum,jmod,jk,jl, paernl(jl,jk,jmod),pm6dry(jl,jk,jmod) 

                 !--- 1.1) Calculate necessary parameters:                 

                 !--- Geometric Standard Deviation:
                 zrcsig=LOG(sigma(jmod))

                 !--- Mass Median Radius:
                 zarg1=pm6dry(jl,jk,jmod)*cmedr2mmedr(jmod)

                 !--- Count Median Radius:
                 zarg2=pm6dry(jl,jk,jmod)

                 !--- Threshold radius between the modes:
                 zarg3=crdiv(jnum+1)

                 !--- Transfer to logarithmic scale:
                 zdpmm=LOG(zarg1)
                 zdpcm=LOG(zarg2)
                 zdpam=LOG(zarg3)

                 !--- Distance of the CMD of the mode from the threshold mode  
                 !    diameter in terms of geometric standard deviations:

                 zcongn=(zdpam-zdpcm)/zrcsig

                 !--- Distance of the MMD of the mode from the threshold mode  
                 !    diameter in terms of geometric standard deviations (t):

                 zcongm=(zdpam-zdpmm)/zrcsig

                 !--- Calculate the cumulative of the log-normal number distribution:

                 CALL m7_cumnor(zcongn,zfconn(jl,jk,jnum,jmod),zdummy)

                 !--- Limit transfer only to adjacent modes:

                 IF (jnum  >  jmod) THEN
                    zfconn(jl,jk,jnum,jmod)= 1.0_JPRB
                 ENDIF

                 !--- Set minimum radius and maximum radius:

                 zr1 = crdiv(jmod)
                 zr2 = crdiv(jmod+1)

                 !--- Radius of average mass for a lognormal distribution

                 zdm = EXP((LOG(zr1)+LOG(zr2))/2.0_JPRB)*cmr2ram(jmod)

                 !--- Average mass contained in the mode

                 zttnj = ztotmass(jl,jk)/paernl(jl,jk,jmod)

                 !--- Average number of sulfate molecules or equivalent for mixed modes,
                 !    for a particle with radius zdm

                 zavnj=zdm**3.0_JPRB*rpi*avo*dh2so4/wh2so4/0.75_JPRB

                 !--- If the average mass contained in the mode is larger than the average mass
                 !    for a particle with radius zdm, the transfer of number and mass is done,
                 !    else there is no transfer

                 IF (zttnj  >  zavnj .AND. jnum  ==  jmod) THEN

                    !--- Mass remaining in the mode

                    zmrj=zfconn(jl,jk,jnum,jmod)*paernl(jl,jk,jmod)*zavnj

                    !--- Mass transferred

                    zmt=ztotmass(jl,jk)-zmrj

                    !--- Numbers transferred 

                    znt=(1.0_JPRB-zfconn(jl,jk,jnum,jmod))*paernl(jl,jk,jmod)

                    !--- Average mass of particles transferred

                    IF(znt>zeps) THEN
                       zavmt=zmt/znt
                    ELSE
                       zavmt=0._JPRB
                    ENDIF

                    !--- Average mass of particles of radius zr2

                    zmcr=(zr2*cmr2ram(jmod))**3*rpi*avo*dh2so4/wh2so4/0.75_JPRB

                    !--- If the average mass of particle transferred is smaller than the average mass
                    !    mass of particles with radius zr2 then reduce the particles transferred
                    !    so that zavmt=zmcr, else calculate the mass fraction transferred zfconmj

                    IF (zavmt  <  zmcr) THEN
                       zntnew = zmt/zmcr
                       zfconn(jl,jk,jnum,jmod) = 1.0_JPRB - zntnew/paernl(jl,jk,jmod)
                    ENDIF
                    zfconm(jl,jk,jnum,jmod)=zmrj/ztotmass(jl,jk)
                 ELSE
                    zfconn(jl,jk,jnum,jmod)=1._JPRB
                    zfconm(jl,jk,jnum,jmod)=1._JPRB
                 ENDIF
              ELSE
                 zfconn(jl,jk,jnum,jmod)=1._JPRB
                 zfconm(jl,jk,jnum,jmod)=1._JPRB
              ENDIF
           ENDDO
        ENDDO
     ENDDO
  ENDDO

  DO jmod=1,nsol
     DO jk=1,klev
        DO jl=kidia,kfdia           

           !--- 2) Calculate the net fraction of mode jmod that is transfered -------
           !       to the mode jnew zfconn(:,:,jnew,jmod) :
           
           !--- Numbers:
           zfconn(jl,jk,4,jmod)=1.0_JPRB            -zfconn(jl,jk,3,jmod)
           zfconn(jl,jk,3,jmod)=zfconn(jl,jk,3,jmod)-zfconn(jl,jk,2,jmod)
           zfconn(jl,jk,2,jmod)=zfconn(jl,jk,2,jmod)-zfconn(jl,jk,1,jmod)

           !--- Mass:
           zfconm(jl,jk,4,jmod)=1.0_JPRB            -zfconm(jl,jk,3,jmod)
           zfconm(jl,jk,3,jmod)=zfconm(jl,jk,3,jmod)-zfconm(jl,jk,2,jmod)
           zfconm(jl,jk,2,jmod)=zfconm(jl,jk,2,jmod)-zfconm(jl,jk,1,jmod)

           !--- 3) Sum the net masses and numbers transfered between the modes: -----

           !--- 3.1) Soluble mode numbers and sulfate mass:

           zsumn(jl,jk,1)=zsumn(jl,jk,1)+paernl(jl,jk,jmod)*zfconn(jl,jk,1,jmod)
           zsumm(jl,jk,1)=zsumm(jl,jk,1)+paerml(jl,jk,jmod)*zfconm(jl,jk,1,jmod)
           zsumn(jl,jk,2)=zsumn(jl,jk,2)+paernl(jl,jk,jmod)*zfconn(jl,jk,2,jmod)
           zsumm(jl,jk,2)=zsumm(jl,jk,2)+paerml(jl,jk,jmod)*zfconm(jl,jk,2,jmod)
           zsumn(jl,jk,3)=zsumn(jl,jk,3)+paernl(jl,jk,jmod)*zfconn(jl,jk,3,jmod)
           zsumm(jl,jk,3)=zsumm(jl,jk,3)+paerml(jl,jk,jmod)*zfconm(jl,jk,3,jmod)
           zsumn(jl,jk,4)=zsumn(jl,jk,4)+paernl(jl,jk,jmod)*zfconn(jl,jk,4,jmod)
           zsumm(jl,jk,4)=zsumm(jl,jk,4)+paerml(jl,jk,jmod)*zfconm(jl,jk,4,jmod)

        ENDDO
     ENDDO
  ENDDO

  DO jk=1,klev
     DO jl=kidia,kfdia

        !--- 3.2) Non-sulfate masses:

        zambc2(2)=paerml(jl,jk,ibcks)*zfconm(jl,jk,2,2)
        zambc2(3)=paerml(jl,jk,ibcks)*zfconm(jl,jk,3,2)
        zambc2(4)=paerml(jl,jk,ibcks)*zfconm(jl,jk,4,2)
        zamoc2(2)=paerml(jl,jk,iocks)*zfconm(jl,jk,2,2)
        zamoc2(3)=paerml(jl,jk,iocks)*zfconm(jl,jk,3,2)
        zamoc2(4)=paerml(jl,jk,iocks)*zfconm(jl,jk,4,2)
        zambc3(3)=paerml(jl,jk,ibcas)*zfconm(jl,jk,3,3)
        zambc3(4)=paerml(jl,jk,ibcas)*zfconm(jl,jk,4,3)
        zamoc3(3)=paerml(jl,jk,iocas)*zfconm(jl,jk,3,3)
        zamoc3(4)=paerml(jl,jk,iocas)*zfconm(jl,jk,4,3)
        zambc4(4)=paerml(jl,jk,ibccs)
        zamoc4(4)=paerml(jl,jk,ioccs)
        zamss3(3)=paerml(jl,jk,issas)*zfconm(jl,jk,3,3)
        zamss3(4)=paerml(jl,jk,issas)*zfconm(jl,jk,4,3)
        zamdu3(3)=paerml(jl,jk,iduas)*zfconm(jl,jk,3,3)
        zamdu3(4)=paerml(jl,jk,iduas)*zfconm(jl,jk,4,3)
        zamss4(4)=paerml(jl,jk,isscs)
        zamdu4(4)=paerml(jl,jk,iducs)
        
        zsumbc(jl,jk,1)=zambc2(2)
        zsumbc(jl,jk,2)=zambc2(3)+zambc3(3)
        zsumbc(jl,jk,3)=zambc2(4)+zambc3(4)+zambc4(4)
        zsumoc(jl,jk,1)=zamoc2(2)
        zsumoc(jl,jk,2)=zamoc2(3)+zamoc3(3)
        zsumoc(jl,jk,3)=zamoc2(4)+zamoc3(4)+zamoc4(4)
        zsumss(jl,jk,1)=zamss3(3)
        zsumss(jl,jk,2)=zamss3(4)+zamss4(4)
        zsumdu(jl,jk,1)=zamdu3(3)
        zsumdu(jl,jk,2)=zamdu3(4)+zamdu4(4)

     ENDDO
  ENDDO

  !--- 4) Store final masses and numbers of the modes: ------------------------

  DO jmod=1,nsol
     DO jk=1,klev
        DO jl=kidia,kfdia

           !--- Particle numbers:

           paernl(jl,jk,jmod)=zsumn(jl,jk,jmod)

           !--- Sulfate mass:

           paerml(jl,jk,jmod)=zsumm(jl,jk,jmod)

        ENDDO
     ENDDO
  ENDDO

  !--- Non sulfate masses:

  DO jk=1,klev
     DO jl=kidia,kfdia

        paerml(jl,jk,ibcks)=zsumbc(jl,jk,1)
        paerml(jl,jk,ibcas)=zsumbc(jl,jk,2)
        paerml(jl,jk,ibccs)=zsumbc(jl,jk,3)
        paerml(jl,jk,iocks)=zsumoc(jl,jk,1)
        paerml(jl,jk,iocas)=zsumoc(jl,jk,2)
        paerml(jl,jk,ioccs)=zsumoc(jl,jk,3)
        paerml(jl,jk,issas)=zsumss(jl,jk,1)
        paerml(jl,jk,isscs)=zsumss(jl,jk,2)
        paerml(jl,jk,iduas)=zsumdu(jl,jk,1)
        paerml(jl,jk,iducs)=zsumdu(jl,jk,2)

     ENDDO
  ENDDO

!--------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('M7_DCONC',1,ZHOOK_HANDLE)
END SUBROUTINE m7_dconc
