C........................................................Jan.2020
C Extract eventsa of Vsw-min-max hourly 0...47 hrs UT hrs 
C witht0 at Vsw-hr-min for prec day dhmax_min > 100
C 
C 
      PROGRAM extrhss48
C----------------------------------------------------------------
C
C
	DIMENSION IM(12),dat(0:47),VSWDY(0:23)
C    +,VSWDY0(0:23)
	CHARACTER*4 AYEAR
      CHARACTER*128 INFILE,OUTHSS
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C++
C
      ICALLS=0
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
	outhss='extrhss48n1.txt'
	OPEN(11,file=outhss)

	infile='d:\apkp\OMNI\swYEAR.txt'

C
C HSS storms from 1994 to 2019
C
   28 format(1X,F8.3,2(1X,I2),3(1X,F6.0))
C
       istrm=0
	DO k=0,47
	dat(k)=0. ! 
	ENDDO
	iutmax_pre=0
	vmax_pre=0.
C Annual cycle							  ++++++++++++++++
	DO 122 iyear=1994,2019
	iyr=iyear-iyear/100*100
C      lda1=ndoy(iyr,imn,idy) ! 
	call blet4(iyear,AYEAR)
	infile(16:19)=AYEAR
	OPEN(10,file=infile,action='READ')
C
   30	format(A50)

	do i=1,13
	read(10,30) txt ! extra lines
	enddo
	xyear=float(iyear)
		if(int(xyear/4.)*4.eq.iyear) THEN 
	ndnr=366
	im(2)=29
	                          ELSE
	ndnr=365
	im(2)=28
	ENDIF
	deyr=1./ndnr
	iflag=0
C day-to day cycle
C							   >>>>>>>>>>>>>>>>>
	DO 125 lda=1,ndnr
C
		DO k=0,23
	dat(k)=dat(k+24)  ! prec. day
	ENDDO
C
	DO ii=0,23
	read(10,31,end=50) kyear,kday,kut,vswdy(ii)
	dat(ii+24)=vswdy(ii)
	ENDDO
	if ((iyear.eq.1994).and.(kday.eq.1)) goto 124 ! read next day
C
      vmax=0.
	iut1=iutmax_pre
	icn999=0
	iut2=47
	DO 121 iut=iut1,iut2
	if (dat(iut).gt.9990.) then 
	icn999=icn999+1
	goto 121
	       else
	if (dat(iut).gt.vmax) then
	iutmax=iut
	vmax=dat(iut)
	endif
	       endif
  121	CONTINUE
C
      if (icn999.eq.48) goto 124
C
	vmin=5000.
	icn99=0
	iutmin=0
	iut1=0
	iut2=iutmax-1
	dvup=vmax
C	if (iut1.lt.0) iut1=0
	if (iut2.lt.0) goto 124
	do 120 iut=iut2,iut1,-1
	if (dat(iut).gt.9990.) then 
	icn99=icn99+1
	goto 120
	       else
	dv=dvup-dat(iut)
	if (dv.lt.0) exit
	if (dat(iut).lt.vmin) then
	vmin=dat(iut)
	dvup=vmin
	iutmin=iut
	endif
	       endif
  120	continue
C	
CREM        if (vmin.eq.5000.) goto 124
        if ((vmin.eq.5000.).or.(iutmin.gt.23)) goto 124
C
	dvmax=vmax-vmin
Crem      if (dvmax.ge.100.) then
      if (vmax.eq.vmax_pre) goto 124
Crem      if (dvmax.ge.50.) then
           if (dvmax.ge.100.) then
Crem      if ((dvmax.ge.50.).and.
	call submmdd(lda_pre,iyr_pre,imn,idy)
	ryear=float(iyear_pre)+deyr_pre*(lda_pre-1)
	 istrm= istrm+1
       write(*,29) ryear,imn,idy,iutmin,vmin,iutmax,vmax,dvmax,istrm
	+,lda_pre
       write(11,29) ryear,imn,idy,iutmin,vmin,iutmax,vmax,dvmax,istrm
     +,lda_pre
	 	vmax_pre=vmax
	endif
  124	lda_pre=lda
      iyr_pre=iyr
	iyear_pre=iyear
	deyr_pre=deyr
C	vmax_pre=vmax
C       if ((iutmax.gt.23).and.(iflag.eq.0)) then
C	  iutmax_pre=iutmax-24
C	iflag=1
C	         else
C	iutmax_pre=0
C	iflag=0
C	endif
  125	CONTINUE		!>>>>>>>>>>>>>>>>>>
C
   50	close(unit=10)
  122	CONTINUE				!++++++++++++++++
C   27 close(unit=13)
C
   31	format(I4,1X,I3,1X,I2,28X,F5.0)
   29 format(1X,F8.3,3(1X,I2),1X,F6.0,1X,I2,2(1X,F6.0),2(1X,I4))
	close(unit=11)
C
   35      write(*,*) outhss
      pause ' ' 
      STOP
       END

C***********************************************************
