C........................................................Feb.2020
C Extract median for 2h bins of time from peak for all indices from t0< +48h for 183 HSS events 
C 
C Select period of 72hrs starting from t0-24h, ending t0+48h; t0 @ Vswmax_hour
C 
      PROGRAM extmed72s
C Input HSSUT.txt 1996-2010...........................Jan 2020
C add: select from -24h < to <+48h for HSS-events
C
C----------------------------------------------------------------
C
	DIMENSION ihr(183),xind(183),ind(0:71) ! 
C
      CHARACTER*128 INFHSS
	+,outfile !
C++
C
C
C
   37 format(72(1X,F4.1))	 ! Wp,Wpp,Wpn
   31 format(72(1X,I3))	 ! kp,ap,aa,
C  
   32 format(72(1X,I5))	 ! al
   33 format(72(1X,I4))	 ! ae,au,dst,sw
C
	infhss='hsspeak72s.txt' !total file for 2011-2019 =183 lines x 24 cols superposed epoch
      OPEN(12,FILE=INFHSS,action='read')
C	
      write(*,*) 'enter ncoldt,ncolind:'
	read(*,*) ncoldt,ncolind
C
	outfile='extmed72s.txt'
	OPEN(12,FILE=OUTFILE)
C
C HSS 183 storms from 1994 to 2019
C
   28 format(1X,F8.3,3(1X,I2),3(1X,F6.0))
   29 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0))
	infhss='catvispch1.txt' ! 183 Pch/HSS events
	open(10,file=infhss,action='READ')
C
C Cycle on events ====================================================
C
       nout=0
	newout=0
	nnev=183
C AL, AU, AE 	nnev=146 -*-------------
	DO 177 iev=1,183
C	read(10,28,end=27) ryear1,imn1,idy1,iut1,v1,v2,delv
	read(10,29,end=27) ryear1,ldam,imn1,idy1,iutm,v1,iut2,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,33,end=51) (ind(k),k=0,71)  ! sw
	iswmax=0
	iutsw=0
C+	do k=0,71
	do k=24,71
	iut=k-24
	if (iswmax.lt.ind(k)) then
	iswmax=ind(k)
	iutsw=iut
	endif
	enddo
C  kp
       read(12,31,end=52) (ind(k),k=0,71)  ! kp
	ikpmax=0
	iutkp=0
c	do k=0,71
	do k=24,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
c	do k=0,71
	do k=24,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
c	do k=0,71
	do k=24,71
	iut=k-24
	if (iaamax.lt.ind(k)) then
	iaamax=ind(k)
	iutaa=iut
	endif
	enddo
C  AE
       read(15,33,end=55) (ind(k),k=0,71)  ! AE
	iaemax=0
	iutae=0
c	do k=0,71
	do k=24,71
	iut=k-24
	if (ind(k).lt.0) exit
	if (iaemax.lt.ind(k)) then
	iaemax=ind(k)
	iutae=iut
	endif
	enddo
C  AU
       read(16,33,end=56) (ind(k),k=0,71)  ! AU
	iaumax=0
	iutau=0
c	do k=0,71
	do k=24,71
	iut=k-24
	if (ind(k).lt.0) exit
	if (iaumax.lt.ind(k)) then
	iaumax=ind(k)
	iutau=iut
	endif
	enddo
C  AL
       read(17,32,end=57) (ind(k),k=0,71)  ! AL
	ialmin=0
	iutal=0
c	do k=0,71
	do k=24,71
	iut=k-24
	if (ialmin.gt.ind(k)) then
	ialmin=ind(k)
	iutal=iut
	endif
	enddo
C  Dst
       read(18,33,end=58) (ind(k),k=0,71)  ! Dst
	idsmin=0
	iutds=0
c	do k=0,71
	do k=24,71
	iut=k-24
	if (idsmin.gt.ind(k)) then
	idsmin=ind(k)
	iutds=iut
	endif
	enddo
C  Wp
       read(19,37,end=59) (xind(k),k=0,71)  ! Wp
	wpmax=0.
	iutwp=0
c	do k=0,71
	do k=24,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
c	do k=0,71
	do k=24,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
c	do k=0,71
	do k=24,71
	iut=k-24
	if (wppmax.lt.xind(k)) then
	wppmax=xind(k)
	iutwpp=iut
	endif
	enddo
C
  138 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0)
     +,5(1X,I3,1X,I4),1X,I3,1X,I5,1X,I3,1X,I4,3(1X,I3,1X,F5.1),1X,I4)
C Output matrices:
      nout=nout+1
 	write(*,138) ryear1,ldam,imn1,idy1,iutm,v1,iut2,v2,delv
	+,iutkp,ikpmax,iutap,iapmax,iutaa,iaamax,iutae,iaemax
     +,iutau,iaumax,iutal,ialmin,iutds,idsmin,iutwp,wpmax
     +,iutwpn,wpnmin,iutwpp,wppmax,nout
 	write(22,138) ryear1,ldam,imn1,idy1,iutm,v1,iut2,v2,delv
	+,iutkp,ikpmax,iutap,iapmax,iutaa,iaamax,iutae,iaemax
     +,iutau,iaumax,iutal,ialmin,iutds,idsmin,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***********************************************************
