      SUBROUTINE CNCDNCA(CECDNC,CERCI,CICDNC,CIRCI,CEWETRB,CERC,CESC, &
                         CIWETRB,CIRC,CISC,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                         PEDPHI0,PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0,SV, &
                         ILGA,LEVA)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     DIAGNOSIS OF CLOUD-CONDENSATION NUCLEI (CCN) CONCENTRATION BASED
!     ON DRY SIZE DISTRIBUTION AND SUPERSATURATION.
!
!     HISTORY:
!     --------
!     * JUN 20/2008 - K.VONSALZEW   BUG FIX FOR KAPPA MODEL FOR
!                                   EXTERNALLY MIXED SPECIES.
!     * AUG 11/2006 - K.VONSALZEN   NEW.
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE SDCODE
      USE SCPARM
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      INTEGER, INTENT(IN) :: ILGA,LEVA
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: SV
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISEXTB) :: &
                                               CEWETRB,CERC,CESC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISINTB) :: &
                                               CIWETRB,CIRC,CISC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAEXT) :: &
                                               PEN0,PEPHI0,PEPSI, &
                                               PEPHIS0,PEDPHI0
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT) :: &
                                               PIN0,PIPHI0,PIPSI, &
                                               PIPHIS0,PIDPHI0
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA) :: CICDNC,CIRCI
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,KEXT) :: CECDNC,CERCI
      LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: TIACT,TEACT,KFRST
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CIISI
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: CEISI
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: TIDPHIS,TIPHISS, &
                                             TISDF,TINUM,TIPN0,TIPHI0, &
                                             TIPSI, &
                                             TEDPHIS,TEPHISS, &
                                             TESDF,TENUM,TEPN0,TEPHI0, &
                                             TEPSI
!
!-----------------------------------------------------------------------
!     * ALLOCATE WORK ARRAYS.
!
      IF ( KEXT > 0 ) THEN
        ALLOCATE(KFRST(ILGA,LEVA,KEXT))
        ALLOCATE(CEISI(ILGA,LEVA,KEXT))
      ENDIF
      IF ( ISWEXT > 0 ) THEN
        ALLOCATE(TEPN0  (ILGA,LEVA,ISWEXT))
        ALLOCATE(TEPHI0 (ILGA,LEVA,ISWEXT))
        ALLOCATE(TEPSI  (ILGA,LEVA,ISWEXT))
        ALLOCATE(TEDPHIS(ILGA,LEVA,ISWEXT))
        ALLOCATE(TEPHISS(ILGA,LEVA,ISWEXT))
        ALLOCATE(TESDF  (ILGA,LEVA,ISWEXT))
        ALLOCATE(TENUM  (ILGA,LEVA,ISWEXT))
        ALLOCATE(TEACT  (ILGA,LEVA,ISWEXT))
      ENDIF
      IF ( KINT > 0 ) THEN
        ALLOCATE(CIISI(ILGA,LEVA))
      ENDIF
      IF ( ISWINT > 0 ) THEN
        ALLOCATE(TIPN0  (ILGA,LEVA,ISWINT))
        ALLOCATE(TIPHI0 (ILGA,LEVA,ISWINT))
        ALLOCATE(TIPSI  (ILGA,LEVA,ISWINT))
        ALLOCATE(TIDPHIS(ILGA,LEVA,ISWINT))
        ALLOCATE(TIPHISS(ILGA,LEVA,ISWINT))
        ALLOCATE(TISDF  (ILGA,LEVA,ISWINT))
        ALLOCATE(TINUM  (ILGA,LEVA,ISWINT))
        ALLOCATE(TIACT  (ILGA,LEVA,ISWINT))
      ENDIF
!
!-----------------------------------------------------------------------
!     * LINERALY INTERPOLATE CRITICAL RADII BETWEEN SECTION BOUNDARIES
!     * FOR EACH EXTERNALLY MIXED AEROSOL TYPE TO FIND MATCHING CRITICAL
!     * RADIUS THAT CORRESPONDS TO ACTUAL SUPERSATURATION.
!
      IF ( ISEXTB > 0 ) THEN
        CEISI=INA
        DO KX=1,KEXT
          ISMAX=PEISMXK(KX)
          RMAX=PEDRYR(ISMAX)%VR
          CERCI(:,:,KX)=RMAX
        ENDDO
        KFRST=.TRUE.
        TEACT=.FALSE.
        DO IS=1,ISEXTB-1
          IF ( CEKX(IS) == CEKX(IS+1) ) THEN
            ISM=SEXTF%ISWET(CEIS(IS))%ISM
            ISMIN=PEISMIN(ISM)
            ISMAX=PEISMAX(ISM)
            RMIN=PEDRYR(ISMIN)%VL
            RMAX=PEDRYR(ISMAX)%VR
            DO L=1,LEVA
            DO IL=1,ILGA
              IF (       ABS(CESC(IL,L,IS  )-YNA) > YTINY &
                   .AND. ABS(CESC(IL,L,IS+1)-YNA) > YTINY &
                                          .AND. SV(IL,L) > YTINY ) THEN
!
!               * SET ACTIVATION SIZE TO SIZE OF SMALLEST PARTICLE
!               * IF SUPERSATURATION LARGE ENOUGH TO ACTIVATE THESE
!               * PARTICLES.
!
                IF ( KFRST(IL,L,CEKX(IS)) ) THEN
                  IF ( SV(IL,L) > CESC(IL,L,IS) ) THEN
                    CEISI(IL,L,CEKX(IS))=CEIS(IS)
                    CERCI(IL,L,CEKX(IS))=RMIN
                  ENDIF
                  KFRST(IL,L,CEKX(IS))=.FALSE.
                ENDIF
!
!               * ACTIVATION SIZE FROM LINEAR INTERPOLATION BETWEEN
!               * BOUNDARIES OF EACH SUB-SECTION.
!
                IF ( SV(IL,L) >= CESC(IL,L,IS+1) &
                                  .AND. SV(IL,L) < CESC(IL,L,IS) ) THEN
                  RCIT=CERC(IL,L,IS)+(SV(IL,L)-CESC(IL,L,IS)) &
                                    *(CERC(IL,L,IS+1)-CERC(IL,L,IS)) &
                                    /(CESC(IL,L,IS+1)-CESC(IL,L,IS))
                ELSE
                  RCIT=YNA
                ENDIF
                IF (  (RCIT>=CERC(IL,L,IS) .AND. RCIT<=CERC(IL,L,IS+1)) &
                 .OR. (RCIT<=CERC(IL,L,IS) .AND. RCIT>=CERC(IL,L,IS+1)) &
                                                                 ) THEN
                  CEISI(IL,L,CEKX(IS))=CEIS(IS)
!
!                 * GROWTH FACTOR FOR FIRST ACTIVATED PARTICLE.
!
                  GRWFL=CERC(IL,L,IS  )/CEDRYRB(IS  )
                  GRWFH=CERC(IL,L,IS+1)/CEDRYRB(IS+1)
                  GRWFT=GRWFL+(SV(IL,L)-CESC(IL,L,IS))*(GRWFH-GRWFL) &
                                       /(CESC(IL,L,IS+1)-CESC(IL,L,IS))
                  CERCI(IL,L,CEKX(IS))=RCIT/GRWFT
                ENDIF
!
!               * CHECK IF CONDENSATE PRESENT.
!
                IF (      YSEC*CEWETRB(IL,L,IS  )>CEDRYRB(IS  ) &
                     .OR. YSEC*CEWETRB(IL,L,IS+1)>CEDRYRB(IS+1)  ) THEN
                  TEACT(IL,L,CEIS(IS))=.TRUE.
                ENDIF
              ENDIF
            ENDDO
            ENDDO
          ENDIF
        ENDDO
      ENDIF
!
!     * LINERALY INTERPOLATE CRITICAL RADII BETWEEN SECTION BOUNDARIES
!     * FOR EACH INTERNALLY MIXED AEROSOL TYPE TO FIND MATCHING CRITICAL
!     * RADIUS THAT CORRESPONDS TO ACTUAL SUPERSATURATION.
!
      IF ( ISINTB > 0 ) THEN
        CIISI=INA
        RMIN=PIDRYR(1)%VL
        RMAX=PIDRYR(ISAINT)%VR
        CIRCI=RMAX
!
!       * SET ACTIVATION SIZE TO SIZE OF SMALLEST PARTICLE
!       * IF SUPERSATURATION LARGE ENOUGH TO ACTIVATE THESE
!       * PARTICLES.
!
        IS=1
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( ABS(CISC(IL,L,IS)-YNA) > YTINY .AND. SV(IL,L) > YTINY &
                                                                ) THEN
            IF ( SV(IL,L) > CISC(IL,L,IS) ) THEN
              CIISI(IL,L)=CIIS(IS)
              CIRCI(IL,L)=RMIN
            ENDIF
          ENDIF
        ENDDO
        ENDDO
        TIACT=.FALSE.
        DO IS=1,ISINTB-1
        DO L=1,LEVA
        DO IL=1,ILGA
          IF (       ABS(CISC(IL,L,IS  )-YNA) > YTINY &
               .AND. ABS(CISC(IL,L,IS+1)-YNA) > YTINY &
                                         .AND. SV(IL,L) > YTINY  ) THEN
!
!           * ACTIVATION SIZE FROM LINEAR INTERPOLATION BETWEEN
!           * BOUNDARIES OF EACH SUB-SECTION.
!
            IF ( SV(IL,L) >= CISC(IL,L,IS+1) &
                                  .AND. SV(IL,L) < CISC(IL,L,IS) ) THEN
              RCIT=CIRC(IL,L,IS)+(SV(IL,L)-CISC(IL,L,IS)) &
                                *(CIRC(IL,L,IS+1)-CIRC(IL,L,IS)) &
                                /(CISC(IL,L,IS+1)-CISC(IL,L,IS))
            ELSE
              RCIT=YNA
            ENDIF
            IF (  (RCIT>=CIRC(IL,L,IS) .AND. RCIT<=CIRC(IL,L,IS+1)) &
             .OR. (RCIT<=CIRC(IL,L,IS) .AND. RCIT>=CIRC(IL,L,IS+1)) &
                                                                 ) THEN
              CIISI(IL,L)=CIIS(IS)
!
!             * GROWTH FACTOR FOR FIRST ACTIVATED PARTICLE.
!
              GRWFL=CIRC(IL,L,IS  )/CIDRYRB(IS  )
              GRWFH=CIRC(IL,L,IS+1)/CIDRYRB(IS+1)
              GRWFT=GRWFL+(SV(IL,L)-CISC(IL,L,IS))*(GRWFH-GRWFL) &
                                       /(CISC(IL,L,IS+1)-CISC(IL,L,IS))
              CIRCI(IL,L)=RCIT/GRWFT
            ENDIF
!
!           * CHECK IF CONDENSATE PRESENT.
!
            IF (      YSEC*CIWETRB(IL,L,IS  )>CIDRYRB(IS  ) &
                 .OR. YSEC*CIWETRB(IL,L,IS+1)>CIDRYRB(IS+1)      ) THEN
              TIACT(IL,L,CIIS(IS))=.TRUE.
            ENDIF
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * PLA PARAMETERS FOR EXTERNALLY MIXED AEROSOL TYPES.
!
      DO IS=1,ISWEXT
        ISM=SEXTF%ISWET(IS)%ISM
        TEPN0  (:,:,IS)=PEN0   (:,:,ISM)
        TEPHI0 (:,:,IS)=PEPHI0 (:,:,ISM)
        TEPSI  (:,:,IS)=PEPSI  (:,:,ISM)
        TEDPHIS(:,:,IS)=PEDPHI0(:,:,ISM)
        TEPHISS(:,:,IS)=PEPHIS0(:,:,ISM)
      ENDDO
!
!     * PLA PARAMETERS FOR INTERNALLY MIXED AEROSOL TYPES.
!
      DO IS=1,ISWINT
        ISM=SINTF%ISWET(IS)%ISI
        TIPN0  (:,:,IS)=PIN0   (:,:,ISM)
        TIPHI0 (:,:,IS)=PIPHI0 (:,:,ISM)
        TIPSI  (:,:,IS)=PIPSI  (:,:,ISM)
        TIDPHIS(:,:,IS)=PIDPHI0(:,:,ISM)
        TIPHISS(:,:,IS)=PIPHIS0(:,:,ISM)
      ENDDO
!
!     * COPY SIZE INFORMATION FOR ACTIVATION SIZE INTO SIZE INFORMATION
!     * ARRAYS FOR EXTERNALLY MIXED AEROSOL.
!
      IF ( ISWEXT > 0 ) THEN
        DO KX=1,KEXT
        DO L=1,LEVA
        DO IL=1,ILGA
          IS=CEISI(IL,L,KX)
          IF ( IS /= INA ) THEN
            PHISRT=TEPHISS(IL,L,IS)+TEDPHIS(IL,L,IS)
            PHISST=MIN(MAX(LOG(CERCI(IL,L,KX)/R0),TEPHISS(IL,L,IS)), &
                                                                PHISRT)
            DPHIST=PHISRT-PHISST
            TEPHISS(IL,L,IS)=PHISST
            TEDPHIS(IL,L,IS)=DPHIST
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
!
!     * COPY SIZE INFORMATION FOR ACTIVATION SIZE INTO SIZE INFORMATION
!     * ARRAYS FOR INTERNALLY MIXED AEROSOL.
!
      IF ( ISWINT > 0 ) THEN
        DO L=1,LEVA
        DO IL=1,ILGA
          IS=CIISI(IL,L)
          IF ( IS /= INA ) THEN
            PHISRT=TIPHISS(IL,L,IS)+TIDPHIS(IL,L,IS)
            PHISST=MIN(MAX(LOG(CIRCI(IL,L)/R0),TIPHISS(IL,L,IS)), &
                                                                PHISRT)
            DPHIST=PHISRT-PHISST
            TIPHISS(IL,L,IS)=PHISST
            TIDPHIS(IL,L,IS)=DPHIST
          ENDIF
        ENDDO
        ENDDO
      ENDIF
!
!     * OBTAIN NUMBER CONCENTRATIONS FROM INTEGRATION OF SIZE DISRIBUTION
!     * FOR EXTERNALLY MIXED AEROSOLS.
!
      IF ( ISWEXT > 0 ) THEN
        TESDF=SDINT0(TEPHI0,TEPSI,TEPHISS,TEDPHIS,ILGA,LEVA,ISWEXT)
        WHERE ( ABS(TEPSI-YNA) > YTINY )
          TENUM=TEPN0*TESDF
        ELSEWHERE
          TENUM=0.
        ENDWHERE
      ENDIF
!
!     * OBTAIN NUMBER CONCENTRATIONS FROM INTEGRATION OF SIZE DISRIBUTION
!     * FOR INTERNALLY MIXED AEROSOLS.
!
      IF ( ISWINT > 0 ) THEN
        TISDF=SDINT0(TIPHI0,TIPSI,TIPHISS,TIDPHIS,ILGA,LEVA,ISWINT)
        WHERE ( ABS(TIPSI-YNA) > YTINY )
          TINUM=TIPN0*TISDF
        ELSEWHERE
          TINUM=0.
        ENDWHERE
      ENDIF
!
!-----------------------------------------------------------------------
!     * CLOUD DROPLET NUMBER CONCENTRATION FROM INTEGRATION OF NUMBER
!     * SIZE DISTRIBUTION FROM CRITICAL SIZE TO SIZE OF LARGEST PARTICLE
!     * IN THE SIZE DISTRIBUTION. FOR EXTERNALLY MIXED AEROSOLS.
!
      IF ( KEXT > 0 ) THEN
        CECDNC=0.
      ENDIF
      ISI=0
      DO KX=1,KEXT
        IF (     (ABS(AEXTF%TP(KX)%NUIO-YNA) > YTINY &
                                      .AND. AEXTF%TP(KX)%NUIO  > YTINY) &
            .OR. (ABS(AEXTF%TP(KX)%KAPPA-YNA) > YTINY &
                               .AND. AEXTF%TP(KX)%KAPPA > YTINY) ) THEN
          DO IS=1,AEXTF%TP(KX)%ISEC
            ISI=ISI+1
            DO L=1,LEVA
            DO IL=1,ILGA
              ISX=CEISI(IL,L,KX)
              IF ( ISX /= INA ) THEN
                ISC=SEXTF%ISWET(ISX)%ISI
                IF ( IS >= ISC .AND. TEACT(IL,L,ISI) ) THEN
                  CECDNC(IL,L,KX)=CECDNC(IL,L,KX)+TENUM(IL,L,ISI)
                ENDIF
              ENDIF
            ENDDO
            ENDDO
          ENDDO
        ENDIF
      ENDDO
!
!     * CLOUD DROPLET NUMBER CONCENTRATION FROM INTEGRATION OF NUMBER
!     * SIZE DISTRIBUTION. FOR INTERNALLY MIXED AEROSOLS.
!
      IF ( KINT > 0 ) THEN
        CICDNC=0.
      ENDIF
      DO IS=1,ISWINT
      DO L=1,LEVA
      DO IL=1,ILGA
        ISX=CIISI(IL,L)
        IF ( ISX /= INA ) THEN
          IF ( IS >= ISX .AND. TIACT(IL,L,IS) ) THEN
            CICDNC(IL,L)=CICDNC(IL,L)+TINUM(IL,L,IS)
          ENDIF
        ENDIF
      ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * DEALLOCATE WORK ARRAYS.
!
      IF ( KEXT > 0 ) THEN
        DEALLOCATE(KFRST)
        DEALLOCATE(CEISI)
      ENDIF
      IF ( ISWEXT > 0 ) THEN
        DEALLOCATE(TEPN0)
        DEALLOCATE(TEPHI0)
        DEALLOCATE(TEPSI)
        DEALLOCATE(TEDPHIS)
        DEALLOCATE(TEPHISS)
        DEALLOCATE(TESDF)
        DEALLOCATE(TENUM)
        DEALLOCATE(TEACT)
      ENDIF
      IF ( KINT > 0 ) THEN
        DEALLOCATE(CIISI)
      ENDIF
      IF ( ISWINT > 0 ) THEN
        DEALLOCATE(TIPN0)
        DEALLOCATE(TIPHI0)
        DEALLOCATE(TIPSI)
        DEALLOCATE(TIDPHIS)
        DEALLOCATE(TIPHISS)
        DEALLOCATE(TISDF)
        DEALLOCATE(TINUM)
        DEALLOCATE(TIACT)
      ENDIF
!
      END SUBROUTINE CNCDNCA
