      SUBROUTINE SICPRD (PEDNDT,PEDMDT,PIDNDT,PIDMDT,PIDFDT, &
                         DERSN,DERSM,DIRSMN,DIRSN,DIRSMS, &
                         TEXSVI,TEXSVIP,TEXSVIA,TIMASS,TIMASSP, &
                         TIMASSA,TIDEN,TEICRIT,TIICRIT,PESMAS, &
                         PEMAS,PENUM,PEN0,PEPHI0,PEPSI,PEDDN, &
                         PISMAS,PIMAS,PINUM,PIN0,PIPHI0,PIPSI, &
                         PIDDN,PIFRC,DT,ILGA,LEVA,IERR)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     IN-CLOUD PRODUCTION OF SULPHATE FOR STRATIFORM CLOUDS.
!
!     HISTORY:
!     --------
!     * JUN 12/2008 - K.VONSALZEN   INCLUDE CRITICAL PARTICLE SIZE
!     * SEP 28/2007 - K.VONSALZEN   NEW.
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE SDCODE
      USE FPDEF
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      INTEGER, PARAMETER :: IMODC=2
      INTEGER, INTENT(OUT) :: IERR
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA) :: DERSN,DERSM
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA) :: DIRSMN,DIRSN,DIRSMS
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISAEXT) :: PEDNDT,PEDMDT
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISAINT) :: PIDNDT,PIDMDT
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIDFDT
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAEXT) :: &
                            PENUM,PEMAS,PEN0,PEPHI0,PEPSI,PEDDN
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT) :: &
                            PINUM,PIMAS,PIN0,PIPHI0,PIPSI,PIDDN
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIFRC
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: PESMAS,PISMAS
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: TIMASS,TIMASSP,TIDEN, &
                                                TEXSVI,TEXSVIP, &
                                                TEXSVIA,TIMASSA
      INTEGER, INTENT(IN), DIMENSION(ILGA,LEVA,KEXT) :: TEICRIT
      INTEGER, INTENT(IN), DIMENSION(ILGA,LEVA) :: TIICRIT
      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: TIMN,TIFRCN
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
                                    TEN0,TEPHI0,TEPSI,TEDDN,TEFRC, &
                                    TECGR1,TECGR2
      REAL(R8), ALLOCATABLE, DIMENSION(:,:,:) :: &
                                    TEDP0L,TEDP1L,TEDP2L,TEDP3L, &
                                    TEDP4L,TEDP5L,TEDP6L,TEDM1L, &
                                    TEDM2L,TEDM3L,TEDP0R,TEDP1R, &
                                    TEDP2R,TEDP3R,TEDP4R,TEDP5R, &
                                    TEDP6R,TEDM1R,TEDM2R,TEDM3R, &
                                    TEDP0S,TEDP1S,TEDP2S,TEDP3S, &
                                    TEDP4S,TEDP5S,TEDP6S,TEDM1S, &
                                    TEDM2S,TEDM3S
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
                                    TIN0,TIPHI0,TIPSI,TIDDN,TIFRCS, &
                                    TICGR1,TICGR2
      REAL(R8), ALLOCATABLE, DIMENSION(:,:,:) :: &
                                    TIDP0L,TIDP1L,TIDP2L,TIDP3L, &
                                    TIDP4L,TIDP5L,TIDP6L,TIDM1L, &
                                    TIDM2L,TIDM3L,TIDP0R,TIDP1R, &
                                    TIDP2R,TIDP3R,TIDP4R,TIDP5R, &
                                    TIDP6R,TIDM1R,TIDM2R,TIDM3R, &
                                    TIDP0S,TIDP1S,TIDP2S,TIDP3S, &
                                    TIDP4S,TIDP5S,TIDP6S,TIDM1S, &
                                    TIDM2S,TIDM3S
      REAL(R8), ALLOCATABLE, DIMENSION(:,:,:) :: TEMT,TIMST
      REAL(R8), ALLOCATABLE, DIMENSION(:,:,:,:) :: TIMNT
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: TEN,TENT,TEM, &
                                             TEDRYR,TEDPHIS,TEPHISS
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: TIN,TINT,TIM,TIMT, &
                                             TIMS,TIRSMN, &
                                             TITM1,TITM2, &
                                             TIDRYR,TIDPHIS,TIPHISS
      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERM1,TERM2,TERM3,TERM4
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: TEI0L,TEI0R
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: TII0L,TII0R
!
!-----------------------------------------------------------------------
!     * INITIALIZATION.
!
      IF ( ISAEXT > 0 ) THEN
        PEDNDT=0.
        PEDMDT=0.
      ENDIF
      IF ( ISAINT > 0 ) THEN
        PIDNDT=0.
        PIDMDT=0.
        PIDFDT=0.
      ENDIF
      IERR=0
!
!-----------------------------------------------------------------------
!     * ALLOCATE MEMORY FOR LOCAL FIELDS.
!
      IF ( ISEXTSO4 > 0 ) THEN
        ALLOCATE(TECGR1 (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TECGR2 (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEN0   (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEPHI0 (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEPSI  (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDDN  (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEM    (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEMT   (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEN    (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TENT   (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEI0L  (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEI0R  (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP0L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP1L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP2L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP3L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP4L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP5L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP6L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM1L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM2L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM3L (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP0R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP1R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP2R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP3R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP4R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP5R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP6R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM1R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM2R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM3R (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP0S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP1S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP2S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP3S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP4S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP5S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDP6S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM1S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM2S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDM3S (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEFRC  (ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDPHIS(ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEPHISS(ILGA,LEVA,ISEXTSO4))
        ALLOCATE(TEDRYR (ILGA,LEVA,ISEXTSO4+1))
      ENDIF
      IF ( ISINTSO4 > 0 ) THEN
        ALLOCATE(TICGR1 (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TICGR2 (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIMN   (ILGA,LEVA,ISINTSO4,ISO4S))
        ALLOCATE(TIMNT  (ILGA,LEVA,ISINTSO4,ISO4S))
        ALLOCATE(TIFRCN (ILGA,LEVA,ISINTSO4,ISO4S))
        ALLOCATE(TIFRCS (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIN0   (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIPHI0 (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIPSI  (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDDN  (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIM    (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIMT   (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIN    (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TINT   (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIMS   (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIMST  (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TII0L  (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TII0R  (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP0L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP1L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP2L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP3L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP4L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP5L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP6L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM1L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM2L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM3L (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP0R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP1R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP2R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP3R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP4R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP5R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP6R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM1R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM2R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM3R (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP0S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP1S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP2S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP3S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP4S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP5S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDP6S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM1S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM2S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDM3S (ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIRSMN (ILGA,LEVA,ISO4S))
        ALLOCATE(TITM1  (ILGA,LEVA,ISO4S))
        ALLOCATE(TITM2  (ILGA,LEVA,ISO4S))
        ALLOCATE(TIDPHIS(ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIPHISS(ILGA,LEVA,ISINTSO4))
        ALLOCATE(TIDRYR (ILGA,LEVA,ISINTSO4+1))
      ENDIF
      ALLOCATE(TERM1(ILGA,LEVA))
      ALLOCATE(TERM2(ILGA,LEVA))
      ALLOCATE(TERM3(ILGA,LEVA))
      ALLOCATE(TERM4(ILGA,LEVA))
!
!-----------------------------------------------------------------------
!     * TEMPORARY AEROSOL FIELDS FOR SULPHATE AEROSOL FOR DRY
!     * AND WET PARTICLE SIZES FOR EXTERNALLY MIXED AEROSOL TYPE.
!
      IF ( KEXTSO4 > 0 ) THEN
        DO IS=1,ISEXTSO4
          TEN    (:,:,IS)=PENUM  (:,:,IEXSO4(IS))
          TEM    (:,:,IS)=PEMAS  (:,:,IEXSO4(IS))
          TEN0   (:,:,IS)=PEN0   (:,:,IEXSO4(IS))
          TEPHI0 (:,:,IS)=PEPHI0 (:,:,IEXSO4(IS))
          TEPSI  (:,:,IS)=PEPSI  (:,:,IEXSO4(IS))
          TEDDN  (:,:,IS)=PEDDN  (:,:,IEXSO4(IS))
          TEDPHIS(:,:,IS)=PEDPHIS(IEXSO4(IS))
          TEPHISS(:,:,IS)=PEPHISS(IEXSO4(IS))
          TEDRYR (:,:,IS)=AEXTF%TP(KEXTSO4)%DRYR(IS)%VL
        ENDDO
        TEDRYR(:,:,ISEXTSO4+1)=AEXTF%TP(KEXTSO4)%DRYR(ISEXTSO4)%VR
      ENDIF
!
!     * TEMPORARY AEROSOL FIELDS FOR SULPHATE AEROSOL FOR DRY
!     * AND WET PARTICLE SIZES FOR INTERNALLY MIXED AEROSOL TYPE.
!
      IF ( KINTSO4 > 0 ) THEN
        DO IS=1,ISINTSO4
          TIN    (:,:,IS)=PINUM  (:,:,IINSO4(IS))
          TIM    (:,:,IS)=PIMAS  (:,:,IINSO4(IS))
          TIMS   (:,:,IS)=PIMAS  (:,:,IINSO4(IS)) &
                         *PIFRC  (:,:,IINSO4(IS),KINTSO4)
          TIFRCS (:,:,IS)=PIFRC  (:,:,IINSO4(IS),KINTSO4)
          DO IT=1,ISO4S
            TIMN(:,:,IS,IT)=PIMAS  (:,:,IINSO4(IS)) &
                           *PIFRC  (:,:,IINSO4(IS),ITSO4(IT))
            TIFRCN(:,:,IS,IT)=PIFRC(:,:,IINSO4(IS),ITSO4(IT))
          ENDDO
          TIN0   (:,:,IS)=PIN0   (:,:,IINSO4(IS))
          TIPHI0 (:,:,IS)=PIPHI0 (:,:,IINSO4(IS))
          TIPSI  (:,:,IS)=PIPSI  (:,:,IINSO4(IS))
          TIDDN  (:,:,IS)=PIDDN  (:,:,IINSO4(IS))
          TIDPHIS(:,:,IS)=PIDPHIS(IINSO4(IS))
          TIPHISS(:,:,IS)=PIPHISS(IINSO4(IS))
          TIDRYR (:,:,IS)=AINTF%DRYR(IINSO4(IS))%VL
        ENDDO
        TIDRYR(:,:,ISINTSO4+1)=AINTF%DRYR(AINTF%TP(KINTSO4)%ISCE)%VR
      ENDIF
!
!-----------------------------------------------------------------------
!     * GROWTH FACTOR FROM R(T)=R(T=0)*C, WITH C=CGR1+CGR2*R(T=0),
!     * FOR DRY PARTICLE RADIUS R AND TIME T. IT IS ASSUMED THAT
!     * THE RELATIVE INCREASE IN DRY PARTICLE RADIUS FOR EACH SECTION
!     * EQUALS (VT/V)**(1/3), WHERE V IS THE INITIAL TOTAL VOLUME FOR
!     * (NH4)2SO4 AEROSOL AND VT IS THE VOLUME AFTER IN-CLOUD PRODUCTION.
!     * IN OTHER WORDS, IN-CLOUD CHEMICAL PRODUCTION OF SULPHATE AEROSOL
!     * IS ASSUMED TO BE PROPORTIONAL TO THE INITIAL VOLUME OF
!     * AEROSOL IN THE DROPLETS (VOLUME-CONTROLLED GROWTH).
!
      TERM4=1./3.
      IF ( ISEXTSO4 > 0 ) THEN
!
!       * RATIO OF NEW AEROSOL VOLUME CONCENTRATION OVER ORIGINAL
!       * CONCENTRATION FOR ACTIVATED PARTICLES AND GROWTH FACTOR
!       * FOR FULLY ACTIVATED SIZE SECTIONS.
!
        WHERE ( TEXSVI > MAX(PESMAS/YLARGE,YTINY) )
          TERM1=1.+PESMAS/TEXSVI
          TERM1=MIN(MAX(TERM1,1.),YLARGE)
        ELSEWHERE
          TERM1=1.
        ENDWHERE
        TERM2=TERM1**TERM4
!
!       * THE SAME AS ABOVE FOR PARTIALLY ACTIVATED SIZE SECTION.
!       * COMPUTE THE RATIO OF VOLUME CHANGE PER CURRENT VOLUME IN
!       * PARTLY ACTIVATED SECTION (TERM1) USING THE CHANGE IN VOLUME
!       * IN THAT SECTION (TERM5).
!
        TERM3=TERM1
        TERM1=1.
        DO L=1,LEVA
        DO IL=1,ILGA
          ISL=TEICRIT(IL,L,KEXTSO4)
          IF ( ISL /= INA ) THEN
            TERM5=(TERM3(IL,L)-1.)*TEXSVIP(IL,L)
            TERM6=TEXSVIA(IL,L)
            IF ( TERM6 > MAX(TERM5/YLARGE,YTINY) ) THEN
              TERM1(IL,L)=1.+TERM5/TERM6
            ENDIF
          ENDIF
        ENDDO
        ENDDO
        TERM1=MIN(MAX(TERM1,1.),TERM3)
        TERM3=TERM1**TERM4
!
!       * SAVE RESULTS FOR GROWTH FACTOR.
!
        TECGR1=1.
        TECGR2=0.
        DO L=1,LEVA
        DO IL=1,ILGA
          ISL=TEICRIT(IL,L,KEXTSO4)
          IF ( ISL /= INA ) THEN
            TECGR1(IL,L,ISL)=MAX(TERM3(IL,L),1.)
            DO IS=ISL+1,ISEXTSO4
              TECGR1(IL,L,IS)=MAX(TERM2(IL,L),1.)
            ENDDO
          ENDIF
        ENDDO
        ENDDO
      ENDIF
      IF ( ISINTSO4 > 0 ) THEN
!
!       * RATIO OF NEW AEROSOL VOLUME CONCENTRATION OVER ORIGINAL
!       * CONCENTRATION FOR ACTIVATED PARTICLES AND GROWTH FACTOR
!       * FOR FULLY ACTIVATED SIZE SECTIONS.
!
        TERM1=PISMAS/AINTF%TP(KINTSO4)%DENS
        WHERE ( TIMASS > MAX(TERM1*TIDEN/YLARGE,YTINY) )
          TERM1=1.+TERM1*TIDEN/TIMASS
          TERM1=MIN(MAX(TERM1,1.),YLARGE)
        ELSEWHERE
          TERM1=1.
        ENDWHERE
        TERM2=TERM1**TERM4
!
!       * THE SAME AS ABOVE FOR PARTIALLY ACTIVATED SIZE SECTION.
!       * COMPUTE THE RATIO OF VOLUME CHANGE PER CURRENT VOLUME IN
!       * PARTLY ACTIVATED SECTION (TERM6) USING THE CHANGE IN VOLUME
!       * IN THAT SECTION (TERM5).
!
        TERM3=TERM1
        TERM1=1.
        DO L=1,LEVA
        DO IL=1,ILGA
          ISL=TIICRIT(IL,L)
          IF ( ISL /= INA ) THEN
            TERM5=(TERM3(IL,L)-1.)*TIMASSP(IL,L)
            TERM6=TIMASSA(IL,L)
            IF ( TERM6 > MAX(TERM5/YLARGE,YTINY) ) THEN
              TERM1(IL,L)=1.+TERM5/TERM6
            ENDIF
          ENDIF
        ENDDO
        ENDDO
        TERM1=MIN(MAX(TERM1,1.),TERM3)
        TERM3=TERM1**TERM4
!
!       * SAVE RESULTS FOR GROWTH FACTOR.
!
        TICGR1=1.
        TICGR2=0.
        DO L=1,LEVA
        DO IL=1,ILGA
          ISL=TIICRIT(IL,L)
          IF ( ISL /= INA ) THEN
            TICGR1(IL,L,ISL)=MAX(TERM3(IL,L),1.)
            DO IS=ISL+1,ISINTSO4
              TICGR1(IL,L,IS)=MAX(TERM2(IL,L),1.)
            ENDDO
          ENDIF
        ENDDO
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * PARTICLE GROWTH DUE TO CONDENSATION/EVAPORATION. THE FOLLOWING
!     * CALCULATIONS PROVIDE THE UPDATED SIZE DISTRIBUTIONS FOR
!     * PARTICLE NUMBER, SULPHUR AEROSOL MASS, AND MASS OF OTHER
!     * AEROSOL SPECIES AFTER THE CONDENSATION STEP.
!
      DERSN=0.
      DERSM=0.
      IF ( ISEXTSO4 > 0 ) THEN
        CALL PGRPAR (TEDP0L,TEDP1L,TEDP2L,TEDP3L,TEDP4L,TEDP5L,TEDP6L, &
                     TEDM1L,TEDM2L,TEDM3L,TEDP0R,TEDP1R,TEDP2R,TEDP3R, &
                     TEDP4R,TEDP5R,TEDP6R,TEDM1R,TEDM2R,TEDM3R,TEDP0S, &
                     TEDP1S,TEDP2S,TEDP3S,TEDP4S,TEDP5S,TEDP6S,TEDM1S, &
                     TEDM2S,TEDM3S,TEI0L,TEI0R,TECGR1,TECGR2,TEN0, &
                     TEDRYR,TEPHISS,TEDPHIS,TEPHI0,TEPSI,ILGA,LEVA, &
                     ISEXTSO4,IERR,IMODC)
        CALL PGRWTH0(TENT,DERSN,TEI0L,TEI0R,TEDP0L,TEDP0R,TEDP0S, &
                     TEN0,ILGA,LEVA,ISEXTSO4)
        TEFRC(:,:,:)=1.
        CALL PGRWTHC(TEMT,DERSM,TEFRC,TEI0L,TEI0R, &
                     TEDP3L,TEDP4L,TEDP5L,TEDP6L,TEDP3R,TEDP4R,TEDP5R, &
                     TEDP6R,TEDP3S,TEDP4S,TEDP5S,TEDP6S, &
                     TECGR1,TECGR2,TEN0,TEDDN,ILGA,LEVA,ISEXTSO4)
      ENDIF
      DIRSN=0.
      DIRSMS=0.
      DIRSMN=0.
      IF ( ISINTSO4 > 0 ) THEN
        CALL PGRPAR (TIDP0L,TIDP1L,TIDP2L,TIDP3L,TIDP4L,TIDP5L,TIDP6L, &
                     TIDM1L,TIDM2L,TIDM3L,TIDP0R,TIDP1R,TIDP2R,TIDP3R, &
                     TIDP4R,TIDP5R,TIDP6R,TIDM1R,TIDM2R,TIDM3R,TIDP0S, &
                     TIDP1S,TIDP2S,TIDP3S,TIDP4S,TIDP5S,TIDP6S,TIDM1S, &
                     TIDM2S,TIDM3S,TII0L,TII0R,TICGR1,TICGR2,TIN0, &
                     TIDRYR,TIPHISS,TIDPHIS,TIPHI0,TIPSI,ILGA,LEVA, &
                     ISINTSO4,IERR,IMODC)
        CALL PGRWTH0(TINT,DIRSN,TII0L,TII0R,TIDP0L,TIDP0R,TIDP0S, &
                     TIN0,ILGA,LEVA,ISINTSO4)
        CALL PGRWTHC(TIMST,DIRSMS,TIFRCS,TII0L,TII0R, &
                     TIDP3L,TIDP4L,TIDP5L,TIDP6L,TIDP3R,TIDP4R,TIDP5R, &
                     TIDP6R,TIDP3S,TIDP4S,TIDP5S,TIDP6S, &
                     TICGR1,TICGR2,TIN0,TIDDN,ILGA,LEVA,ISINTSO4)
        IF ( ISO4S > 0 ) THEN
          TIRSMN=0.
          CALL PGRWTHN(TIMNT,TIRSMN,TIFRCN,TII0L,TII0R,TIDP3L,TIDP3R, &
                       TIDP3S,TIN0,TIDDN,ILGA,LEVA,ISO4S,ISINTSO4)
          DIRSMN=SUM(TIRSMN,DIM=3)
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!     * NUMBER AND MASS FIXERS. THIS CORRECTS FOR ANY TRUNCATION
!     * ERRORS THAT MAY HAVE OCCURRED PREVIOUSLY. THE APPROACH IS
!     * TO SCALE THE TOTAL NUMBER AND MASS CONCENTRATIONS SO THAT THE
!     * FINAL TOTAL MASS WILL BE CONSISTENT WITH THE CORRESPONDING
!     * PHYSICO-CHEMICAL PRODUCTION AND LOSS RATES.
!
      TERM1=0.
      TERM2=0.
      TERM3=0.
      TERM4=0.
      IF ( ISEXTSO4 > 0 ) THEN
        TENT=MAX(TENT,0.)
        TEMT=MAX(TEMT,0._R8)
        TERM1=TERM1+SUM(TEMT,DIM=3)+DERSM
        TERM2=TERM2+SUM(TENT,DIM=3)+DERSN
        TERM3=TERM3+PESMAS+SUM(TEM,DIM=3)
        TERM4=TERM4+SUM(TEN ,DIM=3)
      ENDIF
      IF ( ISINTSO4 > 0 ) THEN
        TINT=MAX(TINT,0.)
        TIMST=MAX(TIMST,0._R8)
        TERM1=TERM1+SUM(TIMST,DIM=3)+DIRSMS
        TERM2=TERM2+SUM(TINT ,DIM=3)+DIRSN
        TERM3=TERM3+PISMAS+SUM(TIMS,DIM=3)
        TERM4=TERM4+SUM(TIN  ,DIM=3)
        IF ( ISO4S > 0 ) THEN
          TITM1=SUM(TIMNT,DIM=3)+TIRSMN
          TITM2=SUM(TIMN ,DIM=3)
        ENDIF
      ENDIF
!
      DO L=1,LEVA
      DO IL=1,ILGA
!
!       * CORRECT AEROSOL NUMBER CONCENTRATION.
!
        IF ( TERM2(IL,L) > MAX(TERM4(IL,L)/YLARGE,YTINY) ) THEN
          CFN=TERM4(IL,L)/TERM2(IL,L)
          IF ( ISEXTSO4 > 0 ) TENT(IL,L,:)=TENT(IL,L,:)*CFN
          IF ( ISINTSO4 > 0 ) TINT(IL,L,:)=TINT(IL,L,:)*CFN
        ENDIF
!
!       * CORRECT SULPHUR AEROSOL MASS CONCENTRATION.
!
        IF ( TERM1(IL,L) > MAX(TERM3(IL,L)/YLARGE,YTINY) ) THEN
          CFM=TERM3(IL,L)/TERM1(IL,L)
          IF ( ISEXTSO4 > 0 ) TEMT (IL,L,:)=TEMT (IL,L,:)*CFM
          IF ( ISINTSO4 > 0 ) TIMST(IL,L,:)=TIMST(IL,L,:)*CFM
        ENDIF
      ENDDO
      ENDDO
!
!     * CORRECT NON-SULPHATE AEROSOL MASS CONCENTRATION.
!
      IF ( ISINTSO4 > 0 ) THEN
        DO IT=1,ISO4S
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( TITM1(IL,L,IT) > MAX(TITM2(IL,L,IT)/YLARGE,YTINY) ) THEN
            CFM=TITM2(IL,L,IT)/TITM1(IL,L,IT)
            TIMNT(IL,L,:,IT)=TIMNT(IL,L,:,IT)*CFM
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * TOTAL AEROSOL MASS FOR INTERNALLY MIXED AEROSOL SPECIES.
!
      IF ( KINTSO4 > 0 ) THEN
        TIMT=TIMST
        DO IT=1,ISO4S
          TIMT(:,:,:)=TIMT(:,:,:)+TIMNT(:,:,:,IT)
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * TRACER TENDENCIES.
!
      IF ( KEXTSO4 > 0 ) THEN
        DO IS=1,ISEXTSO4
          PEDNDT(:,:,IEXSO4(IS))=(TENT(:,:,IS)-TEN(:,:,IS))/DT
          PEDMDT(:,:,IEXSO4(IS))=(TEMT(:,:,IS)-TEM(:,:,IS))/DT
        ENDDO
      ENDIF
      IF ( KINTSO4 > 0 ) THEN
        DO IS=1,ISINTSO4
          PIDNDT(:,:,IINSO4(IS))=(TINT(:,:,IS)-TIN(:,:,IS))/DT
          PIDMDT(:,:,IINSO4(IS))=(TIMT(:,:,IS)-TIM(:,:,IS))/DT
          WHERE ( TIMT(:,:,IS) > MAX(TIMST(:,:,IS)/YLARGE8,YTINY8) )
            PIDFDT(:,:,IINSO4(IS),KINTSO4)= &
                         (TIMST(:,:,IS)/TIMT(:,:,IS)-TIFRCS(:,:,IS))/DT
          ELSEWHERE
            PIDFDT(:,:,IINSO4(IS),KINTSO4)=-TIFRCS(:,:,IS)/DT
          ENDWHERE
          DO IT=1,ISO4S
            WHERE ( TIMT(:,:,IS) &
                               > MAX(TIMNT(:,:,IS,IT)/YLARGE8,YTINY8) )
              PIDFDT(:,:,IINSO4(IS),ITSO4(IT))= &
                   (TIMNT(:,:,IS,IT)/TIMT(:,:,IS)-TIFRCN(:,:,IS,IT))/DT
            ELSEWHERE
              PIDFDT(:,:,IINSO4(IS),ITSO4(IT))=-TIFRCN(:,:,IS,IT)/DT
            ENDWHERE
          ENDDO
        ENDDO
      ENDIF
!
!     * DEALLOCATION.
!
      IF ( ISEXTSO4 > 0 ) THEN
        DEALLOCATE(TECGR1 )
        DEALLOCATE(TECGR2 )
        DEALLOCATE(TEN0   )
        DEALLOCATE(TEPHI0 )
        DEALLOCATE(TEPSI  )
        DEALLOCATE(TEDDN  )
        DEALLOCATE(TEM    )
        DEALLOCATE(TEMT   )
        DEALLOCATE(TEN    )
        DEALLOCATE(TENT   )
        DEALLOCATE(TEI0L  )
        DEALLOCATE(TEI0R  )
        DEALLOCATE(TEDP0L )
        DEALLOCATE(TEDP1L )
        DEALLOCATE(TEDP2L )
        DEALLOCATE(TEDP3L )
        DEALLOCATE(TEDP4L )
        DEALLOCATE(TEDP5L )
        DEALLOCATE(TEDP6L )
        DEALLOCATE(TEDM1L )
        DEALLOCATE(TEDM2L )
        DEALLOCATE(TEDM3L )
        DEALLOCATE(TEDP0R )
        DEALLOCATE(TEDP1R )
        DEALLOCATE(TEDP2R )
        DEALLOCATE(TEDP3R )
        DEALLOCATE(TEDP4R )
        DEALLOCATE(TEDP5R )
        DEALLOCATE(TEDP6R )
        DEALLOCATE(TEDM1R )
        DEALLOCATE(TEDM2R )
        DEALLOCATE(TEDM3R )
        DEALLOCATE(TEDP0S )
        DEALLOCATE(TEDP1S )
        DEALLOCATE(TEDP2S )
        DEALLOCATE(TEDP3S )
        DEALLOCATE(TEDP4S )
        DEALLOCATE(TEDP5S )
        DEALLOCATE(TEDP6S )
        DEALLOCATE(TEDM1S )
        DEALLOCATE(TEDM2S )
        DEALLOCATE(TEDM3S )
        DEALLOCATE(TEFRC  )
        DEALLOCATE(TEDPHIS)
        DEALLOCATE(TEPHISS)
        DEALLOCATE(TEDRYR )
      ENDIF
      IF ( ISINTSO4 > 0 ) THEN
        DEALLOCATE(TICGR1 )
        DEALLOCATE(TICGR2 )
        DEALLOCATE(TIMN   )
        DEALLOCATE(TIMNT  )
        DEALLOCATE(TIFRCN )
        DEALLOCATE(TIFRCS )
        DEALLOCATE(TIN0   )
        DEALLOCATE(TIPHI0 )
        DEALLOCATE(TIPSI  )
        DEALLOCATE(TIDDN  )
        DEALLOCATE(TIM    )
        DEALLOCATE(TIMT   )
        DEALLOCATE(TIN    )
        DEALLOCATE(TINT   )
        DEALLOCATE(TIMS   )
        DEALLOCATE(TIMST  )
        DEALLOCATE(TII0L  )
        DEALLOCATE(TII0R  )
        DEALLOCATE(TIDP0L )
        DEALLOCATE(TIDP1L )
        DEALLOCATE(TIDP2L )
        DEALLOCATE(TIDP3L )
        DEALLOCATE(TIDP4L )
        DEALLOCATE(TIDP5L )
        DEALLOCATE(TIDP6L )
        DEALLOCATE(TIDM1L )
        DEALLOCATE(TIDM2L )
        DEALLOCATE(TIDM3L )
        DEALLOCATE(TIDP0R )
        DEALLOCATE(TIDP1R )
        DEALLOCATE(TIDP2R )
        DEALLOCATE(TIDP3R )
        DEALLOCATE(TIDP4R )
        DEALLOCATE(TIDP5R )
        DEALLOCATE(TIDP6R )
        DEALLOCATE(TIDM1R )
        DEALLOCATE(TIDM2R )
        DEALLOCATE(TIDM3R )
        DEALLOCATE(TIDP0S )
        DEALLOCATE(TIDP1S )
        DEALLOCATE(TIDP2S )
        DEALLOCATE(TIDP3S )
        DEALLOCATE(TIDP4S )
        DEALLOCATE(TIDP5S )
        DEALLOCATE(TIDP6S )
        DEALLOCATE(TIDM1S )
        DEALLOCATE(TIDM2S )
        DEALLOCATE(TIDM3S )
        DEALLOCATE(TIRSMN )
        DEALLOCATE(TITM1  )
        DEALLOCATE(TITM2  )
        DEALLOCATE(TIDPHIS)
        DEALLOCATE(TIPHISS)
        DEALLOCATE(TIDRYR )
      ENDIF
      DEALLOCATE(TERM1)
      DEALLOCATE(TERM2)
      DEALLOCATE(TERM3)
      DEALLOCATE(TERM4)
!
      END SUBROUTINE SICPRD
