      SUBROUTINE SCMICP(CIDDNC,CIDDNSL,CIDDNIS,CINUIO,CIKAPPA,CIEPSM, &
                        CIMOLW,CIWETRB,CEWETRB,PIFRC,PEWETRC,PIWETRC, &
                        ILGA,LEVA)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     CALCULATION OF DRY AEROSOL DENSITIES, NUMBER OF DISSOLVED IONS,
!     THEIR MOLECULAR WEIGHT, AND MASS FRACTION OF SOLUBLE MATERIAL
!     FOR INTERNALLY MIXED AEROSOL FOR PURPOSE OF AEROSOL ACTIVATION
!     CALCULATIONS. ONLY SUB-SECTIONS WITH POTENTIALLY AT LEAST ONE
!     SOLUBLE SPECIES ARE CONSIDERED.
!
!     HISTORY:
!     --------
!     * NOV 03,2011 - K.VONSALZEN   MODIFY MIXING RULES
!     * SEP 09/2009 - K.VONSALZEN   ADD CALCULATION OF WET PARICLE
!                                   RADIUS
!     * APR 04/2006 - K.VONSALZEN   NEW.
!
!-----------------------------------------------------------------------
!
      USE SCPARM
      USE SDPARM
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIFRC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAEXT) :: &
                                               PEWETRC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT) :: &
                                               PIWETRC
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISINT) :: CIDDNC
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISINTB) :: CIDDNSL, &
                                           CIDDNIS,CINUIO,CIKAPPA, &
                                           CIEPSM,CIMOLW,CIWETRB
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISEXTB) :: &
                                           CEWETRB
      REAL, ALLOCATABLE, DIMENSION(:,:) :: AMSL,AVSL,AMIS,AVIS,ANUIO, &
                                           KAPPA,AMOLW,DVOL
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: DM,DV,DMSL0,DVSL0,DMIS0, &
                                             DVIS0,NUIO0,KAPPA0,MOLW0
      REAL, DIMENSION(ILGA,LEVA) :: GRWTHF
!
!-----------------------------------------------------------------------
!
      IF ( ISINTB > 0 ) THEN
!
!       * ALLOCATE WORK ARRAYS.
!
        ALLOCATE(DM    (ILGA,LEVA,ISWINT))
        ALLOCATE(DV    (ILGA,LEVA,ISWINT))
        ALLOCATE(DMSL0 (ILGA,LEVA,ISWINT))
        ALLOCATE(DMIS0 (ILGA,LEVA,ISWINT))
        ALLOCATE(DVSL0 (ILGA,LEVA,ISWINT))
        ALLOCATE(DVIS0 (ILGA,LEVA,ISWINT))
        ALLOCATE(NUIO0 (ILGA,LEVA,ISWINT))
        ALLOCATE(KAPPA0(ILGA,LEVA,ISWINT))
        ALLOCATE(MOLW0 (ILGA,LEVA,ISWINT))
        ALLOCATE(AMSL  (ILGA,LEVA))
        ALLOCATE(AVSL  (ILGA,LEVA))
        ALLOCATE(AMIS  (ILGA,LEVA))
        ALLOCATE(AVIS  (ILGA,LEVA))
        ALLOCATE(ANUIO (ILGA,LEVA))
        ALLOCATE(KAPPA (ILGA,LEVA))
        ALLOCATE(AMOLW (ILGA,LEVA))
        ALLOCATE(DVOL  (ILGA,LEVA))
!
!       * MASSES AND VOLUMES FOR SOLUBLE (SL) AND INSOLUBLE (IS)
!       * AEROSOL FRACTIONS, MEAN NUMBER OF DISSOCIATED IONS, AND THEIR
!       * MOLECULAR WEIGHT IN EACH SECTION. WEIGHTING BY VOLUME FOR
!       * MICROPHYSICAL PARAMETERS (ZSR RULE).
!
        DMSL0 =0.
        DMIS0 =0.
        DVSL0 =0.
        DVIS0 =0.
        NUIO0 =0.
        KAPPA0=0.
        MOLW0 =0.
        DO IS=1,ISWINT
          DO KXT=1,SINTF%ISWET(IS)%ITYPT
            KX=SINTF%ISWET(IS)%ITYP(KXT)
            ISI=SINTF%ISWET(IS)%ISI
            DVOL=PIFRC(:,:,ISI,KX)/AINTF%TP(KX)%DENS
            IF (     (ABS(AINTF%TP(KX)%NUIO-YNA) > YTINY &
                                      .AND. AINTF%TP(KX)%NUIO  > YTINY) &
                .OR. (ABS(AINTF%TP(KX)%KAPPA-YNA) > YTINY &
                               .AND. AINTF%TP(KX)%KAPPA > YTINY) ) THEN
              DMSL0 (:,:,IS)=DMSL0 (:,:,IS)+PIFRC(:,:,ISI,KX)
              DVSL0 (:,:,IS)=DVSL0 (:,:,IS)+DVOL(:,:)
              NUIO0 (:,:,IS)=NUIO0 (:,:,IS)+DVOL(:,:)*AINTF%TP(KX)%NUIO
              KAPPA0(:,:,IS)=KAPPA0(:,:,IS)+DVOL(:,:)*AINTF%TP(KX)%KAPPA
              MOLW0 (:,:,IS)=MOLW0 (:,:,IS)+DVOL(:,:)*AINTF%TP(KX)%MOLW
            ELSE
              DMIS0 (:,:,IS)=DMIS0 (:,:,IS)+PIFRC(:,:,ISI,KX)
              DVIS0 (:,:,IS)=DVIS0 (:,:,IS)+DVOL(:,:)
            ENDIF
          ENDDO
        ENDDO
        DM=DMSL0+DMIS0
        DV=DVSL0+DVIS0
!
!       * DENSITY OF TOTAL DRY AEROSOL IN THE CENTRE OF SUB-SECTIONS.
!       * FOR EACH SUB-SECTION, THE DENSITY IS THE SAME AS IN THE
!       * DENSITY FOR THE SECTIONS IN WHICH IN THE SUB-SECTION RESIDES.
!
        CIDDNC=YNA
        ISC=0
        DO IS=1,ISWINT
          DO IST=1,ISESC
            ISC=ISC+1
            DO L=1,LEVA
            DO IL=1,ILGA
              IF ( DV(IL,L,IS) > MAX(DM(IL,L,IS)/YLARGE,YTINY) ) THEN
                CIDDNC(IL,L,ISC)=DM(IL,L,IS)/DV(IL,L,IS)
              ENDIF
            ENDDO
            ENDDO
          ENDDO
        ENDDO
!
!       * DENSITIES FOR SOLUBLE (DNSL) AND INSOLUBLE (DNIS) AEROSOL
!       * FRACTIONS AT BOUNDARIES OF SUB-SECTIONS FROM LINEAR
!       * INTERPOLATION OF PARICLE MASSES AND VOLUMES BETWEEN THE
!       * MID-POINTS OF THE PLA SIZE SECTIONS. THE SAME APPROACH
!       * IS USED TO CALCULATE THE MEAN NUMBER OF IONS IN SOLUTION AND
!       * THE CORRESPONDING MOLECULAR WEIGHT.
!
        CIDDNSL=YNA
        CIDDNIS=YNA
        CINUIO =YNA
        CIKAPPA=YNA
        CIEPSM =YNA
        CIMOLW =YNA
        DPRAT=1./REAL(ISESC)
        IS=1
        DO ISC=1,ISESC/2
          DO L=1,LEVA
          DO IL=1,ILGA
            IF ( DVSL0(IL,L,IS) > YTINY ) THEN
              CIDDNSL(IL,L,ISC)=DMSL0 (IL,L,IS)/DVSL0(IL,L,IS)
              CINUIO (IL,L,ISC)=NUIO0 (IL,L,IS)/DVSL0(IL,L,IS)
              CIKAPPA(IL,L,ISC)=KAPPA0(IL,L,IS)/DVSL0(IL,L,IS)
              CIMOLW (IL,L,ISC)=MOLW0 (IL,L,IS)/DVSL0(IL,L,IS)
            ENDIF
            IF ( DVIS0(IL,L,IS) > YTINY ) THEN
              CIDDNIS(IL,L,ISC)=DMIS0(IL,L,IS)/DVIS0(IL,L,IS)
            ENDIF
            IF ( DM(IL,L,IS) > YTINY ) THEN
              CIEPSM (IL,L,ISC)=DMSL0(IL,L,IS)/DM(IL,L,IS)
            ENDIF
          ENDDO
          ENDDO
        ENDDO
        ISC=ISESC/2
        DO IS=1,ISWINT-1
          DO IST=1,ISESC
            ISC=ISC+1
            AFAC=REAL(IST-1)*DPRAT
            AMSL (:,:)=DMSL0 (:,:,IS)*(1.-AFAC)+DMSL0 (:,:,IS+1)*AFAC
            AVSL (:,:)=DVSL0 (:,:,IS)*(1.-AFAC)+DVSL0 (:,:,IS+1)*AFAC
            AMIS (:,:)=DMIS0 (:,:,IS)*(1.-AFAC)+DMIS0 (:,:,IS+1)*AFAC
            AVIS (:,:)=DVIS0 (:,:,IS)*(1.-AFAC)+DVIS0 (:,:,IS+1)*AFAC
            ANUIO(:,:)=NUIO0 (:,:,IS)*(1.-AFAC)+NUIO0 (:,:,IS+1)*AFAC
            KAPPA(:,:)=KAPPA0(:,:,IS)*(1.-AFAC)+KAPPA0(:,:,IS+1)*AFAC
            AMOLW(:,:)=MOLW0 (:,:,IS)*(1.-AFAC)+MOLW0 (:,:,IS+1)*AFAC
            DO L=1,LEVA
            DO IL=1,ILGA
              IF ( AVSL(IL,L) > YTINY ) THEN
                CIDDNSL(IL,L,ISC)=AMSL (IL,L)/AVSL(IL,L)
                CINUIO (IL,L,ISC)=ANUIO(IL,L)/AVSL(IL,L)
                CIKAPPA(IL,L,ISC)=KAPPA(IL,L)/AVSL(IL,L)
                CIMOLW (IL,L,ISC)=AMOLW(IL,L)/AVSL(IL,L)
              ENDIF
              IF ( AVIS(IL,L) > YTINY ) THEN
                CIDDNIS(IL,L,ISC)=AMIS(IL,L)/AVIS(IL,L)
              ENDIF
              IF ( (AMSL(IL,L)+AMIS(IL,L)) > YTINY ) THEN
                CIEPSM (IL,L,ISC)=AMSL(IL,L)/(AMSL(IL,L)+AMIS(IL,L))
              ENDIF
            ENDDO
            ENDDO
          ENDDO
        ENDDO
        IS=ISWINT
        DO ISC=ISINTB-ISESC/2,ISINTB
          DO L=1,LEVA
          DO IL=1,ILGA
            IF ( DVSL0(IL,L,IS) > YTINY ) THEN
              CIDDNSL(IL,L,ISC)=DMSL0 (IL,L,IS)/DVSL0(IL,L,IS)
              CINUIO (IL,L,ISC)=NUIO0 (IL,L,IS)/DVSL0(IL,L,IS)
              CIKAPPA(IL,L,ISC)=KAPPA0(IL,L,IS)/DVSL0(IL,L,IS)
              CIMOLW (IL,L,ISC)=MOLW0 (IL,L,IS)/DVSL0(IL,L,IS)
            ENDIF
            IF ( DVIS0(IL,L,IS) > YTINY ) THEN
              CIDDNIS(IL,L,ISC)=DMIS0(IL,L,IS)/DVIS0(IL,L,IS)
            ENDIF
            IF ( DM(IL,L,IS) > YTINY ) THEN
              CIEPSM (IL,L,ISC)=DMSL0(IL,L,IS)/DM(IL,L,IS)
            ENDIF
          ENDDO
          ENDDO
        ENDDO
!
!       * DEALLOCATE WORK ARRAYS.
!
        DEALLOCATE(DM)
        DEALLOCATE(DV)
        DEALLOCATE(DMSL0)
        DEALLOCATE(DMIS0)
        DEALLOCATE(DVSL0)
        DEALLOCATE(DVIS0)
        DEALLOCATE(NUIO0)
        DEALLOCATE(KAPPA0)
        DEALLOCATE(MOLW0)
        DEALLOCATE(AMSL)
        DEALLOCATE(AVSL)
        DEALLOCATE(AMIS)
        DEALLOCATE(AVIS)
        DEALLOCATE(ANUIO)
        DEALLOCATE(KAPPA)
        DEALLOCATE(AMOLW)
        DEALLOCATE(DVOL)
      ENDIF
!
!     * SUPERSATURATION.
!
!      YSMALL2=1.E-06
!      WHERE ( ABS(SV) >= YSMALL2 )
!        SVT=SV
!      ELSEWHERE
!        SVT=-YSMALL2
!      ENDWHERE
!
!     * EQUILIBRIUM PARTICLE SIZES FOR GIVEN SUPERATURATION.
!
!      IF ( ISEXTB > 0 ) THEN
!        CALL EQUIS(CEWETRB,CEDRYRB,CEBK,AK,SVT,ILGA,LEVA,ISEXTB)
!      ENDIF
!      IF ( ISINTB > 0 ) THEN
!        CALL EQUIS(CIWETRB,CIDRYRB,CEBK,AK,SVT,ILGA,LEVA,ISINTB)
!      ENDIF
!      IF ( ISEXTB > 0 ) THEN
!        DO IS=1,ISEXTB
!          CEWETRB(:,:,IS)=2.*CEDRYRB(IS)
!        ENDDO
!      ENDIF
!      IF ( ISINTB > 0 ) THEN
!        DO IS=1,ISINTB
!          CIWETRB(:,:,IS)=2.*CIDRYRB(IS)
!        ENDDO
!      ENDIF
!
!     * EQUILIBRIUM PARTICLE SIZES FOR UNDERSATURATED CONDITIONS.
!     * SIMPLY APPLY THE SAME GROWTH FACTOR WITHIN EACH PLA SECTION
!     * IN CALCULATION OF PARTICLE SIZES AT BOUNDARIES OF SMALLER
!     * SECTIONS.
!
      IF ( ISEXTB > 0 ) THEN
        ISC=0
        DO IS=1,ISWEXT-1
          ISM=SEXTF%ISWET(IS)%ISM
          KX =SEXTF%ISWET(IS)%ITYP
          KXP=SEXTF%ISWET(IS+1)%ITYP
          GRWTHF=PEWETRC(:,:,ISM)/PEDRYRC(ISM)
          DO IST=1,ISESC
            ISC=ISC+1
            CEWETRB(:,:,ISC)=GRWTHF*CEDRYRB(ISC)
          ENDDO
          IF ( KXP /= KX ) THEN
            ISC=ISC+1
            CEWETRB(:,:,ISC)=GRWTHF*CEDRYRB(ISC)
          ENDIF
        ENDDO
        IS=ISWEXT
        ISM=SEXTF%ISWET(IS)%ISM
        GRWTHF=PEWETRC(:,:,ISM)/PEDRYRC(ISM)
        DO IST=1,ISESC
          ISC=ISC+1
          CEWETRB(:,:,ISC)=GRWTHF*CEDRYRB(ISC)
        ENDDO
        ISC=ISC+1
        CEWETRB(:,:,ISC)=GRWTHF*CEDRYRB(ISC)
      ENDIF
      IF ( ISINTB > 0 ) THEN
        ISC=0
        DO IS=1,ISWINT
          GRWTHF=PIWETRC(:,:,IS)/PIDRYRC(IS)
          DO IST=1,ISESC
            ISC=ISC+1
            CIWETRB(:,:,ISC)=GRWTHF*CIDRYRB(ISC)
          ENDDO
        ENDDO
        IS=ISWINT
        GRWTHF=PIWETRC(:,:,IS)/PIDRYRC(IS)
        ISC=ISC+1
        CIWETRB(:,:,ISC)=GRWTHF*CIDRYRB(ISC)
      ENDIF
!
      END SUBROUTINE SCMICP
