C   ***************************************************************
C   * Storm Relative Helicity (SRH) is a measure of the           *
C   * streamwise vorticity within the inflow environment of a     *
C   * convective storm. It is calculated by multiplying the       *
C   * storm-relative inflow velocity vector (Vh-C) by the         *
C   * streamwise vorticity (Zh) and integrating this quantity     *
C   * over the inflow depth (lowest 1-3 km layers above ground    *
C   * level). It describes the extent to which corkscrew-like     *
C   * motion occurs (similar to the spiraling motion of an        *
C   * American football). SRH corresponds to the transfer of      *
C   * vorticity from the environment to an air parcel in          *
C   * convective motion and is used to predict the potential      *
C   * for tornadic development (cyclonic updraft rotation) in     *
C   * right-moving supercells.                                    *
C   *                                                             *
C   * There is no clear threshold value for SRH when forecasting  *
C   * supercells, since the formation of supercells appears to be *
C   * related more strongly to the deeper layer vertical shear.   *
C   * Larger values of 0-3-km SRH (greater than 250 m**2/s**2)    *
C   * and 0-1-km SRH (greater than 100 m**2/s**2), suggest an     *
C   * increased threat of tornadoes with supercells. For SRH,     *
C   * larger values are generally better, but there are no clear  *
C   * "boundaries" between non-tornadic and significant tornadic  *
C   * supercells.                                                 *
C   *                                                             *
C   * SRH < 100 (lowest 1 km): cutoff value                       *
C   * SRH = 150-299: supercells possible with weak tornadoes      *
C   * SRH = 300-499: very favorable to supercell development and  *
C   *                strong tornadoes                             *
C   * SRH > 450    : violent tornadoes                            *
C   ***************************************************************
C NCLFORTSTART
      subroutine dcalrelhl(u, v, ght, ter, top, sreh, miy, mjx, mkzh)
      implicit none
      integer miy, mjx, mkzh
      double precision u(miy,mjx,mkzh), v(miy,mjx,mkzh), 
     &                 ght(miy,mjx,mkzh),top,ter(miy,mjx),
     &                 sreh(miy,mjx)
C NCLEND
C
C This helicity code was provided by Dr. Craig Mattocks, and
C verified by Cindy Bruyere to produce results equivalent to
C those generated by RIP4. (The code came from RIP4?)
C
      double precision pi, dtr, dpr
      double precision dh, sdh, su, sv, ua, va, asp, adr, bsp, bdr
      double precision cu, cv, x, sum
      integer i, j, k, k10, k3, ktop
      parameter (pi=3.14159265d0, dtr=pi/180.d0, dpr=180.d0/pi)
     
      do 15 j = 1, mjx-1
	do 15 i = 1, miy-1
	  sdh = 0.d0
	  su = 0.d0
	  sv = 0.d0
	  k3 = 0
	  k10 = 0
	  ktop = 0
	  do 6 k = mkzh, 2, -1
	    if (((ght(i,j,k) - ter(i,j)) .gt. 10000.d0) .and.
     &             (k10 .eq. 0)) then
	      k10 = k
	      go to 8
	    endif
	    if (((ght(i,j,k) - ter(i,j)) .gt. top) .and.
     &           (ktop .eq. 0)) ktop = k
	    if (((ght(i,j,k) - ter(i,j)) .gt. 3000.d0) .and.
     &           (k3 .eq. 0)) k3 = k
    6     continue
    8     continue
	  if (k10 .eq. 0) k10=2
	  do k = k3, k10, -1
	    dh = ght(i,j,k-1) - ght(i,j,k)
	    sdh = sdh + dh
	    su = su + 0.5d0*dh*(u(i,j,k-1)+u(i,j,k))
	    sv = sv + 0.5d0*dh*(v(i,j,k-1)+v(i,j,k))
	  enddo
	  ua = su / sdh
	  va = sv / sdh
	  asp = sqrt(ua*ua + va*va)
	  if (ua .eq. 0.d0 .and. va .eq. 0.d0) then
	    adr = 0.d0
	  else
	    adr = dpr * (pi + atan2(ua,va))
	  endif
	  bsp = 0.75d0 * asp
	  bdr = adr + 30.d0
	  if (bdr .gt. 360.d0) bdr = bdr-360.d0
	  cu = -bsp * sin(bdr*dtr)
	  cv = -bsp * cos(bdr*dtr)
          sum = 0.d0
          do 12 k = mkzh-1, ktop, -1
            x = ((u(i,j,k)-cu) * (v(i,j,k)-v(i,j,k+1))) -
     &          ((v(i,j,k)-cv) * (u(i,j,k)-u(i,j,k+1)))
            sum = sum + x
   12     continue
          sreh(i,j) = -sum
   15 continue
      end