      SUBROUTINE BHNUCL(SXP,ANUCL,T,RH,PMASS,YSCALE,ILGA,LEVA)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     CALCULATION OF COEFFICIENTS FOR NUCLEATION RATE ANUCL*C**SXP
!     ACCORDING TO VON SALZEN ET AL. (2000) USING THE PARAMETERIZATION
!     OF KULMALA ET AL. (1998). IT IS ASSUMED THAT SUFFICIENT AMMONIA
!     IS AVAILABLE TO FORM (NH4)2S04 PARTICLES ONCE THE PARTICLES
!     ARE PRODUCED BY NUCLEATION. ALTHOUGH THE PATRICLES INTIALLY
!     CONTAIN WATER THEY ARE INJECTED AS DRY PARTICLES AT THE LOWER
!     BOUNDARY OF THE SIZE SPECTRUM.
!
!     HISTORY:
!     --------
!     * APR 17/2015 - K.VONSALZEN   CHANGES TO SUPPORT SINGLE PRECISION
!     * DEC 11/2005 - K.VONSALZEN   NEW.
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE FPDEF
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      REAL(R8), INTENT(OUT), DIMENSION(ILGA,LEVA) :: ANUCL,SXP
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: T,RH
      REAL, INTENT(IN) :: YSCALE,PMASS
      INTEGER, INTENT(IN) :: ILGA,LEVA
      REAL(R8), ALLOCATABLE, DIMENSION(:,:) :: &
                                    TB,RHB,ANW,TERM,TERMX,TERMY,ADELTA, &
                                    APARA,APARB,APARC,APARD,ACONCR,SXPT
      REAL(R8) :: APARE
!
      REAL(R8), PARAMETER :: YVOLC =1.E+06_R8 ! FOR CONVERSION 1/CM**3->1/M**3
!
!-----------------------------------------------------------------------
!
!     * ALLOCATE WORK ARRAYS.
!
      ALLOCATE(TB    (ILGA,LEVA))
      ALLOCATE(RHB   (ILGA,LEVA))
      ALLOCATE(ANW   (ILGA,LEVA))
      ALLOCATE(TERM  (ILGA,LEVA))
      ALLOCATE(TERMX (ILGA,LEVA))
      ALLOCATE(TERMY (ILGA,LEVA))
      ALLOCATE(ADELTA(ILGA,LEVA))
      ALLOCATE(APARA (ILGA,LEVA))
      ALLOCATE(APARB (ILGA,LEVA))
      ALLOCATE(APARC (ILGA,LEVA))
      ALLOCATE(APARD (ILGA,LEVA))
      ALLOCATE(ACONCR(ILGA,LEVA))
      ALLOCATE(SXPT  (ILGA,LEVA))
!
!     * RESTRICT RANGE FOR TEMPERATURE AND RELATIVE HUMDITY.
!
      TB=T
      RHB=RH
!                                                  D!PROC-DEPEND
!      TB=DMAX1(DMIN1(TB,298._R8),233._R8)
!      RHB=DMAX1(DMIN1(RHB,1.0_R8),0.01_R8)
!                                                   !PROC-DEPEND
      TB=MAX(MIN(TB,298._R8),233._R8)
      RHB=MAX(MIN(RHB,1.0_R8),0.01_R8)
!
!     * WATER VAPOUR CONCENTRATION (IN 1/CM3).
!
      TERM=LOG(TB)
      TERMX=77.34491296_R8-7235.42451_R8/TB-8.2_R8*TERM &
           +5.7113E-03_R8*TB
      ANW=EXP(TERMX)
      ANW=RHB*ANW/(AKB*TB*YVOLC)
      ADELTA=TB/273.15_R8
      APARA=25.1289_R8-4890.8_R8/TB-2.2479_R8*ADELTA*RHB
      APARB=7643.4_R8/TB-1.9712_R8*ADELTA/RHB
      APARC=-1743.3_R8/TB
      TERM=LOG(ANW)
      APARD=1.2233_R8-0.0154_R8*ARA/(ARA+RHB)-0.0415_R8*TERM &
           +0.0016_R8*TB
      APARE=0.0102_R8
!
!     * THRESHOLD H2SO4 CONCENTRATION.
!
      TERMX=-14.5125_R8+0.1335_R8*TB-10.5462_R8*RHB+1958.4_R8*RHB/TB
      ACONCR=EXP(TERMX)
!
!-----------------------------------------------------------------------
!     * EXPONENT.
!
      SXPT=APARA+APARB*APARE
      SXP=SXPT
!
!     * FACTOR FOR NUCLEATION RATE IN MOLECULES/CM**3/SEC FOR
!     * INPUT CONCENTRATIONS IN MOLECULES/CM**3. SCALE ACONCR
!     * INSTEAD OF SCALING ANUCL IN THE FINAL RESULT FOR NUMERICAL
!     * STABILITY.
!
      TERMY=YSCALE
      TERM=-1._R8/APARA
      TERMX=TERMY**TERM
      ACONCR=ACONCR*TERMX
      TERM=EXP(APARB*APARD+APARC)
      TERMX=ACONCR**APARA
      TERM=TERM/TERMX
!
!-----------------------------------------------------------------------
!     * CONVERT NUCLEATION RATE TO NMOL/M**3/SEC FOR INPUT
!     * CONCENTRATIONS IN NMOL/M**3.
!
      TERMY=AVO/(YSCALE*YVOLC)
      TERMX=TERMY**SXPT
      TERMY=PMASS*TERMX*YVOLC
      ANUCL=TERM*TERMY*ATUNE/WAMSUL
!
!     * DEALLOCATE WORK ARRAYS.
!
      DEALLOCATE(TB    )
      DEALLOCATE(RHB   )
      DEALLOCATE(ANW   )
      DEALLOCATE(TERM  )
      DEALLOCATE(TERMX )
      DEALLOCATE(TERMY )
      DEALLOCATE(ADELTA)
      DEALLOCATE(APARA )
      DEALLOCATE(APARB )
      DEALLOCATE(APARC )
      DEALLOCATE(APARD )
      DEALLOCATE(ACONCR)
      DEALLOCATE(SXPT  )
!
      END SUBROUTINE BHNUCL
