      SUBROUTINE CNEXTRP (WETRT,SVT,AKT,BKT,XP,RC,SC,KGR,BSP,IRS,IRSMAX, &
                          WETR,SV,AK,BK,RATP0,IRDS,IRGS,IBS,ILGA,LEVA, &
                          ISEC,IRSTMAX,IMOD1,IMOD2,IMOD3)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     EXTRACTS CHARACTERISTIC NON-DIMENSIONALIZED PARICLE GROWTH CURVES
!     AND LIMITS FOR GIVEN INITIAL PARTICLE SIZE, SUPERSATURATION, AND
!     KOEHLER PARAMETERS.
!
!     HISTORY:
!     --------
!     * SEP 19/2008 - K.VONSALZEN   CALCULATION OF IBTL SUBJECT
!                                   TO KOK
!     * JUN 20/2008 - K.VONSALZEN   ABORT IF PARTICLE SIZE RANGE
!                                   NOT APPROPRIATE IN TABLE DATA.
!     * APR 20/2006 - K.VONSALZEN   NEW.
!
!-----------------------------------------------------------------------
!
      USE CNPARM
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
!      LOGICAL, PARAMETER :: KBS=.FALSE.
      LOGICAL, PARAMETER :: KBS=.TRUE.
      REAL, PARAMETER :: YTOL=1.E-01
!
      INTEGER, INTENT(IN) :: ILGA,LEVA,ISEC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: SV,AK
      INTEGER, INTENT(IN), DIMENSION(ILGA,LEVA,ISEC) :: IRDS
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISEC) :: WETR,BK,RATP0
      INTEGER, INTENT(INOUT), DIMENSION(ILGA,LEVA,ISEC) :: IMOD1,IMOD2, &
                                                           IMOD3
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISEC) :: WETRT,XP,BKT,BSP, &
                                                      SVT,SC,RC
      INTEGER, INTENT(OUT), DIMENSION(ILGA,LEVA,ISEC) :: IRS,IRGS,IBS
      LOGICAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISEC) :: KGR
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA) :: AKT
      INTEGER, INTENT(OUT), DIMENSION(LEVA,ISEC) :: IRSMAX
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: KOK
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IBST,IRDSL,IRGL,IBTL
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: IRGT
      REAL, ALLOCATABLE, DIMENSION(:) :: BSPL
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XC
!
!-----------------------------------------------------------------------
!
!     * ALLOCATE TEMPORARY ARRAYS.
!
      ALLOCATE(KOK   (ILGA))
      ALLOCATE(IBST  (ILGA))
      ALLOCATE(IRDSL (ILGA))
      ALLOCATE(IRGL  (ILGA))
      ALLOCATE(BSPL  (ILGA))
      ALLOCATE(IBTL  (ILGA))
      ALLOCATE(XC    (ILGA,LEVA,ISEC))
      ALLOCATE(IRGT  (ILGA,LEVA,ISEC,2))
!
!-----------------------------------------------------------------------
!     * INITIALIZATIONS.
!
      AKT=YNA
      BKT=YNA
      XP=YNA
      BSP=YNA
      XC=0.
      WETRT=WETR
      IRGT=IDEF
      IRGS=IDEF
      IBS=IDEF
      DO IS=1,ISEC
        WHERE ( SV < -YSMALL .OR. SV > YSMALL )
          SVT(:,:,IS)=SV(:,:)
        ELSEWHERE
          SVT(:,:,IS)=YSMALL
        ENDWHERE
      ENDDO
!
!-----------------------------------------------------------------------
!     * ESSENTIAL PARAMETERS AND PRELIMINARY DETERMINATION OF GROWTH
!     * REGIME.
!
      DO IS=1,ISEC
      DO L=1,LEVA
      DO IL=1,ILGA
        IRDST=IRDS(IL,L,IS)
        IF ( IRDST /= IDEF ) THEN
!
!         * SCALED B-TERM IN KOEHLER EQUATION.
!
          IF ( KBS ) THEN
            BSP(IL,L,IS)=BK(IL,L,IS)/(SQRT2P3*SVT(IL,L,IS))
            ASP=BSP(IL,L,IS)/RATP0(IL,L,IS)
          ELSE
            ASP=AK(IL,L)/(SQRT2*SVT(IL,L,IS))
            BSP(IL,L,IS)=RATP0(IL,L,IS)*ASP
          ENDIF
!
!         * OVERWRITE ORIGINAL RESULTS FOR AK AND BK BY APPROXIMATE
!         * RESULTS.
!
          AKT(IL,L)=ASP*SQRT2*SVT(IL,L,IS)
          BKT(IL,L,IS)=2.*RATP0(IL,L,IS)*AKT(IL,L)
!
!         * SCALED PARTICLE SIZE.
!
          XP(IL,L,IS)=.5*WETRT(IL,L,IS)**2
!
!         * RESTRICT PARTICLE SIZES TO GIVEN DOMAIN. THE PROGRAM
!         * WILL ABORT IF THE WET PARTICLE SIZE IS SMALLER THAN
!         * THE SMALLEST TABULATED SIZE FOR THE DROPLET GROWTH
!         * CALCULATIONS. REPLACE INPUT DATA TABLE (PROVIDED VIA
!         * MODULE CNEVDT) IN THAT CASE.
!
          IF ( XP(IL,L,IS) < XPMIN(IRDST) ) THEN
!            WRITE(6,*) 'IS,IRDST,XP,XP_MIN=',IS,IRDST,XP(IL,L,IS)
!     1                                      ,XPMIN(IRDST)
!            CALL XIT('CNEXTRP',-1)
            WETRT(IL,L,IS)=RPMIN(IRDST)
            XP(IL,L,IS)=XPMIN(IRDST)
            IMOD1(IL,L,IS)=1
          ENDIF
!
!         * RESTRICT SUPERSATURATION TO GIVEN DOMAIN.
!
          IF ( BSP(IL,L,IS) >= 0. ) THEN
            IF ( BSP(IL,L,IS) < BSMINP(IRDST) ) THEN
              SVT(IL,L,IS)=SVT(IL,L,IS)*BSP(IL,L,IS)/BSMINP(IRDST)
              BSP(IL,L,IS)=BSMINP(IRDST)
              IMOD2(IL,L,IS)=1
            ENDIF
            IF ( BSP(IL,L,IS) > BSMAXP(IRDST) ) THEN
              SVT(IL,L,IS)=SVT(IL,L,IS)*BSP(IL,L,IS)/BSMAXP(IRDST)
              BSP(IL,L,IS)=BSMAXP(IRDST)
              IMOD2(IL,L,IS)=2
            ENDIF
          ELSE
            IF ( BSP(IL,L,IS) < BSMINN(IRDST) ) THEN
              SVT(IL,L,IS)=SVT(IL,L,IS)*BSP(IL,L,IS)/BSMINN(IRDST)
              BSP(IL,L,IS)=BSMINN(IRDST)
              IMOD2(IL,L,IS)=3
            ENDIF
            IF ( BSP(IL,L,IS) > BSMAXN(IRDST) ) THEN
              SVT(IL,L,IS)=SVT(IL,L,IS)*BSP(IL,L,IS)/BSMAXN(IRDST)
              BSP(IL,L,IS)=BSMAXN(IRDST)
              IMOD2(IL,L,IS)=4
            ENDIF
          ENDIF
!
!         * CRITICAL SIZE FOR EACH GROWTH CURVE.
!
          XC(IL,L,IS)=3.*RATP0(IL,L,IS)
!
!         * DETERMINE 2 POSSIBLE GROWTH REGIMES.
!
          IF ( SVT(IL,L,IS) > 0. ) THEN
            IRGT(IL,L,IS,1)=2
            IF (        XP(IL,L,IS) > XC(IL,L,IS) &
                 .AND. BSP(IL,L,IS) > BSCP(IRDST)                ) THEN
              IRGT(IL,L,IS,2)=3
            ELSE
              IRGT(IL,L,IS,2)=1
            ENDIF
          ELSE
            IRGT(IL,L,IS,1)=5
            IF ( XP(IL,L,IS) <= XC(IL,L,IS)                      ) THEN
              IRGT(IL,L,IS,2)=4
            ELSE
              IRGT(IL,L,IS,2)=5
            ENDIF
          ENDIF
        ENDIF
      ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * CRITICAL RADIUS AND SUPERSATURATION FOR EACH GROWTH CURVE
!     * FOR DIAGNOSTIC PURPOSES.
!
      RC=SQRT(2.*XC)
      DO IS=1,ISEC
      DO L=1,LEVA
      DO IL=1,ILGA
        IRDST=IRDS(IL,L,IS)
        IF ( IRDST /= IDEF ) THEN
          SC(IL,L,IS)=AKT(IL,L)/RC(IL,L,IS)-BKT(IL,L,IS)/RC(IL,L,IS)**3
        ELSE
          SC(IL,L,IS)=YNA
          RC(IL,L,IS)=YNA
        ENDIF
      ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * FINALLY DETERMINE GROWTH REGIME.
!
      DO IX=1,2
      DO IS=1,ISEC
      DO L=1,LEVA
        IRDSL(:)=IRDS(:,L,IS)
        IRGL(:)=IRGT(:,L,IS,IX)
        BSPL(:)=BSP(:,L,IS)
!
!       * CHECK WHETHER BS-PARAMETER IS WITHIN THE RANGE OF THE
!       * TABULATED DATA.
!
        KOK=.FALSE.
        DO IL=1,ILGA
          IRDST=IRDSL(IL)
          IF ( IRDST /= IDEF ) THEN
            IRG=IRGL(IL)
            IF ( RGB(IRG)%FLG(IRDST) ) THEN
              IF (       BSPL(IL) >= RGB(IRG)%BSBMIN(IRDST) &
                   .AND. BSPL(IL) <= RGB(IRG)%BSBMAX(IRDST) ) THEN
                KOK(IL)=.TRUE.
              ENDIF
            ENDIF
          ENDIF
        ENDDO

!
!       * DETERMINE INDEX FOR BS-PARAMETER FOR CORRESPONDING
!       * TABULATED DATA
!
        DO IL=1,ILGA
          IF ( KOK(IL) ) THEN
            IBTL(IL)=RGB(IRGL(IL))%IBT
          ENDIF
        ENDDO
        IBST=IDEF
        DO IB=1,IBTMAX
        DO IL=1,ILGA
          IF ( KOK(IL) ) THEN
            IRDST=IRDSL(IL)
            IRG=IRGL(IL)
            IF ( IB <= IBTL(IL) ) THEN
              ID=IDBSB(IRG,IRDST,IB)
              IF ( BSPL(IL) >= RBSB(ID) ) THEN
                IBST(IL)=IB
              ENDIF
            ENDIF
          ENDIF
        ENDDO
        ENDDO
!
!       * LOWER AND UPPER VALUES OF THE XP-PARAMETER IN THE TABULATED
!       * DATA FOR GIVEN BS-PARAMETER. CHECK IF XP FALLS INTO THAT RANGE
!       * AND SAVE INDICES FOR THE TABULATED DATA FOR THAT POINT IF THAT
!       * IS THE CASE. OTHERWISE, NO CHANGE IN PARTICLE SIZE IS
!       * ANTICIPATED BECAUSE THE PARTICLE SIZE IS ALREADY IN EQUILIBRIUM.
!
        DO IL=1,ILGA
          IF ( KOK(IL) ) THEN
            IRDST=IRDSL(IL)
            IRG=IRGL(IL)
            IBSTT=IBST(IL)
            IDL=IDPL(IRG,IRDST,IBSTT)
            IDU=IDPU(IRG,IRDST,IBSTT)
            XPL=XPPNTL(IDL)+BSPL(IL)*XPDERL(IDL)
            XPU=XPPNTU(IDU)+BSPL(IL)*XPDERU(IDU)
            IF (     (XP(IL,L,IS) >= XPL .AND. XP(IL,L,IS) <= XPU) &
                .OR. (XP(IL,L,IS) > XPU &
                      .AND. RGPN(IRG)%KOPEN(IBSTT,IRDST))        ) THEN
              IBS(IL,L,IS)=IBSTT
              IRGS(IL,L,IS)=IRG
              IMOD3(IL,L,IS)=0
            ELSE
              IMOD3(IL,L,IS)=2
            ENDIF
          ENDIF
        ENDDO
      ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * INTERPOLATION OF TABULATED DATA.
!
      IRS(:,:,:)=0
      IRSMAX=0
      IRSTMAX=0
      DO IS=1,ISEC
      DO L=1,LEVA
        DO IL=1,ILGA
          IRGST=IRGS(IL,L,IS)
          IF ( IRGST /= IDEF ) THEN
!
!           * DETERMINE NUMBER OF POINTS IN TABULATED DATA FOR THE GIVEN
!           * SLICE OF THE DATA.
!
            IRDST=IRDS(IL,L,IS)
            IBSTT=IBS(IL,L,IS)
            IRSTT=RGPN(IRGST)%IPNTS(IBSTT,IRDST)
            IRS(IL,L,IS)=IRSTT
            IRSMAX(L,IS)=MAX(IRSMAX(L,IS),IRSTT)
            IRSTMAX=MAX(IRSTMAX,IRSTT)
!
!           * DETERMINE IF GROWTH IS POSITIVE OR NEGATIVE. POSITIVE
!           * (NEGATIVE) GROWTH MEANS THAT THE NORMALIZED TIME
!           * INCREASES (DECREASES) WITH INCREASING SIZE.
!
            IF ( IRGST == 2 .OR. IRGST == 5 ) THEN
              KGR(IL,L,IS)=.FALSE.
            ELSE
              KGR(IL,L,IS)=.TRUE.
            ENDIF
          ENDIF
        ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!     * DEALLOCATE TEMPORARY ARRAYS.
!
      DEALLOCATE(KOK)
      DEALLOCATE(IBST)
      DEALLOCATE(IRDSL)
      DEALLOCATE(IRGL)
      DEALLOCATE(BSPL)
      DEALLOCATE(IBTL)
      DEALLOCATE(XC)
      DEALLOCATE(IRGT)
!
      END SUBROUTINE CNEXTRP
