C........................................................Jan.2020
C Extract Vsw-max hourly +UT hrs for HSS 1200 events
C and Vsw-hr-min for prec day
C 
C 
      PROGRAM extrhssut
C----------------------------------------------------------------
C
C
	DIMENSION VSWDY(0:23),VSWDY0(0:23)
	CHARACTER*4 AYEAR
      CHARACTER*128 INFILE,INFHSS,OUTHSS
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
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='extrhssut.txt'
	OPEN(11,file=outhss)

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

C
C HSS 1200 storms from 1994 to 2019
C
   28 format(1X,F8.3,2(1X,I2),3(1X,F6.0))
	infhss='exthssmag50wnp.txt' ! 1200 HSS events
	open(13,file=infhss,action='READ')
C
       istrm=0
	DO 122 iev=1,1200
	read(13,28,end=27) ryear,imn,idy,v1,v2,dv
	iyear=int(ryear)
	iyr=iyear-iyear/100*100
      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
	                          ELSE
	ndnr=365
	ENDIF
C day-to day cycle
C
	DO lda=1,lda1
	DO ii=0,23
	read(10,31,end=50) kyear,kday,kut,vswdy(ii)
	ENDDO
	if (lda.lt.lda1) then
	DO k=0,23
	vswdy0(k)=vswdy(k) ! prec day
	ENDDO
	endif
	ENDDO
   50	close(unit=10)
C
	if (lda1.eq.1) then 
	vmin=v1
	                 else
	vmin=5000.
	do 120 iut=0,23
	if (vswdy0(iut).gt.9990.) then 
	goto 120
	       else
	if (vswdy0(iut).lt.vmin) then
	vmin=vswdy0(iut)
	endif
	       endif
  120	continue
                        endif
C	
      vmax=0.
	DO 121 iut=0,23
	if (vswdy(iut).gt.9990.) then 
	goto 121
	       else
	if (vswdy(iut).gt.vmax) then
	iutmax=iut
	vmax=vswdy(iut)
	dvmax=vmax-vmin
	endif
	       endif
C
  121	CONTINUE
       write(*,29) ryear,imn,idy,iutmax,vmin,vmax,dvmax,istrm
       if (dvmax.lt.50.) goto 122
      istrm=istrm+1
       write(11,29) ryear,imn,idy,iutmax,vmin,vmax,dvmax,istrm
  122	CONTINUE
   27 close(unit=13)
C
   31	format(I4,1X,I3,1X,I2,28X,F5.0)
   29 format(1X,F8.3,3(1X,I2),3(1X,F6.0),1X,I4)
	close(unit=11)
C
   35      write(*,*) outhss
      pause ' ' 
      STOP
       END

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