      SUBROUTINE CCNC(CECDNC,CERCI,CICDNC,CIRCI,CEWETRB,CEDDNSL, &
                      CEDDNIS,CENUIO,CEMOLW,CEKAPPA,CIWETRB,CIDDNSL, &
                      CIDDNIS,CINUIO,CIMOLW,CIKAPPA,CIEPSM,PEN0, &
                      PEPHI0,PEPSI,PEPHIS0,PEDPHI0,PIN0,PIPHI0, &
                      PIPSI,PIPHIS0,PIDPHI0,ZCLF,CLWC,SV,TA,ZCTHR, &
                      ILGA,LEVA)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     CLOUD CONDENSATION NUMBER NUCLEI CONCENTRATION FOR GIVEN
!     MAXIMUM SUPERSATURATION IN CLOUD LAYER.
!
!     HISTORY:
!     --------
!     * JUN 10/2014 - K.VONSALZEN   CODE CLEAN-UP: EXTERNAL CLOUD
!     *                             THRESHOLD, REPLACE CALCULATIONS OF
!     *                             CLOUD DROPLET NUMBER AND CRITICAL
!     *                             SIZE BY INSTANTANEOUS VALUES
!     * FEB 27/2014 - K.VONSALZEN   MORE EFFICIENT GATHERING
!                                   OF CLOUD LAYERS
!     * FEB 10/2010 - K.VONSALZEN   NEWLY INSTALLED
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE SCPARM
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      REAL, INTENT(INOUT), DIMENSION(ILGA,LEVA,KEXT) :: CECDNC,CERCI
      REAL, INTENT(INOUT), DIMENSION(ILGA,LEVA)      :: CICDNC,CIRCI
      REAL, INTENT(INOUT), DIMENSION(ILGA,LEVA) :: SV
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) ::    ZCLF,CLWC,TA
      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(IN), DIMENSION(ILGA,LEVA,ISEXTB) :: &
                                                   CEWETRB,CEDDNSL, &
                                                   CEDDNIS,CENUIO, &
                                                   CEMOLW,CEKAPPA
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISINTB) :: &
                                                   CIWETRB,CIDDNSL, &
                                                   CIDDNIS,CINUIO, &
                                                   CIMOLW,CIKAPPA, &
                                                   CIEPSM
      REAL, ALLOCATABLE, DIMENSION(:,:,:) ::       TEN0,TEPHI0,TEPSI, &
                                                   TEPHIS0,TEDPHI0
      REAL, ALLOCATABLE, DIMENSION(:,:,:) ::       TERCI,TECDNC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) ::       TIN0,TIPHI0,TIPSI, &
                                                   TIPHIS0,TIDPHI0
      REAL, ALLOCATABLE, DIMENSION(:,:) ::         TIRCI,TICDNC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) ::       TEWETRB,TEDDNSL, &
                                                   TEDDNIS,TENUIO, &
                                                   TEMOLW,TEKAPPA, &
                                                   TERC,TESC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) ::       TIWETRB,TIDDNSL, &
                                                   TIDDNIS,TINUIO, &
                                                   TIMOLW,TIKAPPA, &
                                                   TIRC,TISC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) ::       TIEPSM
      REAL, ALLOCATABLE, DIMENSION(:,:) :: SVT,TAT
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ILGAT,LB,LT,L0
      LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: KLCLC
!
!     * PARAMETERS.
!
      INTEGER, PARAMETER :: LEVAT=1
      INTEGER, PARAMETER :: LOFFS=1
      LOGICAL :: KCLD
!
!-----------------------------------------------------------------------
!     * ALLOCATE MEMORY.
!
      ALLOCATE(KLCLC(ILGA,LEVA))
!
!-----------------------------------------------------------------------
!     * INITIALIZATIONS.
!
      IF ( KEXT > 0 ) THEN
        CECDNC=YNA
        DO KX=1,KEXT
          CERCI(:,:,KX)=YNA
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        CICDNC=YNA
        CIRCI=YNA
      ENDIF
      DO L=1,LEVA
      DO IL=1,ILGA
        IF ( (1.-ZCLF(IL,L)) < ZCTHR .AND. CLWC(IL,L) > YSMALL ) THEN
          KLCLC(IL,L)=.TRUE.
        ELSE
          KLCLC(IL,L)=.FALSE.
        ENDIF
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * FIND BOTTOM AND TOP INDEX FOR CLOUD LAYERS.
!
      ILGATT=0
      DO IL=1,ILGA
        KCLD=.FALSE.
!
!       * DETERMINE TOTAL NUMBER OF CLOUD LAYERS.
!
        IF ( KLCLC(IL,LEVA) ) THEN
          KCLD=.TRUE.
          ILGATT=ILGATT+1
        ENDIF
        DO L=LEVA,2,-1
          IF ( .NOT.KCLD .AND. KLCLC(IL,L-1) ) THEN
            KCLD=.TRUE.
            ILGATT=ILGATT+1
          ELSE IF ( KCLD .AND. .NOT.KLCLC(IL,L-1) ) THEN
            KCLD=.FALSE.
          ENDIF
        ENDDO
        IF ( KCLD .AND. KLCLC(IL,1) ) THEN
          KCLD=.FALSE.
        ENDIF
      ENDDO
!
!     * ALLOCATE ARRAYS TO SAVE CLOUD LAYER LOCATION AND LEVEL INDICES.
!
      IF ( ILGATT > 0 ) THEN
        ALLOCATE(ILGAT(ILGATT))
        ALLOCATE(LB(ILGATT))
        ALLOCATE(LT(ILGATT))
        ALLOCATE(L0(ILGATT))
!
        ILGT=0
        DO IL=1,ILGA
          KCLD=.FALSE.
!
!         * DETECT BOTTOM AND TOP OF EACH CLOUD LAYER.
!
          IF ( KLCLC(IL,LEVA) ) THEN
            KCLD=.TRUE.
            ILGT=ILGT+1
            LB(ILGT)=LEVA
            L0(ILGT)=LEVA
            ILGAT(ILGT)=IL
          ENDIF
          DO L=LEVA,2,-1
            IF ( .NOT.KCLD .AND. KLCLC(IL,L-1) ) THEN
              KCLD=.TRUE.
              ILGT=ILGT+1
              LB(ILGT)=L-1
              L0(ILGT)=MIN(LB(ILGT)+LOFFS,LEVA)
              ILGAT(ILGT)=IL
            ELSE IF ( KCLD .AND. .NOT.KLCLC(IL,L-1) ) THEN
              KCLD=.FALSE.
              LT(ILGT)=L
            ENDIF
          ENDDO
          IF ( KCLD .AND. KLCLC(IL,1) ) THEN
            KCLD=.FALSE.
            LT(ILGT)=1
          ENDIF
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * ALLOCATION OF ARRAYS.
!
      IF ( ILGATT > 0 ) THEN
        ALLOCATE(SVT(ILGATT,LEVAT))
        ALLOCATE(TAT(ILGATT,LEVAT))
        IF ( ISEXTB > 0 ) THEN
          ALLOCATE(TEDDNSL(ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TEDDNIS(ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TENUIO (ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TEKAPPA(ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TEMOLW (ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TEWETRB(ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TERC   (ILGATT,LEVAT,ISEXTB))
          ALLOCATE(TESC   (ILGATT,LEVAT,ISEXTB))
        ENDIF
        IF ( ISAEXT > 0 ) THEN
          ALLOCATE(TEN0   (ILGATT,LEVAT,ISAEXT))
          ALLOCATE(TEPHI0 (ILGATT,LEVAT,ISAEXT))
          ALLOCATE(TEPSI  (ILGATT,LEVAT,ISAEXT))
          ALLOCATE(TEPHIS0(ILGATT,LEVAT,ISAEXT))
          ALLOCATE(TEDPHI0(ILGATT,LEVAT,ISAEXT))
        ENDIF
        IF ( KEXT > 0 ) THEN
          ALLOCATE(TECDNC (ILGATT,LEVAT,KEXT))
          ALLOCATE(TERCI  (ILGATT,LEVAT,KEXT))
        ENDIF
        IF ( ISINTB > 0 ) THEN
          ALLOCATE(TIDDNSL(ILGATT,LEVAT,ISINTB))
          ALLOCATE(TIDDNIS(ILGATT,LEVAT,ISINTB))
          ALLOCATE(TINUIO (ILGATT,LEVAT,ISINTB))
          ALLOCATE(TIKAPPA(ILGATT,LEVAT,ISINTB))
          ALLOCATE(TIMOLW (ILGATT,LEVAT,ISINTB))
          ALLOCATE(TIWETRB(ILGATT,LEVAT,ISINTB))
          ALLOCATE(TIRC   (ILGATT,LEVAT,ISINTB))
          ALLOCATE(TISC   (ILGATT,LEVAT,ISINTB))
          ALLOCATE(TIEPSM (ILGATT,LEVAT,ISINTB))
        ENDIF
        IF ( ISAINT > 0 ) THEN
          ALLOCATE(TIN0   (ILGATT,LEVAT,ISAINT))
          ALLOCATE(TIPHI0 (ILGATT,LEVAT,ISAINT))
          ALLOCATE(TIPSI  (ILGATT,LEVAT,ISAINT))
          ALLOCATE(TIPHIS0(ILGATT,LEVAT,ISAINT))
          ALLOCATE(TIDPHI0(ILGATT,LEVAT,ISAINT))
        ENDIF
        IF ( KINT > 0 ) THEN
          ALLOCATE(TICDNC (ILGATT,LEVAT))
          ALLOCATE(TIRCI  (ILGATT,LEVAT))
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!     * INITIALIZATION OF AIR AND AEROSOL PROPERTIES FOR SUBCLOUD LAYER.
!
      DO IL=1,ILGATT
        ILO=ILGAT(IL)
        SVT(IL,1)=SV(ILO,LB(IL))
        TAT(IL,1)=TA(ILO,LB(IL))
        IF ( ISEXTB > 0 ) THEN
          TEDDNSL (IL,1,:)=CEDDNSL(ILO,L0(IL),:)
          TEDDNIS (IL,1,:)=CEDDNIS(ILO,L0(IL),:)
          TENUIO  (IL,1,:)=CENUIO (ILO,L0(IL),:)
          TEKAPPA (IL,1,:)=CEKAPPA(ILO,L0(IL),:)
          TEMOLW  (IL,1,:)=CEMOLW (ILO,L0(IL),:)
          TEWETRB (IL,1,:)=CEWETRB(ILO,L0(IL),:)
        ENDIF
        IF ( ISAEXT > 0 ) THEN
          TEN0   (IL,1,:)=PEN0   (ILO,L0(IL),:)
          TEPHI0 (IL,1,:)=PEPHI0 (ILO,L0(IL),:)
          TEPSI  (IL,1,:)=PEPSI  (ILO,L0(IL),:)
          TEPHIS0(IL,1,:)=PEPHIS0(ILO,L0(IL),:)
          TEDPHI0(IL,1,:)=PEDPHI0(ILO,L0(IL),:)
        ENDIF
        IF ( ISINTB > 0 ) THEN
          TIDDNSL (IL,1,:)=CIDDNSL(ILO,L0(IL),:)
          TIDDNIS (IL,1,:)=CIDDNIS(ILO,L0(IL),:)
          TINUIO  (IL,1,:)=CINUIO (ILO,L0(IL),:)
          TIKAPPA (IL,1,:)=CIKAPPA(ILO,L0(IL),:)
          TIMOLW  (IL,1,:)=CIMOLW (ILO,L0(IL),:)
          TIWETRB (IL,1,:)=CIWETRB(ILO,L0(IL),:)
          TIEPSM  (IL,1,:)=CIEPSM (ILO,L0(IL),:)
        ENDIF
        IF ( ISAINT > 0 ) THEN
          TIN0   (IL,1,:)=PIN0   (ILO,L0(IL),:)
          TIPHI0 (IL,1,:)=PIPHI0 (ILO,L0(IL),:)
          TIPSI  (IL,1,:)=PIPSI  (ILO,L0(IL),:)
          TIPHIS0(IL,1,:)=PIPHIS0(ILO,L0(IL),:)
          TIDPHI0(IL,1,:)=PIDPHI0(ILO,L0(IL),:)
        ENDIF
      ENDDO
!
!     * DIAGNOSE CCN MASS MIXING RATIO AND CRITICAL RADIUS.
!
      IF ( ILGATT > 0 ) THEN
        CALL CCNPAR(TERC,TESC,TIRC,TISC,TAT,TEDDNSL,TEDDNIS, &
                    TENUIO,TEKAPPA,TEMOLW,TIDDNSL,TIDDNIS,TINUIO, &
                    TIKAPPA,TIMOLW,TIEPSM,SVT,ILGATT,LEVAT, &
                    IEXKAP,IINKAP)
        CALL CNCDNCA(TECDNC,TERCI,TICDNC,TIRCI,TEWETRB,TERC,TESC, &
                     TIWETRB,TIRC,TISC,TEN0,TEPHI0,TEPSI,TEPHIS0, &
                     TEDPHI0,TIN0,TIPHI0,TIPSI,TIPHIS0,TIDPHI0,SVT, &
                     ILGATT,LEVAT)
      ENDIF
!
!     * APPLY RESULTS TO ENTIRE CLOUD LAYER.
!
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
        DO IL=1,ILGATT
          ILO=ILGAT(IL)
          CECDNC(ILO,LT(IL):LB(IL),KX)=TECDNC(IL,1,KX)
          CERCI (ILO,LT(IL):LB(IL),KX)=TERCI (IL,1,KX)
        ENDDO
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        DO IL=1,ILGATT
          ILO=ILGAT(IL)
          CICDNC(ILO,LT(IL):LB(IL))=TICDNC(IL,1)
          CIRCI (ILO,LT(IL):LB(IL))=TIRCI (IL,1)
        ENDDO
      ENDIF
      DO IL=1,ILGATT
        ILO=ILGAT(IL)
        SV(ILO,LT(IL):LB(IL))=SVT(IL,1)
      ENDDO
!
!     * DEALLOCATION OF ARRAYS.
!
      IF ( ILGATT > 0 ) THEN
        DEALLOCATE(ILGAT)
        DEALLOCATE(LB)
        DEALLOCATE(LT)
        DEALLOCATE(L0)
        DEALLOCATE(SVT)
        DEALLOCATE(TAT)
        IF ( ISEXTB > 0 ) THEN
          DEALLOCATE(TEDDNSL)
          DEALLOCATE(TEDDNIS)
          DEALLOCATE(TENUIO )
          DEALLOCATE(TEKAPPA)
          DEALLOCATE(TEMOLW )
          DEALLOCATE(TEWETRB)
          DEALLOCATE(TERC   )
          DEALLOCATE(TESC   )
        ENDIF
        IF ( ISAEXT > 0 ) THEN
          DEALLOCATE(TEN0   )
          DEALLOCATE(TEPHI0 )
          DEALLOCATE(TEPSI  )
          DEALLOCATE(TEPHIS0)
          DEALLOCATE(TEDPHI0)
        ENDIF
        IF ( KEXT > 0 ) THEN
          DEALLOCATE(TECDNC )
          DEALLOCATE(TERCI  )
        ENDIF
        IF ( ISINTB > 0 ) THEN
          DEALLOCATE(TIDDNSL)
          DEALLOCATE(TIDDNIS)
          DEALLOCATE(TINUIO )
          DEALLOCATE(TIKAPPA)
          DEALLOCATE(TIMOLW )
          DEALLOCATE(TIWETRB)
          DEALLOCATE(TIRC   )
          DEALLOCATE(TISC   )
          DEALLOCATE(TIEPSM )
        ENDIF
        IF ( ISAINT > 0 ) THEN
          DEALLOCATE(TIN0   )
          DEALLOCATE(TIPHI0 )
          DEALLOCATE(TIPSI  )
          DEALLOCATE(TIPHIS0)
          DEALLOCATE(TIDPHI0)
        ENDIF
        IF ( KINT > 0 ) THEN
          DEALLOCATE(TICDNC )
          DEALLOCATE(TIRCI  )
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!     * LIMIT RANGE FOR CRITICAL RADIUS RESULTS.
!
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
          ISMIN=PEISMNK(KX)
          ISMAX=PEISMXK(KX)
          RMIN=PEDRYR(ISMIN)%VL
          RMAX=PEDRYR(ISMAX)%VR
          WHERE ( ABS(CERCI(:,:,KX)-YNA) > YTINY )
            CERCI(:,:,KX)=MIN(MAX(CERCI(:,:,KX),RMIN),RMAX)
          ENDWHERE
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        RMIN=PIDRYR(1     )%VL
        RMAX=PIDRYR(ISAINT)%VR
        WHERE ( ABS(CIRCI-YNA) > YTINY )
          CIRCI=MIN(MAX(CIRCI,RMIN),RMAX)
        ENDWHERE
      ENDIF
!
!-----------------------------------------------------------------------
!     * DEALLOCATE MEMORY.
!
      DEALLOCATE(KLCLC)
!
      END SUBROUTINE CCNC
