C........................................................Mar. 2022
C 481 Kp storms1 / 86 Kpstprms2 // 1994-2021
C........................................................Jan.2020
C Extract peak for all indices from -24 < t0< +48h for Kp storm events 
C 
C Select period of 48hrs starting from t0-24h, ending t0+48h; t0 @ Kp peak
C 
      PROGRAM extpeakskpmd
C add: select from -24h < to <+48h for Kp-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
	+,infds
c-	+,infsw
C     +,infkp,infap
C     +,infae,infds,infal,infau
CC     +,infwp,infwpg,infwpn,infwpp
	+,outfile
C-     +,outhss  !
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
      CHARACTER*1 kpx
	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
c-       write(*,*) ' Enter m, n, s:'
c-	read(*,*) gns
	outfile='catkpstx.txt'  ! Kp events t0 at Kp storm peak
	infhss='kpstormx.txt'
C+       infsw='hsssw1d.txt'
C-	 infkp='hsspcn3d.txt' !PCN
C-	 infap='hsspcs3d.txt' !PCS
C-	 infaa='hssaa3d.txt'
C-	infsw='hsssw3d.txt'
C/	 infae='hssae1d.txt'
	 infds='kpdst3dx.txt'
C-	 infpn='hsspn1m.txt'
C/	 infal='hssal1d.txt'
C-	 infps='hssps1m.txt'
C/	 infau='hssau1d.txt'
CC	infwp='hsswp3d.txt'
CC	infwpg='hsswe3dx.txt'
C+	infwp='hsswe3dx.txt'
C-	infwpn='hsswpn1m.txt'
Cpre	infwpn='hsswl1d.txt'
CC      	infwpn='hsswl3dx.txt'
C-	infwpp='hsswpp1m.txt'
Cpre	infwpp='hsswu1d.txt'
CC      infwpp='hsswu3dx.txt'
C-      open(11,file=infsw,action='READ')
C-      open(12,file=infkp,action='READ')
C-      open(13,file=infap,action='READ')
c/      open(14,file=infaa,action='READ')
C/      open(15,file=infae,action='READ')
C++

C Start kpstorm1 or kpstorm2
       kpx='1'
C
C/      open(17,file=infal,action='READ')
C/      open(18,file=infau,action='READ')
   1  CONTINUE
   	infds(8:8)=kpx
      open(16,file=infds,action='READ')
	outfile(8:8)=kpx
	infhss(8:8)=kpx
CC      infwpg(8:8)=gns
CC      infwpn(8:8)=gns
CC	infwpp(8:8)=gns
CC      open(19,file=infwp,action='READ')
CC      open(20,file=infwpn,action='READ')
CC      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,PCN,PCS
   32 format(72(1X,F4.2))	 ! no PCn,no PCs
  133 format(72(1X,I5))	 ! al
C
CC	outfile='hsspeakdx.txt' !total file for 1996-2021 =391 lines x 72 cols superposed epoch
CC	outfile(9:9)=gns
c-      	outfile='hsspcnpcs3.txt'  ! PCN, PCH
	OPEN(22,FILE=OUTFILE)
c-	outhss='outhss100.txt'
c-	OPEN(23,FILE=OUTHSS)
C
C HSS/Dst 455 storms from 1996 to 2019
C
   28 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0))
C   29 format(1X,F8.3,3(1X,I2),3(1X,F6.0),1X,I4)
c   29 format(1X,F8.3,1X,I3,3(1X,I2),1X,I4,2(1X,I4),1X,I3,2(1X,I4))
   29 format(1X,F8.3,1X,I3,3(1X,I2),1X,F3.1,1X,I3,1X,I3)
	open(10,file=infhss,action='READ')
C
C Cycle on events ====================================================
C
       nout=0
	newout=0
	nev=481
	if (kpx.eq.'2') nev=86
	DO 177 iev=1,nev
C	read(10,28,end=27) ryear1,imn1,idy1,iut1,v1,iutm,v2,delv
C	read(10,28,end=27) ryear1,ldam,imn1,idy1,iutm,v1,iut1,v2,delv
      read(10,29,end=27) ryear1,lda1,imn1,idy1,iut1,xkp,ikpsum,ninp
	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=========================================
C		   Read Vsw data:
C==========================================
C,ivsmin,iutvs,ivsmax,idel, PCN
189       read(16,33,end=52) (ind(k),k=0,71)  ! Vsw, Dst
C+	ivsmax=0
       idsmin=100
	iutvs=0
	do iut=0,71
	iut0=iut-24
C+	if (ivsmax.lt.ind(iut)) then
	if (idsmin.gt.ind(iut)) then
C+	ivsmax=ind(iut)
	idsmin=ind(iut)
	iutvs=iut0
	endif
	enddo
          GOTO 123   !++++++++++++++++++++
C
C? Vsw min prior time Vsmax
C?	ivsmin=ivsmax
C?	iutvs0=0
C?	do  iut=0,iutvs+24
C?	iut0=iut-24
C?	if (ivsmin.gt.ind(iut)) then
C?	ivsmin=ind(iut)
C?	iutvs0=iut0
C?	endif
C?	enddo
C?      idel=ivsmax-ivsmin
C?	if (idel.eq.0.) then
C?	idel=nint((ind(iutvs+24)-ind(iutvs+23))*24.)
C?	ivsmin=ivsmax-idel
C?	endif
C START:
C  PCN
       read(12,32,end=52) (xind(k),k=0,71)  ! PCN
	pcnmax=0
	iutpcn=0
	do iut=0,71
	iut0=iut-24
	if (pcnmax.lt.xind(iut)) then
	pcnmax=xind(iut)
	iutpcn=iut0
	endif
	enddo
CC	GOTO 158  ! Avoid extra parametersw ==========>>>>>>>>>>>>>>>
C  PCS
       read(13,32,end=53) (xind(k),k=0,71)  ! ap
	pcsmax=0
	iutpcs=0
	do iut=0,71
	iut0=iut-24
	if (pcsmax.lt.xind(iut)) then
	pcsmax=xind(iut)
	iutpcs=iut0
	endif
	enddo
C		   Avoid next data:
C==========================================
	GOTO 123
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		   Avoid next data:
C==========================================
	GOTO 123
C==========================================
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 End extra parameters  ................>>>>>>>>>>>>>>>>>>>>>>
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
C/  138 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,I4,1X,I3,2(1X,I4)
C/     +,1X,I3,1X,F4.1
C/     +,3(1X,I3,1X,I4),1X,I3,1X,I5,2(1X,I3,1X,I4),3(1X,I3,1X,F5.2),1X,I4)
c/  138 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,I4,1X,I3,2(1X,I4)	 ! kp, ap, aa
c/     +,1X,I3,1X,F4.1,2(1X,I3,1X,I4),1X,I4)						 ! kp, ap, aa
CC     +,3(1X,I3,1X,F5.2),1X,I4)
C
C Output matrices:
C-	if (ikpmax.lt.30) goto 177
  123	continue
C/      xkp=ikpmax/10.
      nout=nout+1
C/	if (iaemax.eq.0) then
C/	ialmin=0
C/	iaumax=0
C/	iutal=0
C/	iutau=0
C/	endif
C
  138 format(1X,F8.3,1X,I3,3(1X,I2),1X,F3.1,2(1X,I3),2(1X,I4)) ! Dstmin
	write(*,138) ryear1,lda1,imn1,idy1,iut1,xkp,ikpsum
	+,iutvs,idsmin,ninp
	write(22,138) ryear1,lda1,imn1,idy1,iut1,xkp,ikpsum
	+,iutvs,idsmin,ninp
C/ 	write(*,138) ryear1,ldam,imn1,idy1,iutm,ivmin,idtsw,ivmax,idelsw
C/	+,iutkp,xkp
C/	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutal,ialmin,iutau,iaumax
C/     +,iutds,idsmin,iutwp,wpmax,iutwpn,wpnmin
C/     +,iutwpp,wppmax,nout
C/ 	write(22,138)  ryear1,ldam,imn1,idy1,iutm,ivmin,idtsw,ivmax,idelsw
C/	+,iutkp,xkp
C/	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutal,ialmin,iutau,iaumax
C/	+,iutds,idsmin,iutwp,wpmax,iutwpn,wpnmin
C/     +,iutwpp,wppmax,nout
C+ 	write(*,138) ryear1,ldam,imn1,idy1,iutm,ivsmin,iutvs,ivsmax,idel
C+	+,iutpcn,pcnmax,iutpcs,pcsmax,iev
C/	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutal,ialmin,iutau,iaumax
C/     +,iutds,idsmin
CC     +,iutwp,wpmax,iutwpn,wpnmin,iutwpp,wppmax,nout
C+ 	write(22,138)  ryear1,ldam,imn1,idy1,iutm,ivsmin,iutvs,ivsmax,idel
C+	+,iutpcn,pcnmax,iutpcs,pcsmax,iev
C/	+,iutap,iapmax,iutaa,iaamax,iutae,iaemax,iutal,ialmin,iutau,iaumax
C/	+,iutds,idsmin
CC     +,iutwp,wpmax,iutwpn,wpnmin,iutwpp,wppmax,nout

  177	CONTINUE
C+   51 close(unit=11)
   52 close(unit=16)  !+++
   53 continue
C+   53 close(unit=13)
   54 continue
C+   54 close(unit=14)
   55 continue
CC       close(unit=15)
   56 continue
CC       close(unit=16)
   57 continue
CC       close(unit=17)
   58 continue
CC       close(unit=18)
   59 continue
CC      close(unit=19)
   60 continue
CC       close(unit=20)
   61 continue
CC      close(unit=21)
   27 close(unit=10)		!+
      close(unit=22)		!+
C-	close(unit=23)
C
        if (kpx.eq.'1') then
	kpx='2'
	goto 1
	  endif
C
   35      write(*,*) outfile
      pause ' ' 
      STOP
       END

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