      SUBROUTINE CCNPAR(CERC,CESC,CIRC,CISC,TEMP,CEDDNSL,CEDDNIS, &
                        CENUIO,CEKAPPA,CEMOLW,CIDDNSL,CIDDNIS,CINUIO, &
                        CIKAPPA,CIMOLW,CIEPSM,SV,ILGA,LEVA, &
                        IEXKAP,IINKAP)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     CRITICAL PARTICLE SIZES AND SUPERSATURATION OF CCN'S FROM
!     KOEHLER THEORY.
!
!     HISTORY:
!     --------
!     * DEC 08/2010 - K.VONSALZEN   CORRECT KAPPA APPROACH (TREATMENT
!                                   OF INSOLUBLE CORE)
!     * SEP 09/2009 - K.VONSALZEN   REMOVE CALCULATION OF WET PARICLE
!                                   RADIUS
!     * MAR 20/2009 - K.VONSALZEN   NEW, BASED ON CNGRW
!
!-----------------------------------------------------------------------
!
      USE SCPARM
      USE CNPARM
      USE SDPHYS
      USE FPDEF
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      INTEGER, INTENT(IN) :: ILGA,LEVA
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISEXTB) :: &
                                               CEDDNSL,CEDDNIS,CENUIO, &
                                               CEKAPPA,CEMOLW
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISINTB) :: &
                                               CIDDNSL,CIDDNIS,CINUIO, &
                                               CIKAPPA,CIMOLW,CIEPSM
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: TEMP,SV
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISEXTB) :: &
                                               CERC,CESC
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISINTB) :: &
                                               CIRC,CISC
      REAL, DIMENSION(ILGA,LEVA) :: SFCTW,AK,SVT
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CIBK,CEBK,CITMP,CETMP
!
!-----------------------------------------------------------------------
!
!     * ALLOCATE TEMPORARY ARRAYS.
!
      IF ( ISEXTB > 0 ) THEN
        ALLOCATE(CEBK (ILGA,LEVA,ISEXTB))
        ALLOCATE(CETMP(ILGA,LEVA,ISEXTB))
      ENDIF
      IF ( ISINTB > 0 ) THEN
        ALLOCATE(CIBK (ILGA,LEVA,ISINTB))
        ALLOCATE(CITMP(ILGA,LEVA,ISINTB))
      ENDIF
!
!-----------------------------------------------------------------------
!     * SURFACE TENSION OF WATER.
!
      SFCTW=0.0761-1.55E-04*(TEMP-273.)
!
!     * A-TERM IN KOEHLER EQUATION (FOR CURVATURE EFFECT).
!
      AK=2.*WH2O*SFCTW/(RGASM*TEMP*RHOH2O)
!
!     * B-TERM IN KOEHLER EQUATION (FOR SOLUTE EFFECT).
!
      IF ( ISEXTB > 0 ) THEN
        CEBK=YNA
        IF ( IEXKAP /= 1 ) THEN
          CORU=1.
          DO IS=1,ISEXTB
          DO L=1,LEVA
          DO IL=1,ILGA
!
!           * NUMBER OF MOLES OF SOLUTE.
!
            AMSL=(4.*YPI/3.)*CEDDNSL(IL,L,IS)*CEDRYRB(IS)**3
            ANS=AMSL*CORU*CENUIO(IL,L,IS)/CEMOLW(IL,L,IS)
!
!           * B-TERM IN KOEHLER EQUATION (FOR SOLUTE EFFECT).
!
            CEBK(IL,L,IS)=0.75*ANS*WH2O/(YPI*RHOH2O)
          END DO
          END DO
          END DO
        ELSE
          DO IS=1,ISEXTB
          DO L=1,LEVA
          DO IL=1,ILGA
!
!           * B-TERM IN KOEHLER EQUATION (FOR SOLUTE EFFECT).
!
            CEBK(IL,L,IS)=CEKAPPA(IL,L,IS)*CEDRYRB(IS)**3
          END DO
          END DO
          END DO
        ENDIF
      ENDIF
      IF ( ISINTB > 0 ) THEN
        CIBK=YNA
        IF ( IINKAP /= 1 ) THEN
          DO IS=1,ISINTB
          DO L=1,LEVA
          DO IL=1,ILGA
            IF (         ABS(CIEPSM(IL,L,IS)-YNA) > YSMALL &
                   .AND. CIEPSM(IL,L,IS) > YSMALL                ) THEN
              ARAT=(1.-CIEPSM(IL,L,IS))/CIEPSM(IL,L,IS)
              IF ( ARAT > YSMALL ) THEN
                CORU=1./(1.+(CIDDNSL(IL,L,IS)/CIDDNIS(IL,L,IS))*ARAT)
              ELSE
                CORU=1.
              ENDIF
!
!             * NUMBER OF MOLES OF SOLUTE.
!
              AMSL=(4.*YPI/3.)*CIDDNSL(IL,L,IS)*CIDRYRB(IS)**3
              ANS=AMSL*CORU*CINUIO(IL,L,IS)/CIMOLW(IL,L,IS)
!
!             * B-TERM IN KOEHLER EQUATION (FOR SOLUTE EFFECT).
!
              CIBK(IL,L,IS)=0.75*ANS*WH2O/(YPI*RHOH2O)
            ENDIF
          END DO
          END DO
          END DO
        ELSE
          DO IS=1,ISINTB
          DO L=1,LEVA
          DO IL=1,ILGA
            IF (       ABS(CIKAPPA(IL,L,IS)-YNA) > YSMALL &
                     .AND. CIKAPPA(IL,L,IS) > YSMALL &
                 .AND. ABS(CIEPSM(IL,L,IS)-YNA) > YSMALL &
                     .AND. CIEPSM(IL,L,IS) > YSMALL              ) THEN
              ARAT=(1.-CIEPSM(IL,L,IS))/CIEPSM(IL,L,IS)
              IF ( ARAT > YSMALL ) THEN
                CORU=1./(1.+(CIDDNSL(IL,L,IS)/CIDDNIS(IL,L,IS))*ARAT)
              ELSE
                CORU=1.
              ENDIF
!
!             * B-TERM IN KOEHLER EQUATION (FOR SOLUTE EFFECT).
!
              CIBK(IL,L,IS)=CIKAPPA(IL,L,IS)*CORU*CIDRYRB(IS)**3
            ENDIF
          END DO
          END DO
          END DO
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!     * CRITICAL PARTICLE RADIUS AND SUPERSATURATION.
!
      IF ( ISEXTB > 0 ) THEN
        DO IS=1,ISEXTB
          WHERE ( ABS(CEBK(:,:,IS)-YNA) > YSMALL )
            CETMP(:,:,IS)=3.*CEBK(:,:,IS)/AK(:,:)
          ELSEWHERE
            CETMP(:,:,IS)=0.
          ENDWHERE
        ENDDO
        CERC=SQRT(CETMP)
        WHERE ( CERC <= YSMALL )
          CEBK=YNA
        ENDWHERE
        DO IS=1,ISEXTB
          WHERE ( ABS(CEBK(:,:,IS)-YNA) > YSMALL )
            CESC(:,:,IS)=2.*AK(:,:)/(3.*CERC(:,:,IS))
          ELSEWHERE
            CERC(:,:,IS)=YNA
            CESC(:,:,IS)=YNA
          ENDWHERE
        ENDDO
      ENDIF
      IF ( ISINTB > 0 ) THEN
        DO IS=1,ISINTB
          WHERE ( ABS(CIBK(:,:,IS)-YNA) > YSMALL )
            CITMP(:,:,IS)=3.*CIBK(:,:,IS)/AK(:,:)
          ELSEWHERE
            CITMP(:,:,IS)=0.
          ENDWHERE
        ENDDO
        CIRC=SQRT(CITMP)
        WHERE ( CIRC <= YSMALL )
          CIBK=YNA
        ENDWHERE
        DO IS=1,ISINTB
          WHERE ( ABS(CIBK(:,:,IS)-YNA) > YSMALL )
            CISC(:,:,IS)=2.*AK(:,:)/(3.*CIRC(:,:,IS))
          ELSEWHERE
            CIRC(:,:,IS)=YNA
            CISC(:,:,IS)=YNA
          ENDWHERE
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * DEALLOCATE TEMPORARY ARRAYS.
!
      IF ( ISEXTB > 0 ) THEN
        DEALLOCATE(CEBK )
        DEALLOCATE(CETMP)
      ENDIF
      IF ( ISINTB > 0 ) THEN
        DEALLOCATE(CIBK )
        DEALLOCATE(CITMP)
      ENDIF
!
      END SUBROUTINE CCNPAR
