C........................................................Jan.2020
C Extract peak for all indices from -24h<t0< +48h for 1131 HSS events 
C 
C Select period of 72hrs starting from t0-24h, ending t0+48h; t0 @ Vswmax_hour
C 
      PROGRAM extpeaks72
C Input HSSUT.txt 1996-2010...........................Jan 2020
C add: select from -24h < to <+48h for HSS-events
C
C----------------------------------------------------------------
C
	DIMENSION xind(0:71),ind(0:71),IM(12) ! 3h indices for 24h (0r 72h file for 1h indices)
C
      CHARACTER*128 INFHSS
	+,infsw,infkp,infap,infaa,infae,infds,infpn,infps
     +,infwp,infwpn,infwpp
	+,outfile,outhss  !
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
C	CHARACTER*2 AYR,AMN,ADY
	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
       infsw='hsssw.txt'
	 infkp='hsskp.txt'
	 infap='hssap.txt'
	 infaa='hssaa.txt'
	 infae='hssae.txt'
	 infds='hssds.txt'
	 infpn='hsspn.txt'
	 infps='hssps.txt'
	infwp='hsswp.txt'
	infwpn='hsswpn.txt'
	infwpp='hsswpp.txt'
      open(11,file=infsw,action='READ')
      open(12,file=infkp,action='READ')
      open(13,file=infap,action='READ')
      open(14,file=infaa,action='READ')
      open(15,file=infae,action='READ')
      open(16,file=infds,action='READ')
      open(17,file=infpn,action='READ')
      open(18,file=infps,action='READ')
      open(19,file=infwp,action='READ')
      open(20,file=infwpn,action='READ')
      open(21,file=infwpp,action='READ')
C
   37 format(72(1X,F4.1))	 ! Wp,Wpp,Wpn
   31 format(72(1X,I4))	 ! kp,ap,aa,ae,dst,sw
   32 format(72(1X,F4.2))	 ! PCn,PCs
C
	outfile='hsspeak.txt' !total file for 1996-2019 =1131 lines x 24 cols superposed epoch
	OPEN(22,FILE=OUTFILE)
	outhss='outhss100.txt'
	OPEN(23,FILE=OUTHSS)
C
C HSS 1131 storms from 1994 to 2019
C
   28 format(1X,F8.3,3(1X,I2),3(1X,F6.0))
   29 format(1X,F8.3,3(1X,I2),3(1X,F6.0),1X,I4)
	infhss='extrhssut.txt' ! 1131 HSS events
	open(10,file=infhss,action='READ')
C
C Cycle on events ====================================================
C
       nout=0
	newout=0
	DO 177 iev=1,1131
	read(10,28,end=27) ryear1,imn1,idy1,iut1,v1,v2,delv
	iyear=int(ryear1)
	iyr=iyear-iyear/100*100
	xyear=float(iyear)
	if(int(xyear/4.)*4.eq.iyear) THEN 
 	im(2)=29
	                          ELSE
	im(2)=28
	ENDIF

C Vsw
       read(11,31,end=51) (ind(k),k=0,71)  ! sw
	iswmax=0
	iutsw=0
	iswmin=5000
	do k=0,47
	iut=k-24
	if (iswmax.lt.ind(k)) then
	iswmax=ind(k)
	iutsw=iut
	endif
	enddo
       iut2=iut1+iutsw
	 idy2=idy1
	imn2=imn1
	iyr2=iyr
	ryear2=ryear1
	if (iut2.gt.23) then	 !3
	iut2=iut2-24
	idy2=idy2+1
	if(idy2.gt.im(imn2)) then !2
	idy2=1
	imn2=imn2+1
	if (imn2.gt.12) then	!1
	imn2=1
	iyr2=iyr2+1
	ryear2=xyear+1.
	endif                   !1
	endif					  !2
	endif					  !3
C
	if (iut2.lt.0) then	 !3
	iut2=iut2+24
	idy2=idy2-1
	if(idy2.lt.1) then !2
	imn2=imn2-1
	if (imn2.lt.1) then	!1
	imn2=12
	iyr2=iyr2-1
	ryear2=xyear-1.+0.995
	endif                   !1
	idy2=im(imn2)
	endif					  !2
	endif					  !3
C
	do k=0,iutsw+24
	if (iswmin.gt.ind(k)) then
	iswmin=ind(k)
	endif
        enddo
	 sw1=float(iswmin)
	sw2=float(iswmax)
	delsw=sw2-sw1
Crem	if (delsw.lt.50.) goto 188
	if (delsw.lt.100.) goto 188
C
      newout=newout+1
	write(*,29) ryear2,imn2,idy2,iut2,sw1,sw2,delsw,newout
	write(23,29) ryear2,imn2,idy2,iut2,sw1,sw2,delsw,newout
188	if (iutsw.ne.0) then
	write(*,*) ' iev:',iev,iutsw,iswmax,v1,v2,delv
	continue
C	pause ' '
C	goto 177
	endif
C  kp
       read(12,31,end=52) (ind(k),k=0,71)  ! kp
	ikpmax=0
	iutkp=0
	do k=0,71
	iut=k-24
	if (ikpmax.lt.ind(k)) then
	ikpmax=ind(k)
	iutkp=iut
	endif
	enddo
C  ap
       read(13,31,end=53) (ind(k),k=0,71)  ! ap
	iapmax=0
	iutap=0
	do k=0,71
	iut=k-24
	if (iapmax.lt.ind(k)) then
	iapmax=ind(k)
	iutap=iut
	endif
	enddo
C  aa
       read(14,31,end=54) (ind(k),k=0,71)  ! aa
	iaamax=0
	iutaa=0
	do k=0,71
	iut=k-24
	if (iaamax.lt.ind(k)) then
	iaamax=ind(k)
	iutaa=iut
	endif
	enddo
C  AE
       read(15,31,end=55) (ind(k),k=0,71)  ! AE
	iaemax=0
	iutae=0
	do k=0,71
	iut=k-24
	if (ind(k).lt.0) exit
	if (iaemax.lt.ind(k)) then
	iaemax=ind(k)
	iutae=iut
	endif
	enddo
C  Dst
       read(16,31,end=56) (ind(k),k=0,71)  ! Dst
	idsmin=0
	iutds=0
	do k=0,71
	iut=k-24
	if (idsmin.gt.ind(k)) then
	idsmin=ind(k)
	iutds=iut
	endif
	enddo
C  PCn
       read(17,32,end=57) (xind(k),k=0,71)  ! PCn
	pcnmax=0.
	iutpcn=0
	do k=0,71
	iut=k-24
	if (pcnmax.lt.xind(k)) then
	pcnmax=xind(k)
	iutpcn=iut
	endif
	enddo
C  PCs
       read(18,32,end=58) (xind(k),k=0,71)  ! PCs
	pcsmax=0.
	iutpcs=0
	do k=0,71
	iut=k-24
	if (pcsmax.lt.xind(k)) then
	pcsmax=xind(k)
	iutpcs=iut
	endif
	enddo
C  Wp
       read(19,37,end=59) (xind(k),k=0,71)  ! Wp
	wpmax=0.
	iutwp=0
	do k=0,71
	iut=k-24
	if (wpmax.lt.xind(k)) then
	wpmax=xind(k)
	iutwp=iut
	endif
	enddo
C
C  Wpn
       read(20,37,end=60) (xind(k),k=0,71)  ! Wpn
	wpnmin=0.
	iutwpn=0
	do k=0,71
	iut=k-24
	if (wpnmin.gt.xind(k)) then
	wpnmin=xind(k)
	iutwpn=iut
	endif
	enddo
C  Wpp
       read(21,37,end=61) (xind(k),k=0,71)  ! Wpp
	wppmax=0.
	iutwpp=0
	do k=0,71
	iut=k-24
	if (wppmax.lt.xind(k)) then
	wppmax=xind(k)
	iutwpp=iut
	endif
	enddo
C
  138 format(1X,F8.3,3(1X,I2),3(1X,F6.0),5(1X,I3,1X,I4)
     +,2(1X,I3,1X,F6.2),3(1X,I3,1X,F5.1),1X,I4)
C Output matrices:
      nout=nout+1
 	write(*,138) ryear1,imn1,idy1,iut1,v1,v2,delv,iutkp,ikpmax
	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutds,idsmin
	+,iutpcn,pcnmax,iutpcs,pcsmax,iutwp,wpmax,iutwpn,wpnmin
     +,iutwpp,wppmax,nout
 	write(22,138) ryear1,imn1,idy1,iut1,v1,v2,delv,iutkp,ikpmax
	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutds,idsmin
	+,iutpcn,pcnmax,iutpcs,pcsmax,iutwp,wpmax,iutwpn,wpnmin
     +,iutwpp,wppmax,nout
  177	CONTINUE
   51 close(unit=11)
   52 close(unit=12)
   53 close(unit=13)
   54 close(unit=14)
   55 close(unit=15)
   56 close(unit=16)
   57 close(unit=17)
   58 close(unit=18)
   59 close(unit=19)
   60 close(unit=20)
   61 close(unit=21)
   27 close(unit=10)
      close(unit=22)
	close(unit=23)
C
C
   35      write(*,*) outfile
      pause ' ' 
      STOP
       END

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