C........................................................Dec. 2020
C +WU, WL, WE, +AL, AU (no PCn, no PCs)
C........................................................Jan.2020
C Extract peak for all indices from -24 < t0< +48h for 1305 HSS events 
C 
C Select period of 48hrs starting from t0-24h, ending t0+48h; t0 @ Vswmax_hour
C 
      PROGRAM extpeaks48mk
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 48h file for 1h indices)
C
      CHARACTER*128 INFHSS
	+,infsw,infkp,infap,infaa,infae,infds,infal,infau
     +,infwp,infwpn,infwpp
	+,outfile
C-     +,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='hsssw1m.txt'
	 infkp='hsskp1m.txt'
	 infap='hssap1m.txt'
	 infaa='hssaa1m.txt'
	 infae='hssae1m.txt'
	 infds='hssds1m.txt'
C-	 infpn='hsspn1m.txt'
	 infal='hssal1m.txt'
C-	 infps='hssps1m.txt'
	 infau='hssau1m.txt'
C-	infwp='hsswp1m.txt'
	infwp='hsswe1m.txt'
C-	infwpn='hsswpn1m.txt'
	infwpn='hsswl1m.txt'
C-	infwpp='hsswpp1m.txt'
	infwpp='hsswu1m.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=infal,action='READ')
      open(18,file=infau,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.2))	 ! WE,WU,WL
   31 format(72(1X,I3))	 ! kp,ap,aa,
   33 format(72(1X,I4))	 ! ae,dst,sw,au
   32 format(72(1X,F4.2))	 ! no PCn,no PCs
  133 format(72(1X,I5))	 ! al
C
	outfile='hsspeak48mk.txt' !total file for 1996-2019 =1305 lines x 25 cols superposed epoch
	OPEN(22,FILE=OUTFILE)
c-	outhss='outhss100.txt'
c-	OPEN(23,FILE=OUTHSS)
C
C HSS 1305 storms from 1994 to 2019
C
   28 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0))
   29 format(1X,F8.3,3(1X,I2),3(1X,F6.0),1X,I4)
	infhss='cathss48m.txt' ! 1305 HSS events
	open(10,file=infhss,action='READ')
C
C Cycle on events ====================================================
C
       nout=0
	newout=0
	DO 177 iev=1,1305
C	read(10,28,end=27) ryear1,imn1,idy1,iut1,v1,iutm,v2,delv
	read(10,28,end=27) ryear1,ldam,imn1,idy1,iutm,v1,iut1,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		   Avoid Vsw data:
C==========================================
        GOTO 189   ! none Vsw analysys
C==========================================
C Vsw
       read(11,33,end=51) (ind(k),k=0,71)  ! sw
	iswmax=0
	iutsw=0
	iswmin=5000
	do iut=0,71
	if (iswmax.lt.ind(iut)) then
	iswmax=ind(iut)
	iutsw=iut
	endif
	enddo
C
       goto 189        !===================  
       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
C-	write(*,29) ryear2,imn2,idy2,iut2,sw1,sw2,delsw,newout
C-	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 START:
C  kp
189       read(12,31,end=52) (ind(k),k=0,71)  ! kp
	ikpmax=0
	iutkp=0
	do iut=0,71
	iut0=iut-24
	if (ikpmax.lt.ind(iut)) then
	ikpmax=ind(iut)
	iutkp=iut0
	endif
	enddo
C  ap
       read(13,31,end=53) (ind(k),k=0,71)  ! ap
	iapmax=0
	iutap=0
	do iut=0,71
	iut0=iut-24
	if (iapmax.lt.ind(iut)) then
	iapmax=ind(iut)
	iutap=iut0
	endif
	enddo
C  aa
       read(14,31,end=54) (ind(k),k=0,71)  ! aa
	iaamax=0
	iutaa=0
	do iut=0,71
	iut0=iut-24
	if (iaamax.lt.ind(iut)) then
	iaamax=ind(iut)
	iutaa=iut0
	endif
	enddo
C  AE
       read(15,33,end=155) (ind(k),k=0,71)  ! AE
	iaemax=0
	iutae=0
	do iut=0,71
	iut0=iut-24
	if (ind(iut).lt.0) exit
	if (iaemax.lt.ind(iut)) then
	iaemax=ind(iut)
	iutae=iut0
	endif
	enddo
C  Dst
  155     read(16,33,end=56) (ind(k),k=0,71)  ! Dst
	idsmin=0
	iutds=0
	do iut=0,71
	iut0=iut-24
	if (idsmin.gt.ind(iut)) then
	idsmin=ind(iut)
	iutds=iut0
	endif
	enddo
C  AL
       read(17,133,end=157) (ind(k),k=0,71)  ! AL
	ialmin=0.
	iutal=0
	do iut=0,71
	iut0=iut-24
	if (ialmin.gt.ind(iut)) then
	ialmin=ind(iut)
	iutal=iut0
	endif
	enddo
C  AU
  157     read(18,33,end=158) (ind(k),k=0,71)  ! AU
	iaumax=0.
	iutau=0
	do iut=0,71
	iut0=iut-24
	if (iaumax.lt.ind(iut)) then
	iaumax=ind(iut)
	iutau=iut0
	endif
	enddo
C  Wp
  158     read(19,37,end=59) (xind(k),k=0,71)  ! Wp
	wpmax=0.
	iutwp=0
	do iut=0,71
	iut0=iut-24
	if (wpmax.lt.xind(iut)) then
	wpmax=xind(iut)
	iutwp=iut0
	endif
	enddo
C
C  Wpn
       read(20,37,end=60) (xind(k),k=0,71)  ! Wpn
	wpnmin=0.
	iutwpn=0
	do iut=0,71
	iut0=iut-24
	if (wpnmin.gt.xind(iut)) then
	wpnmin=xind(iut)
	iutwpn=iut0
	endif
	enddo
C  Wpp
       read(21,37,end=61) (xind(k),k=0,71)  ! Wpp
	wppmax=0.
	iutwpp=0
	do iut=0,71
	iut0=iut-24
	if (wppmax.lt.xind(iut)) then
	wppmax=xind(iut)
	iutwpp=iut0
	endif
	enddo
C
C   28 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0))
C	read(10,29,end=27) ryear1,ldam,imn1,idy1,iutm,v1,iut1,v2,delv
  138 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0)
     +,1X,I3,1X,F4.1
     +,3(1X,I3,1X,I4),1X,I3,1X,I5,2(1X,I3,1X,I4),3(1X,I3,1X,F5.2),1X,I4)
C Output matrices:
	if (ikpmax.lt.30) goto 177
	xkp=ikpmax/10.
      nout=nout+1
	if (iaemax.eq.0) then
	ialmin=0
	iaumax=0
	iutal=0
	iutau=0
	endif
C
 	write(*,138) ryear1,ldam,imn1,idy1,iutm,v1,iut1,v2,delv
	+,iutkp,xkp
	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutal,ialmin,iutau,iaumax
     +,iutds,idsmin,iutwp,wpmax,iutwpn,wpnmin
     +,iutwpp,wppmax,nout
 	write(22,138) ryear1,ldam,imn1,idy1,iutm,v1,iut1,v2,delv
	+,iutkp,xkp
	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutal,ialmin,iutau,iaumax
	+,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)
C-	close(unit=23)
C
C
   35      write(*,*) outfile
      pause ' ' 
      STOP
       END

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