C........................................................Apr. 2022
C Limit t(peak) [-24h...23h]
C nev=433 Dst storms1 / 111 Dst stprms2 // 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 extpeaksdst
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
C	+,infds
c-	+,infsw
     +,infkp,infap,infaa
C     +,infae,infds,infal,infau
     +,infwp
     +,infwegm,infwlom,infwupm
	+,infwegn,infwlon,infwupn
	+,infwegs,infwlos,infwups
	+,outfile
	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='catdstxa.res'  ! Dst events t0 at Dst storm peak
	infhss='catdstx.txt' !includes Dst peaks
	infkp='dstkp5dx.txt' ! x= 1 ~ 2			   input Kp
	infap='dstap5dx.txt' ! x= 1 ~ 2			   input ap
	infaa='dstaa5dx.txt' ! x= 1 ~ 2			   input aa
	infwp='dstwp5dx.txt' ! x= 1 ~ 2			   input Wp
      infwupm='dstwudmx.txt' ! x= 1 ~ 2         ! input WUm
      infwlom='dstwldmx.txt' ! x= 1 ~ 2         ! input WLm
      infwegm='dstwedmx.txt' ! x= 1 ~ 2         ! input WEm
	infwupn='dstwudnx.txt' ! x= 1 ~ 2         ! input WUn
	infwlon='dstwldnx.txt' ! x= 1 ~ 2         ! input WLn
 	infwegn='dstwednx.txt' ! x= 1 ~ 2         ! input WEn
	infwups='dstwudsx.txt' ! x= 1 ~ 2         ! input WUs
	infwlos='dstwldsx.txt' ! x= 1 ~ 2         ! input WLs
	infwegs='dstwedsx.txt' ! x= 1 ~ 2         ! input WEs
C++
C Start kpstorm1 or kpstorm2
       kpx='1'
C
   1  CONTINUE
   	infkp(8:8)=kpx
      open(11,file=infkp,action='READ')
   	infap(8:8)=kpx
      open(12,file=infap,action='READ')
   	infaa(8:8)=kpx
      open(13,file=infaa,action='READ')
      infwp(8:8)=kpx
      open(14,file=infwp,action='READ')
   	    infwupm(8:8)=kpx
      open(15,file=infwupm,action='READ')
	   	infwlom(8:8)=kpx
      open(16,file=infwlom,action='READ')
	   	infwegm(8:8)=kpx
      open(17,file=infwegm,action='READ')
   	    infwupn(8:8)=kpx
      open(18,file=infwupn,action='READ')
	   	infwlon(8:8)=kpx
      open(19,file=infwlon,action='READ')
	   	infwegn(8:8)=kpx
      open(20,file=infwegn,action='READ')
   	    infwups(8:8)=kpx
      open(21,file=infwups,action='READ')
	   	infwlos(8:8)=kpx
      open(22,file=infwlos,action='READ')
	   	infwegs(8:8)=kpx
      open(23,file=infwegs,action='READ')

	outfile(7:7)=kpx
	infhss(7:7)=kpx
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.1))	 ! Wp
  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
	OPEN(24,FILE=OUTFILE)
C
C Kp storms from 1994 to 2021
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,I4,1X,I4)
	open(10,file=infhss,action='READ')
C
C Cycle on events ====================================================
C
       nout=0
	newout=0
	nev=433
	if (kpx.eq.'2') nev=111
	DO 177 iev=1,nev
      read(10,29,end=27) ryear1,lda1,imn1,idy1,iut1,idstpeak,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            Kp
C
      read(11,31,end=151) (ind(k),k=0,71)  ! Kp*10
C+	ivsmax=0
       ikpmax=0
	iutkp=0
C--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (ikpmax.lt.ind(iut)) then
	ikpmax=ind(iut)
	iutkp=iut0
	endif
	enddo
	xkpmax=ikpmax/10.0
	if ((iutkp.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C            Ap
C
      read(12,31,end=152) (ind(k),k=0,71)  ! ap
       iapmax=0
	iutap=0
C--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (iapmax.lt.ind(iut)) then
	iapmax=ind(iut)
	iutap=iut0
	endif
	enddo
	if ((iutap.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C            Aa
C
      read(13,31,end=153) (ind(k),k=0,71)  ! aa
       iaamax=0
	iutaa=0
c--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (iaamax.lt.ind(iut)) then
	iaamax=ind(iut)
	iutaa=iut0
	endif
	enddo
	if ((iutaa.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C  Wp
C		 
       read(14,32,end=154) (xind(k),k=0,71)  ! Wp
	wpmax=0
	iutwp=0
c--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (wpmax.lt.xind(iut)) then
	wpmax=xind(iut)
	iutwp=iut0
	endif
	enddo
	if ((iutwp.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C		   Read WUm data:
C
       read(15,37,end=155) (xind(k),k=0,71)  ! WUm
       wumaxm=0.
	iutwum=0
c--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (wumaxm.lt.xind(iut)) then
	wumaxm=xind(iut)
	iutwum=iut0
	endif
	enddo
	if ((iutwum.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C  WLm
       read(16,37,end=156) (xind(k),k=0,71)  ! WLm
	wlminm=100.
	iutwlm=0
	do iut=0,71
	iut0=iut-24
	if (wlminm.gt.xind(iut)) then
	wlminm=xind(iut)
	iutwlm=iut0
	endif
	enddo
C>>	if (iutwlm.gt.23) GOTO 177
C
C  WEm
       read(17,37,end=157) (xind(k),k=0,71)  ! WEm
	wemaxm=0
	iutwem=0
	do iut=0,71
	iut0=iut-24
	if (wemaxm.lt.xind(iut)) then
	wemaxm=xind(iut)
	iutwem=iut0
	endif
	enddo
C>>	if (iutwem.gt.23) GOTO 177
C
C		   Read WUn data:
C
       read(18,37,end=158) (xind(k),k=0,71)  ! WUn
       wumaxn=0.
	iutwun=0
c--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (wumaxn.lt.xind(iut)) then
	wumaxn=xind(iut)
	iutwun=iut0
	endif
	enddo
	if ((iutwun.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C  WLn
       read(19,37,end=159) (xind(k),k=0,71)  ! WLn
	wlminn=100.
	iutwln=0
	do iut=0,71
	iut0=iut-24
	if (wlminn.gt.xind(iut)) then
	wlminn=xind(iut)
	iutwln=iut0
	endif
	enddo
C>>	if (iutwln.gt.23) GOTO 177
C
C  WEn
       read(20,37,end=160) (xind(k),k=0,71)  ! WEn
	wemaxn=0
	iutwen=0
	do iut=0,71
	iut0=iut-24
	if (wemaxn.lt.xind(iut)) then
	wemaxn=xind(iut)
	iutwen=iut0
	endif
	enddo
C>>	if (iutwen.gt.23) GOTO 177
C
C		   Read WUs data:
C
       read(21,37,end=160) (xind(k),k=0,71)  ! WUs
       wumaxs=0.
	iutwus=0
c--	do iut=0,71
	do iut=0,47
	iut0=iut-24
	if (wumaxs.lt.xind(iut)) then
	wumaxs=xind(iut)
	iutwus=iut0
	endif
	enddo
	if ((iutwus.gt.23).and.(idstpeak.gt.-200)) GOTO 177
C
C  WLs
       read(22,37,end=161) (xind(k),k=0,71)  ! WLs
	wlmins=100.
	iutwls=0
	do iut=0,71
	iut0=iut-24
	if (wlmins.gt.xind(iut)) then
	wlmins=xind(iut)
	iutwls=iut0
	endif
	enddo
C>>	if (iutwls.gt.23) GOTO 177
C
C  WEs
       read(23,37,end=162) (xind(k),k=0,71)  ! WEs
	wemaxs=0
	iutwes=0
	do iut=0,71
	iut0=iut-24
	if (wemaxs.lt.xind(iut)) then
	wemaxs=xind(iut)
	iutwes=iut0
	endif
	enddo
C>>	if (iutwes.gt.23) GOTO 177
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
       read(16,33,end=156) (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
       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
C Output matrices:
  123	continue
      nout=nout+1
C
  138 format(1X,F8.3,1X,I3,3(1X,I2),1X,I4,1X,I3,1X,F3.1		!Dst,Kp,ap,aa,Wp
     +,2(1X,I3,1X,I3),1X,I3,1X,F4.1,9(1X,I3,1X,F5.2),1X,I4) ! 3(WU,WL,WE)
	write(*,138) ryear1,lda1,imn1,idy1,iut1,idstpeak
	+,iutkp,xkpmax,iutap,iapmax,iutaa,iaamax,iutwp,wpmax
     +,iutwum,wumaxm,iutwlm,wlminm,iutwem,wemaxm
	+,iutwun,wumaxn,iutwln,wlminn,iutwen,wemaxn
	+,iutwus,wumaxs,iutwls,wlmins,iutwes,wemaxs
     +,nout
	write(24,138) ryear1,lda1,imn1,idy1,iut1,idstpeak
	+,iutkp,xkpmax,iutap,iapmax,iutaa,iaamax,iutwp,wpmax
     +,iutwum,wumaxm,iutwlm,wlminm,iutwem,wemaxm
	+,iutwun,wumaxn,iutwln,wlminn,iutwen,wemaxn
	+,iutwus,wumaxs,iutwls,wlmins,iutwes,wemaxs
     +,nout

  177	CONTINUE
   27 close(unit=10)		!+
  151 close(unit=11)  !+++
  152 close(unit=12)  !+++
  153 close(unit=13)  !+++
  154 close(unit=14)
  155 close(unit=15)
  156 close(unit=16)
  157 close(unit=17)
  158 close(unit=18)
  159 close(unit=19)
  160 close(unit=20)
  161 close(unit=21)
  162 close(unit=22)
  163 close(unit=23)
      close(unit=24)		!+
C
        if (kpx.eq.'1') then
	kpx='2'
	goto 1
	  endif
C
   35      write(*,*) outfile
      pause ' ' 
      STOP
       END

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