C SRH700.f
C
C VIS-5D analysis function to compute Storm Relative Helicity 
C (in m2/s2), where Storm motion is Wind at 700 hPa)

      INTEGER FUNCTION USERFUNC( OUTGRID, OUTNL, OUTLOWLEV,
     *                           INGRID, NR, NC, NL, LOWLEV, MAXNL,
     *                           NVARS, NAMES,
     *                           DATE, TIME,
     *                           PROJECTION, PROJ_ARGS,
     *                           VERTICAL, VERT_ARGS )
	implicit none
C     ARGUMENTS:
      INTEGER NVARS
      INTEGER NR, NC, NL(NVARS), LOWLEV(NVARS), MAXNL
      REAL OUTGRID(NR,NC,MAXNL)
      INTEGER OUTNL, OUTLOWLEV
      REAL INGRID(NR,NC,MAXNL,NVARS)
      CHARACTER*8 NAMES(NVARS)
      INTEGER DATE, TIME
      INTEGER PROJECTION
      REAL PROJ_ARGS(*)
      INTEGER VERTICAL
      REAL VERT_ARGS(*)

C     LOCAL VARS:
      integer var, i,j,il,i700
      integer iu, iv,kk
      real p(22),ustorm,vstorm,helimenos,xincru,xincrv
	real uc,vc


C     Specify number of levels in OUTGRID
      OUTNL = 1
      OUTLOWLEV = 0

C     Find the U and V variables
      iu = -1
      iv = -1
      do var=1,nvars
         if (names(var) .eq. 'U') iu = var
         if (names(var) .eq. 'V') iv = var
      end do

C     If U, V  not found, return error 1
      if (iu .eq. -1 .or. iv .eq. -1 ) then
         print *, "Couldn't find U, V variables!"
         userfunc = 1
         return
      endif
      
c Cercam p700 i p(i) en mb

	do i=1,maxnl
	p(i)=1012.5*exp(vert_args(i)/-7.2)
	if (p(i).gt.699.and.p(i).lt.701.)  i700=i
	enddo
		DO 5770 J=1,nc
		DO 5770 I=1,nr

c	Entran u,v,p
C	---------------------------------------------------------
C	---------------------------------------------------------	
C	CALCULO DE LA -HELICIDAD A LO LARGO DE LA CAPA CONPRENDIDA 
C       ENTRE P(1)=1000 hPa Y P(4)=700 hPa 
C	---------------------------------------------------------
C Atencion: Velocidad estimada de la tormenta 
C Atencion: Como velocidad de la tormenta se toma el viento a 700 hPa

        ustorm=ingrid(I,J,i700,iu)
        vstorm=ingrid(I,J,i700,iv)
        HELIMENOS=0.
        DO KK=2,i700
c Agafem un vent mig de la capa sobre la qual estam integrant
	uc=(ingrid(i,j,KK,iu)+ingrid(i,j,KK-1,iu))/2.
	vc=(ingrid(i,j,KK,iv)+ingrid(i,j,KK-1,iv))/2.
         XINCRU=(ingrid(i,j,KK,iu)-ingrid(i,j,KK-1,iu))
         XINCRV=(ingrid(i,j,KK,iv)-ingrid(i,j,KK-1,iv))
         HELIMENOS=HELIMENOS+((uc-ustorm)*XINCRV-
     $(vc-vstorm)*XINCRU)
        ENDDO


C ASIGNACION DE LOS CAMPOS:

	do il=1,outnl
		outgrid(i,j,il)=-HELIMENOS
	enddo

5770 	continue
      USERFUNC = 0
      RETURN
      END


