      SUBROUTINE PAMDI(CNT,CN20,CN50,CN100,CN200,CNTW,CN20W,CN50W, &
                       CN100W,CN200W,CC02,CC04,CC08,CC16,ACAS,ACOA, &
                       ACBC,ACSS,ACMD,SUPS,CCN,CCNE,RCRI,VCCN,VCNE, &
                       PEMAS,PENUM,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                       PEDPHI0,PECDNC,PEDDN,PIMAS,PINUM,PIN0, &
                       PIPHI0,PIPSI,PIPHIS0,PIDPHI0,PICDNC,PIDDN, &
                       PIFRC,PIRCI,CEDDNIS,CEDDNSL,CENUIO,CEMOLW, &
                       CEKAPPA,CEEPSM,CEWETRB,CIDDNIS,CIDDNSL,CINUIO, &
                       CIMOLW,CIKAPPA,CIEPSM,CIWETRB,TA,RHOA,SZCLF, &
                       SZMLWC,SVF,VITRM,ZCTHR,SVREF,ILGA,LEVA)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     DIAGNOSTIC AEROSOL PARAMETERS INTERNAL TO PAM.
!
!     HISTORY:
!     --------
!     * JUL 3/2015 - K.VONSALZEN   NEW.
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE SCPARM
!
      IMPLICIT REAL (A-H,O-Z),INTEGER (I-N)
!
      REAL, INTENT(OUT), DIMENSION(ILGA) ::        VCCN,VCNE
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA)   :: CNT,CN20,CN50,CN100, &
                                                   CN200,CNTW,CN20W, &
                                                   CN50W,CN100W,CN200W
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA) ::   ACAS,ACOA,ACBC,ACSS, &
                                                   ACMD,SUPS,CCN,RCRI, &
                                                   CC02,CC04,CC08,CC16, &
                                                   CCNE
!
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISEXTB) :: CEDDNIS,CEDDNSL, &
                                                       CENUIO,CEMOLW, &
                                                       CEKAPPA,CEEPSM, &
                                                       CEWETRB
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISINTB) :: CIDDNIS,CIDDNSL, &
                                                       CINUIO,CIMOLW, &
                                                       CIKAPPA,CIEPSM, &
                                                       CIWETRB
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: TA,RHOA,SZCLF,SZMLWC, &
                                                SVF,VITRM
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,KEXT) :: PECDNC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: PICDNC,PIRCI
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAEXT) :: &
                                 PEMAS,PENUM,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                                 PEDPHI0,PEDDN
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT) :: &
                                 PIMAS,PINUM,PIN0,PIPHI0,PIPSI,PIPHIS0, &
                                 PIDPHI0,PIDDN
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIFRC
!
      LOGICAL, DIMENSION(ILGA,LEVA) :: KCLDF
      REAL, DIMENSION(ILGA,LEVA) :: RADS,AWGT,SV,RHTA
      INTEGER, ALLOCATABLE, DIMENSION(:) :: PEINDS,PEINDE
      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: PERADC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: PIRADC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CECDNC,CERCIT
      REAL, ALLOCATABLE, DIMENSION(:,:)   :: CICDNC,CIRCIT
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CERC,CESC,PEWETRC
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CIRC,CISC,PIWETRC
      REAL, ALLOCATABLE, DIMENSION(:,:)   :: EMCDNC
!
      INTEGER, PARAMETER :: NCT=5       ! NUMBER OF DIAGNOSED CN CATEGORIES
      REAL, DIMENSION(NCT) :: RADC0     ! DROPLET RADIUS THRESHOLD
      DATA RADC0 / 0., 10.E-09, 25.E-09, 50.E-09, 100.E-09 /
!
!-----------------------------------------------------------------------
!     * ALLOCATE MEMORY FOR PLA SECTION SIZE PARAMETER ARRAYS.
!
      ALLOCATE(EMCDNC(ILGA,LEVA))
      IF ( ISAEXT > 0 ) THEN
        ALLOCATE(PEINDS(KEXT))
        ALLOCATE(PEINDE(KEXT))
        ALLOCATE(PERADC(ILGA,LEVA,KEXT,NCT))
        ALLOCATE(PEWETRC(ILGA,LEVA,ISAEXT))
      ENDIF
      IF ( KEXT > 0 ) THEN
        ALLOCATE(CECDNC(ILGA,LEVA,KEXT))
        ALLOCATE(CERCIT(ILGA,LEVA,KEXT))
      ENDIF
      IF ( ISEXTB > 0 ) THEN
        ALLOCATE(CERC(ILGA,LEVA,ISEXTB))
        ALLOCATE(CESC(ILGA,LEVA,ISEXTB))
      ENDIF
      IF ( ISAINT > 0 ) THEN
        ALLOCATE(PIRADC(ILGA,LEVA,NCT))
        ALLOCATE(PIWETRC(ILGA,LEVA,ISAINT))
      ENDIF
      IF ( KINT > 0 ) THEN
        ALLOCATE(CICDNC(ILGA,LEVA))
        ALLOCATE(CIRCIT(ILGA,LEVA))
      ENDIF
      IF ( ISINTB > 0 ) THEN
        ALLOCATE(CIRC(ILGA,LEVA,ISINTB))
        ALLOCATE(CISC(ILGA,LEVA,ISINTB))
      ENDIF
!
!-----------------------------------------------------------------------
!     * FOR EXTERNALLY MIXED AEROSOL, DETERMINE THE SIZE SECTION
!     * RANGE FOR EACH INDIVIDUAL TYPE.
!
      IF ( ISAEXT > 0 ) THEN
        IS=1
        KX=SEXTF%ISAER(IS)%ITYP
        PEINDS(KX)=IS
        DO IS=2,ISAEXT
          KX=SEXTF%ISAER(IS)%ITYP
          KXM=SEXTF%ISAER(IS-1)%ITYP
          IF ( KX/=KXM ) THEN
            PEINDS(KX)=IS
            PEINDE(KXM)=IS-1
          ENDIF
        ENDDO
        IS=ISAEXT
        KX=SEXTF%ISAER(IS)%ITYP
        PEINDE(KX)=IS
      ENDIF
!
!-----------------------------------------------------------------------
!     * AEROSOL NUMBER CONCENTRATION FOR DRY DROPLET SIZE THRESHOLDS.
!
      IF ( ISAEXT > 0 ) THEN
        DO NC=1,NCT
          PERADC(:,:,:,NC)=RADC0(NC)
        ENDDO
      ENDIF
      IF ( ISAINT > 0 ) THEN
        DO NC=1,NCT
          PIRADC(:,:,NC)=RADC0(NC)
        ENDDO
      ENDIF
      CALL CNDIAG (CNT,CN20,CN50,CN100,CN200,PERADC,PIRADC, &
                   PEN0,PEPHI0,PEPSI,PEPHIS0,PEDPHI0, &
                   PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0, &
                   PEINDS,PEINDE,NCT,ILGA,LEVA)
      CNT   =CNT   *RHOA*1.E-06
      CN20  =CN20  *RHOA*1.E-06
      CN50  =CN50  *RHOA*1.E-06
      CN100 =CN100 *RHOA*1.E-06
      CN200 =CN200 *RHOA*1.E-06
!
!     * AEROSOL NUMBER CONCENTRATION FOR WET DROPLET SIZE THRESHOLDS
!     * AT 60% RELATIVE HUMIDITY.
!
      RHTA=0.6
      CALL SDAPROP (PEWETRC,PIWETRC,PEN0,PEPHI0,PEPSI,PEDDN, &
                    PIN0,PIPHI0,PIPSI,PIFRC,PIDDN,TA,RHTA, &
                    ILGA,LEVA)
      IF ( ISAEXT > 0 ) THEN
        DO NC=1,NCT
          DO KX=1,KEXT
            RADS(:,:)=PEDRYRB(PEINDS(KX))*PEWETRC(:,:,PEINDS(KX)) &
                     /PEDRYRC(PEINDS(KX))
            WHERE ( RADC0(NC) < RADS(:,:) )
              PERADC(:,:,KX,NC)=PEDRYRB(PEINDS(KX))
            ELSEWHERE ( RADC0(NC) < PEWETRC(:,:,PEINDS(KX)) )
              PERADC(:,:,KX,NC)=RADC0(NC)*PEDRYRC(PEINDS(KX)) &
                               /PEWETRC(:,:,PEINDS(KX))
            ENDWHERE
            DO IS=PEINDS(KX),PEINDE(KX)-1
              WHERE (      RADC0(NC) >= PEWETRC(:,:,IS) &
                     .AND. RADC0(NC)  < PEWETRC(:,:,IS+1) )
                AWGT(:,:)=(RADC0(NC)-PEWETRC(:,:,IS)) &
                         /(PEWETRC(:,:,IS+1)-PEWETRC(:,:,IS))
                PERADC(:,:,KX,NC)=(1.-AWGT(:,:))*PEDRYRC(IS) &
                                 +AWGT(:,:)*PEDRYRC(IS+1)
              ENDWHERE
            ENDDO
            RADS(:,:)=PEDRYRB(PEINDE(KX))*PEWETRC(:,:,PEINDE(KX)) &
                     /PEDRYRC(PEINDE(KX))
            WHERE ( RADC0(NC) >= RADS(:,:) )
              PERADC(:,:,KX,NC)=PEDRYRB(PEINDE(KX))
            ELSEWHERE ( RADC0(NC) >= PEWETRC(:,:,PEINDE(KX)) )
              PERADC(:,:,KX,NC)=RADC0(NC)*PEDRYRC(PEINDE(KX)) &
                               /PEWETRC(:,:,PEINDE(KX))
            ENDWHERE
          ENDDO
        ENDDO
      ENDIF
      IF ( ISAINT > 0 ) THEN
        DO NC=1,NCT
          RADS(:,:)=PIDRYRB(1)*PIWETRC(:,:,1)/PIDRYRC(1)
          WHERE ( RADC0(NC) < RADS(:,:) )
            PIRADC(:,:,NC)=PIDRYRB(1)
          ELSEWHERE ( RADC0(NC) < PIWETRC(:,:,1) )
            PIRADC(:,:,NC)=RADC0(NC)*PIDRYRC(1)/PIWETRC(:,:,1)
          ENDWHERE
          DO IS=1,ISAINT-1
            WHERE (      RADC0(NC) >= PIWETRC(:,:,IS) &
                   .AND. RADC0(NC)  < PIWETRC(:,:,IS+1) )
              AWGT(:,:)=(RADC0(NC)-PIWETRC(:,:,IS)) &
                       /(PIWETRC(:,:,IS+1)-PIWETRC(:,:,IS))
              PIRADC(:,:,NC)=(1.-AWGT(:,:))*PIDRYRC(IS) &
                                +AWGT(:,:)*PIDRYRC(IS+1)
            ENDWHERE
          ENDDO
          RADS(:,:)=PIDRYRB(ISAINTB)*PIWETRC(:,:,ISAINT) &
                   /PIDRYRC(ISAINT)
          WHERE ( RADC0(NC) >= RADS(:,:) )
            PIRADC(:,:,NC)=PIDRYRB(ISAINTB)
          ELSEWHERE ( RADC0(NC) >= PIWETRC(:,:,ISAINT) )
            PIRADC(:,:,NC)=RADC0(NC)*PIDRYRC(ISAINT) &
                          /PIWETRC(:,:,ISAINT)
          ENDWHERE
        ENDDO
      ENDIF
      CALL CNDIAG (CNTW,CN20W,CN50W,CN100W,CN200W,PERADC,PIRADC, &
                   PEN0,PEPHI0,PEPSI,PEPHIS0,PEDPHI0, &
                   PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0, &
                   PEINDS,PEINDE,NCT,ILGA,LEVA)
      CNTW  =CNTW  *RHOA*1.E-06
      CN20W =CN20W *RHOA*1.E-06
      CN50W =CN50W *RHOA*1.E-06
      CN100W=CN100W*RHOA*1.E-06
      CN200W=CN200W*RHOA*1.E-06
!
!-----------------------------------------------------------------------
!     * AEROSOL MASS CONCENTRATIONS.
!
      CALL AMDIAG(ACAS,ACOA,ACBC,ACSS,ACMD,PEMAS,PIMAS,PIFRC, &
                  RHOA,ILGA,LEVA)
!
!-----------------------------------------------------------------------
!     * CLOUD INDICATOR FLAG.
!
      WHERE ( (1.-SZCLF) < ZCTHR .AND. SZMLWC > YSMALL )
        KCLDF=.TRUE.
      ELSEWHERE
        KCLDF=.FALSE.
      ENDWHERE
!
!     * DIAGNOSE SUPERSATURATION.
!
      WHERE ( KCLDF )
        SUPS=SVF
      ELSEWHERE
        SUPS=0.
      ENDWHERE
!
!     * DIAGNOSE CRITICAL RADIUS AND CLOUD DROPLET NUMBER.
!
      VCCN=0.
      CCN=0.
      RCRI=0.
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
          WHERE ( KCLDF )
            CCN=CCN+PECDNC(:,:,KX)*RHOA*1.E-06
          ENDWHERE
          DO L=1,LEVA
          DO IL=1,ILGA
            IF ( KCLDF(IL,L) ) THEN
              VCCN(IL)=VCCN(IL)+VITRM(IL,L)*PECDNC(IL,L,KX)*1.E-06
            ENDIF
          ENDDO
          ENDDO
         ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        RMAX=PIDRYR(ISAINT)%VR
        WHERE ( KCLDF .AND. PIRCI < RMAX )
          RCRI=RCRI+PIRCI*1.E+06
        ENDWHERE
        WHERE ( KCLDF )
          CCN=CCN+PICDNC*RHOA*1.E-06
        ENDWHERE
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( KCLDF(IL,L) ) THEN
            VCCN(IL)=VCCN(IL)+VITRM(IL,L)*PICDNC(IL,L)*1.E-06
          ENDIF
        ENDDO
        ENDDO
      ENDIF

!
!-----------------------------------------------------------------------
!     * CALCULATE CCN CONCENTRATIONS FOR 0.2% SUPERSATURATION.
!
      SV=SVREF
      CALL CCNPAR(CERC,CESC,CIRC,CISC,TA,CEDDNSL,CEDDNIS, &
                  CENUIO,CEKAPPA,CEMOLW,CIDDNSL,CIDDNIS,CINUIO, &
                  CIKAPPA,CIMOLW,CIEPSM,SV,ILGA,LEVA, &
                  IEXKAP,IINKAP)
      CALL CNCDNCA(CECDNC,CERCIT,CICDNC,CIRCIT,CEWETRB,CERC,CESC, &
                   CIWETRB,CIRC,CISC,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                   PEDPHI0,PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0,SV, &
                   ILGA,LEVA)
!
!     * SAVE RESULTS.
!
      CC02=0.
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
          CC02=CC02+CECDNC(:,:,KX)*RHOA*1.E-06
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        CC02=CC02+CICDNC*RHOA*1.E-06
      ENDIF
!
!     * CALCULATE CCN CONCENTRATIONS FOR 0.4% SUPERSATURATION.
!
      SV=0.004
      CALL CCNPAR(CERC,CESC,CIRC,CISC,TA,CEDDNSL,CEDDNIS, &
                  CENUIO,CEKAPPA,CEMOLW,CIDDNSL,CIDDNIS,CINUIO, &
                  CIKAPPA,CIMOLW,CIEPSM,SV,ILGA,LEVA, &
                  IEXKAP,IINKAP)
      CALL CNCDNCA(CECDNC,CERCIT,CICDNC,CIRCIT,CEWETRB,CERC,CESC, &
                   CIWETRB,CIRC,CISC,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                   PEDPHI0,PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0,SV, &
                   ILGA,LEVA)
!
!     * SAVE RESULTS.
!
      CC04=0.
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
          CC04=CC04+CECDNC(:,:,KX)*RHOA*1.E-06
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        CC04=CC04+CICDNC*RHOA*1.E-06
      ENDIF
!
!     * CALCULATE CCN CONCENTRATIONS FOR 0.8% SUPERSATURATION.
!
      SV=0.008
      CALL CCNPAR(CERC,CESC,CIRC,CISC,TA,CEDDNSL,CEDDNIS, &
                  CENUIO,CEKAPPA,CEMOLW,CIDDNSL,CIDDNIS,CINUIO, &
                  CIKAPPA,CIMOLW,CIEPSM,SV,ILGA,LEVA, &
                  IEXKAP,IINKAP)
      CALL CNCDNCA(CECDNC,CERCIT,CICDNC,CIRCIT,CEWETRB,CERC,CESC, &
                   CIWETRB,CIRC,CISC,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                   PEDPHI0,PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0,SV, &
                   ILGA,LEVA)
!
!     * SAVE RESULTS.
!
      CC08=0.
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
          CC08=CC08+CECDNC(:,:,KX)*RHOA*1.E-06
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        CC08=CC08+CICDNC*RHOA*1.E-06
      ENDIF
!
!     * CALCULATE CCN CONCENTRATIONS FOR 1.6% SUPERSATURATION.
!
      SV=0.016
      CALL CCNPAR(CERC,CESC,CIRC,CISC,TA,CEDDNSL,CEDDNIS, &
                  CENUIO,CEKAPPA,CEMOLW,CIDDNSL,CIDDNIS,CINUIO, &
                  CIKAPPA,CIMOLW,CIEPSM,SV,ILGA,LEVA, &
                  IEXKAP,IINKAP)
      CALL CNCDNCA(CECDNC,CERCIT,CICDNC,CIRCIT,CEWETRB,CERC,CESC, &
                   CIWETRB,CIRC,CISC,PEN0,PEPHI0,PEPSI,PEPHIS0, &
                   PEDPHI0,PIN0,PIPHI0,PIPSI,PIPHIS0,PIDPHI0,SV, &
                   ILGA,LEVA)
!
!     * SAVE RESULTS.
!
      CC16=0.
      IF ( KEXT > 0 ) THEN
        DO KX=1,KEXT
          CC16=CC16+CECDNC(:,:,KX)*RHOA*1.E-06
        ENDDO
      ENDIF
      IF ( KINT > 0 ) THEN
        CC16=CC16+CICDNC*RHOA*1.E-06
      ENDIF
!
!-----------------------------------------------------------------------
!     * CLOUD DROPLET NUMBER BASED ON SEMI-EMPIRICAL RELATIONSHIP
!     * (OLD METHOD).
!
      CALL CDNCEM(EMCDNC,PEMAS,PEPSI,PIMAS,PIPSI,PIFRC, &
                  RHOA,ILGA,LEVA)
      VCNE=0.
      WHERE ( KCLDF )
        CCNE=EMCDNC*RHOA*1.E-06
      ELSEWHERE
        CCNE=0.
      ENDWHERE
      DO L=1,LEVA
      DO IL=1,ILGA
        IF ( KCLDF(IL,L) ) THEN
          VCNE(IL)=VCNE(IL)+VITRM(IL,L)*EMCDNC(IL,L)*1.E-06
        ENDIF
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * DEALLOCATION OF ARRAYS.
!
      DEALLOCATE(EMCDNC)
      IF ( ISAEXT > 0 ) THEN
        DEALLOCATE(PEINDS)
        DEALLOCATE(PEINDE)
        DEALLOCATE(PERADC)
        DEALLOCATE(PEWETRC)
      ENDIF
      IF ( KEXT > 0 ) THEN
        DEALLOCATE(CECDNC)
        DEALLOCATE(CERCIT)
      ENDIF
      IF ( ISEXTB > 0 ) THEN
        DEALLOCATE(CERC   )
        DEALLOCATE(CESC   )
      ENDIF
      IF ( ISAINT > 0 ) THEN
        DEALLOCATE(PIRADC)
        DEALLOCATE(PIWETRC)
      ENDIF
      IF ( KINT > 0 ) THEN
        DEALLOCATE(CICDNC)
        DEALLOCATE(CIRCIT)
      ENDIF
      IF ( ISINTB > 0 ) THEN
        DEALLOCATE(CIRC   )
        DEALLOCATE(CISC   )
      ENDIF
!
      END SUBROUTINE PAMDI
