PARAMR.f

!    SUBPROGRAM DOCUMENTATION BLOCK

!      HISTORY
 
!        Original MM5 code received frm Roelof Bruintjes, 8 Jan 96.

!        1996 - early 1998: Numerous small changes by John B., Tanya Smirnova
!                           and Stan Benjamin.

!        2000 Jan: Changes by John B.
!                  in conjunction with major revamping of EXMOISG
!                  by Roy Rasmussen, Greg Thompson, Kevin Manning of NCAR.  
 
!      PURPOSE: Sets utility constants and physical parameters used in 
!               EXMOISG, mixed phase microphysics routine. 

!      CALLING ROUTINES: INITHYBV
 
!      SUBPROGRAMS CALLED: fgamma (Computes Gamma function) 

!      REMARKS:   

             SUBROUTINE paramr
!      module PARAMR_mod


      use pmicrph_mod, only: pi, r1, ron, ron2, son, gon, br, bs, bg, arain,&
              asnow, agraupel, rho_not, drain, dsnow, xr0s, xr0g, xm01, xm0s,&
              xm0g, diace_min, topr, tops, topg, ron_min, qr0, dgraupel, dice,&
              drain2, dsnow2, delqr0, const1r, const2r, const1a, const1b,&
              const_ns1, const_ns2, const_ng1, const_ng2, slor_r1, slos_r1,&
              tno, ato, int0, berc1, bp, ap, cnp, xnu, frd1, fra1, efis, efir,&
              efsr, efcs, slog_r1, efgi, efgc, efgr, efgs, efcr, acris, bacris,&
              cir, cirf, cpiacr0, cpiacr1, cpiacr2, cpiacr3, frain, fsnow,&
              fgraupel, csr, alpha1, beta1, gamma3, crs, acrcs, bacrcs, acrcs_new,&
              acrls, acrcg, bacrcg, bacrcs_new, bacls, acrcg_new, bacrcg_new,&
              acrig, bacrig, crg, csg, depg1, depg2, depg3, depg4, deps1, deps2,&
              deps3, deps4, c1, xsmax, qck1, qcth, acrcr, bacrcr, depr1, depr2,&
              depr3, depr4, psm1, psm2, psm3, psm4, pgm1, pgm2, pgm3, pgm4,&
              cw, hgfr

      implicit none

     REAL aber1(31),aber2(31)
      REAL fgamma
!     REAL xnu      ! Added 01 Dec 2004  GREG T.
!     COMMON/BER/ ABER1(31),ABER2(31)
! LOOKUP TABLE FOR A1 AND A2 IN BERGERGON PROCESS


      REAL gi,gs,gr,gg

!jmb--declare local variables
      real consta,constd,constgb
      real cpiacr7,cpiacr8,cpiacr9
      real const1,const2

      DATA aber1/.7939e-07,.7841e-06,.3369e-05,.4336e-05,      &
       .5285e-05,.3728e-05,.1852e-05,.2991e-06,.4248e-06,      &
       .7434e-06,.1812e-05,.4394e-05,.9145e-05,.1725e-06,      &
       .3348e-04,.1725e-04,.9175e-05,.4412e-05,.2252e-05,      &
       .9115e-06,.4876e-06,.3473e-06,.4758e-06,.6306e-06,      &
       .8573e-06,.7868e-06,.7192e-06,.6513e-06,.5956e-06,      &
       .5333e-06,.4834e-06/

      DATA aber2/.4006,.4831,.5320,.5307,.5319,.5249,          &
       .4888,.3894,.4047,.4318,.4771,.5183,.5463,.5651,        &
       .5813,.5655,.5478,.5203,.4906,.4447,.4126,.3960,        &
       .4149,.4320,.4506,.4483,.4460,.4433,.4413,.4382,        &
       .4361/
!gt
!gt  The value .4506 replaces .4406 which was a typo - check original
!gt  Koenig, 1971 paper.
!gt

      pi=acos(-1.)

!     Min value for hydrometeor mixing ratios
      r1 = 1.e-15
 
! SLOPE INTERCEPT FOR RAIN, SNOW, AND GRAUPEL

!jmb--Roy R. suggests a larger value for the slope-intercept for rain.
!      This will slow down the fall speed.--16dec98
      ron=8.e6          ! Original M-P value.
!gt   RON2=1.E10        ! GREG T.  MWR Part1 vrbl intercept
      ron2=1.e9         ! GREG T.  changed 01 Dec 2004
!     SON=2.E6          ! Original M-P value.
      son=2.e7
!jmb--According to Roy Rasmussens data (from a QJRMS paper he was reviewing)
!      the value of the M-P slope intercept can be as large as 3.E7 for 
!      graupel.  The value GON = 4.E6 as an upper bound on the intercept value
!      appears too small.  Use same value as for snow.--17oct96
!     GON=4.E6          ! Original M-P value.
!gt   GON=5.e7          ! Roy R., summer 1998, 19 Jan 00, Oct 00
      gon=4.e6          ! Original M-P value.  GREG T.  changed 01 Dec 2004

! EXPONENT FOR RAIN, SNOW, AND GRAUPEL, IN FALL SPEED V(D)=A*D**B
!     THIS FROM SEKHON AND SRIVASTAVA (1970,JAS)

      br=0.8
      bs=0.41
      bg=0.37

! A IN FALL SPEED

      arain=842.
      asnow=11.72
      agraupel=19.3

!jmb--Standard density (p/RT, values from ICAO standard atmosphere) 
!      used in computing density correction to fall
!      speeds--22jan99

      rho_not = 101325.0/(287.0586*298.0) 
 
! DENSITY OF RAIN, SNOW, AND GRAUPEL

      drain=1000.
      dsnow=100.
      dgraupel=400.
!     DICE=150.
      dice=500.
!jmb--added square of rain and snow densities--24jun96
      drain2=drain*drain
      dsnow2=dsnow*dsnow

!      SMALLEST SIZE OF SNOW AND GRAUPEL (RADIUS, METERS)
!gt   XR0S=0.75E-4
!gt   XR0G=0.457E-4
      xr0s= 75.e-6
      xr0g=150.e-6
!      MINIMUM MASS OF ICE, SNOW, GRAUPEL
      xm01=1.0e-12
      xm0s=4.*pi/3.*dsnow*xr0s**3     !                 GREG T.
      xm0g=4.*pi/3.*dgraupel*xr0g**3  !                 GREG T.
      diace_min = 2.0 * (3.0*xm01/(4.0*pi*dice))**0.3333   !   GREG T.

! TOP OF SLOPE FOR RAIN, SNOW, AND GRAUPEL
!jmb--By top of slope is meant numerator Marshall-Palmer slope parameter
!      [See (4) in Reisner et al 1998, QJRMS].

      topr=pi*drain*ron
      tops=pi*dsnow*son
      topg=pi*dgraupel*gon

!CONSTANTS FOR VARIABLE RON

!jmb  qr0 is center value of rain mixing ratio for transition from
!       M-P slope-intercept for drizzle formed by a collision-coalescence
!       process to M-P slope-intercept for traditional rain.--nov00
!jmb  delqr0 governs sharpness of transition: small delt_qr0 makes the
!      transition sharper:
!      if the rate of change of zero intercept wrt rain mixing ratio
!      were linear, with the slope at QR0 given by present tanh formula,
!      the transition would occur between qr0-delqr0 and qr0+delqr0.--nov00
!gt   RON_min = RON
      ron_min = 2.e7
!gt   qr0 = 0.0001  !  Roy R. 26oct00
      qr0 = 0.0002  !  GREG T.  01 Dec 2004
!gt   delqr0 = 0.25*qr0
      delqr0 = 0.5*qr0    !  GREG T.  01 Dec 2004
      const1r=(ron2-ron_min)*0.5
      const2r=(ron2+ron_min)*0.5

!CONSTANTS FOR VARIABLE SON

!     CONST1A is for unit conversion of Sekhon and Srivastava (1970, JAS, Eq 45)
!        from M-P intercept in [m^-3 mm^-1] to [m^-4], and rain rate in 
!        [mm/h] to [m/s].
      const1a=2.5e6*(1./1000*1./3600.)**(0.94)  ! = 1.718
      gi = 4.+bs
      consta=fgamma(gi)
      const1b=asnow*consta/6.
      const1=2.5e6*(1./1000*1./3600.)**(0.94)  ! = 1.718 Reisner et al (5)
      const2=fgamma(4.+bs)
      const_ns1 = (const1*                                              &
       (((asnow*const2)/(6.*drain*((pi*dsnow)**(0.25*bs))))**(-0.94)))  &
       **(4./(4. - 0.94*bs))
      const_ns2 = -0.94*(1.+.25*bs)*(4./(4.-0.94*bs))
!     const_ns2 is exponent on the product rho*qnib (or rho*qnia)

!CONSTANTS FOR VARIABLE GON
!     Based on Roy R s formulation, Jun 96

      constd=1./0.52
      constgb=12./13.
      const_ng1=(1.57**constd)*((pi*dgraupel)**constgb)
      const_ng2=-constgb

!jmb--Specify inverse slope values when q_r, q_s and q_g are default 
!      small values.--22jan99
!jmb--Dry air density assumed unity.

      slor_r1=(1.*r1/topr)**0.25
      slos_r1=(1.*r1/tops)**0.25
      slog_r1=(1.*r1/topg)**0.25
      
! CONSTANT IN FLETCHER CURVES

!c    TNO=1.E-2    
!c    ATO=0.6     

! CONSTANT IN COOPER CURVES   !  GREG T.
      tno=5.0                 !  GREG T.
      ato=0.304               !  GREG T. 

! CONSTANTS FOR BERGERON PROCESS

      int0=273
      berc1=pi*50.0e-06*50.0e-06

! FREEZING OF CLOUD DROPLETS, MURAKAMI (1989) 
      bp=100.
      ap=0.66
      cnp=100.e6              !  GREG T.  Jul98
!gt
!gt  Berry and Reinhardt autoconversion uses this cloud drop
!gt  shape parameter (effectively a measure of dispersion) and
!gt  if CNP is changed, be sure to change the section of code
!gt  in EXMOISG too.
!gt
      xnu = max(0.0, (cnp*1e-6 - 100.)/100.)

! FREEZING OF RAIN DROPLETS, LIN ET AL (45)

      frd1=pi*pi*20.*bp*ron
      fra1=ap

! COLLECTION EFFICIENCIES

      efis=0.1
      efir=1.0
      efsr=1.0
      efcs=1.0
      efgi=0.1
      efgc=1.0
      efgr=1.0
      efgs=0.1
      efcr=1.0


! COLLECTION OF CLOUD ICE BY SNOW

      gi=3.+bs
      gs=fgamma(gi)
      acris=0.25*pi*asnow*efis*son*gs
      bacris=3+bs

! COLLECTION OF CLOUD ICE BY RAIN

      cir=0.25*pi*efir*ron

! RATE AT WHICH RAIN IS FROZEN BY COLLISION WITH CLOUD ICE

      cirf=1./24.*pi*pi*drain*ron*efir
!jmb--Additional constants for PIACR--26may97
      cpiacr0 = cirf*.267*120.
      cpiacr7 =  6.*5.15e3/.267
      cpiacr8 =  6.*7.*1.0225e6/.267
      cpiacr9 =  6.*7.*8.*7.55e7/.267
      cpiacr1 =  cpiacr7
      cpiacr2 =  cpiacr8/cpiacr7
      cpiacr3 =  cpiacr9/cpiacr8
 

! PARAMETERS FOR MEAN FALL SPEED

      gi=4.+br
      gr=fgamma(gi)
      frain=arain*gr/6.
      gi=4.+bs
      gs=fgamma(gi)
      fsnow=asnow*gs/6.
      gi=4.+bg
      gg=fgamma(gi)
      fgraupel=agraupel*gg/6.

! COLLECTION OF SNOW BY RAIN

      csr=pi*pi*efsr*drain*ron*son
      alpha1=1.2
      beta1=0.95
!jmb--Changed GAMMA1-->GAMMA3 in FSL version of PARAMR 
!jmb   to avoid conflicts with GAMMA1 in CUP.--12feb99
!jmb****GAMMA1 is used in MM5 EXMOISG in loop 30 for PSACR, PRACS.  Make sure
!jmb**** these are changed to GAMMA3 in FSL version.--26jan00
      gamma3=0.08

! COLLECTION OF RAIN BY SNOW

      crs=pi*pi*efsr*dsnow*ron*son

! COLLECTION OF CLOUD WATER BY SNOW

!     Old particle size distribution for snow 
      gi=bs+3.  
      gs=fgamma(gi)
      acrcs=0.25*pi*asnow*efcs*son*gs
      bacrcs=3.+bs
 
!     New particle size distribution for snow (Roy R., Jul 99)   
      gi=bs+4.  
      gs=fgamma(gi)
      acrcs_new=0.25*pi*asnow*efcs*son*gs
      bacrcs_new=4.+bs  !  New particle size distribution for snow 

! LOSS OF SNOW DUE TO COLLISION WITH CLOUD WATER 
!jmb--These constants follow Reisner et al (1998) (A.43)--20jan99
      gi = 2.*bs + 2.0
      gs = fgamma(gi)
      acrls = 3.0*pi*son*gs*asnow*asnow
      bacls = gi
!c      RMC=4.E-12
!c      GI=6.+BS
!c      GS=GAMMA(GI)
!c      ACRLS=(1./24.)*PI*PI*EFCS*SON*ASNOW*DSNOW*GS
!c      BACLS=6.+BS

! COLLECTION OF CLOUD WATER BY GRAUPEL

!   Old particle size distribution for graupel 
!gt As of 01 Dec 2004, again use this, not new gamma distrib below - GREG T.
      gi=3.+bg   
      gg=fgamma(gi)
      acrcg=0.25*pi*agraupel*efgc*gon*gg
      bacrcg=3.+bg 

!   New particle size distribution for graupel (Roy R, Jul 99)
      gi=4.+bg   
      gg=fgamma(gi)
      acrcg_new=0.25*pi*agraupel*efgc*gon*gg
      bacrcg_new=4.+bg 

! COLLECTION OF CLOUD ICE BY GRAUPEL

      gi=3.+bg
      gg=fgamma(gi)
      acrig=0.25*pi*agraupel*efgi*gon*gg
      bacrig=3.+bg

! COLLECTION OF RAIN BY GRAUPEL

      crg=pi*pi*efgr*drain*ron*gon

! COLLECTION OF SNOW BY GRAUPEL

      csg=pi*pi*efgs*dsnow*son*gon

! DEPOSITIONAL GROWTH OF GRAUPEL

      gi=bg/2.+2.5
      gg=fgamma(gi)
      depg1=2*pi*gon
      depg2=agraupel
      depg3=0.31*gg
      depg4=bg/2.+2.5

! DEPOSITIONAL GROWTH OF SNOW

      gi=bs/2.+2.5
      gs=fgamma(gi)
      deps1=4.*son
      deps2=asnow
      deps3=0.44*gs
      deps4=bs/2.+2.5

! AGGREGATION OF CLOUD ICE

      c1=700.*0.1*0.25/dice   !   GREG T. to conform to R:Eq (A.33)  Jul98 

! AUTOCONVERSION TO SNOW

      xsmax=9.4e-10

! AUTOCONVERSION OF CLOUD WATER TO RAINWATER [Reisner et al 1998, (A.60)]
!jmb--Moved QCK1 and QCTH definition from INITHYBV to here to keep it with 
!      other setting of microphysics constants.

      qck1 = 1.e-3  
!c    QCTH = .00010    !   Used in RUC Apr 98 -
!c    QCTH = .00015    !   Suggested by Greg T., 26feb99
!c    QCTH = .00025    !   Desired by Roy R., 12 Jan 00
      qcth = .00035    !   Desired by Roy R., Oct 00
!gt                    !   No longer used, replaced by Berry&Reinhardt - GREG T.

! COLLECTION OF CLOUD WATER BY RAIN

      gi=3.+br
      gr=fgamma(gi)
      acrcr=0.25*pi*arain*efcr*ron*gr
      bacrcr=3.+br


! DEPOSITIONAL GROWTH OF RAIN

      gi=br/2.+2.5
      gr=fgamma(gi)
      depr1=2*pi*ron
      depr2=arain
      depr3=0.31*gr
      depr4=br/2.+2.5

! FOR MELTING OF SNOW 

      gi=bs/2.+2.5
      gs=fgamma(gi)
      psm1=2*pi*son
      psm2=asnow
      psm3=0.44*gs
      psm4=bs/2.+2.5

! FOR MELTING OF GRAUPEL

      gi=bg/2.+2.5
      gg=fgamma(gi)
      pgm1=2*pi*gon
      pgm2=agraupel
      pgm3=0.31*gg
      pgm4=bg/2.+2.5

! CONSTANT FOR ENHANCED MELTING OF GRAUPEL BY RAIN AND CLOUD WATER

      cw=4218.
   

! CONSTANT FOR HOMOGENEOUS FREEZING OF CLOUD DROPLETS

      hgfr=233.15

      RETURN
      END
!      end module PARAMR_mod