C........................................................Dec. 2021
C 381 HSS/DST storms // 1991-2021

C WU, WL, WS global/north/south
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 477 HSS/Dst ~ 444 AE events 
C 
C Select period of 48hrs starting from t0-24h, ending t0+48h; t0 @ Vswmax_hour
C 
      PROGRAM extpeakswumd
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,infwp,infwug,infwun,infwus,infwlg,infwln,infwls
     +,infweg,infwen,infwes,outfile
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
C	CHARACTER*2 AYR,AMN,ADY
      CHARACTER*1 gns
	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
       write(*,*) ' Enter m, n, s:'
	read(*,*) gns
C+       infsw='hsssw1d.txt'
C+	 infkp='hsskp3d.txt'
C+	 infap='hssap3d.txt'
C+	 infaa='hssaa3d.txt'
	infsw='hsssw3d.txt'
C/	 infae='hssae1d.txt'
C/	 infds='hssds1d.txt'
C-	 infpn='hsspn1m.txt'
C/	 infal='hssal1d.txt'
C-	 infps='hssps1m.txt'
C/	 infau='hssau1d.txt'
	infwp='hsswp3d.txt'
	infwun='hsswu3dn.txt'
	infwln='hsswl3dn.txt'
	infwen='hsswe3dn.txt'
	infwus='hsswu3ds.txt'
	infwls='hsswl3ds.txt'
	infwes='hsswe3ds.txt'
	infwug='hsswu3dm.txt'
	infwlg='hsswl3dm.txt'
	infweg='hsswe3dm.txt'
      open(11,file=infsw,action='READ')
      open(12,file=infwp,action='READ')
      open(13,file=infwun,action='READ')
      open(14,file=infwln,action='READ')
      open(15,file=infwen,action='READ')
      open(16,file=infwus,action='READ')
      open(17,file=infwls,action='READ')
      open(18,file=infwes,action='READ')
      open(19,file=infwug,action='READ')
      open(20,file=infwlg,action='READ')
      open(21,file=infweg,action='READ')
   1  CONTINUE
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
   36 format(72(1X,F4.1))	 ! Wp
   37 format(72(1X,F4.2))	 !
   31 format(72(1X,I3))	 ! kp,ap,aa,
   33 format(72(1X,I4))	 ! ae,dst,sw,au,  WE,WU,WL

   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
      	outfile='hsswuwlwe3.txt'  ! Wp, WU, Wl, WE
	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)
   29 format(1X,F8.3,1X,I3,3(1X,I2),1X,I4,2(1X,I4),1X,I3,2(1X,I4))
	infhss='catdsthss3.txt'  ! 381 HSS/Dst events t0 at Dst storm onset
	open(10,file=infhss,action='READ')
C
C Cycle on events ====================================================
C
       nout=0
	newout=0
	DO 177 iev=1,381
      read(10,29,end=27) ryear1,ldam,imn1,idy1,iutm,idstpeak,ivmin
	+,idelsw,idtsw,ivmax,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
189       read(11,33,end=51) (ind(k),k=0,71)  ! Vsw
	ivsmax=0
	iutvs=0
	do iut=0,71
	iut0=iut-24
	if (ivsmax.lt.ind(iut)) then
	ivsmax=ind(iut)
	iutvs=iut0
	endif
	enddo
C Vsw min prior time Vsmax
	ivsmin=ivsmax
	iutvs0=0
	do  iut=0,iutvs+24
	iut0=iut-24
	if (ivsmin.gt.ind(iut)) then
	ivsmin=ind(iut)
	iutvs0=iut0
	endif
	enddo
      idel=ivsmax-ivsmin
	if (idel.eq.0.) then
	idel=nint((ind(iutvs+24)-ind(iutvs+23))*24.)
	ivsmin=ivsmax-idel
	endif
C START:
C  Wp
       read(12,36,end=52) (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
CC	
C  North WU
       read(13,33,end=53) (ind(k),k=0,71)  ! WUn
	iwumaxn=0
	iutun=0
	do iut=0,71
	iut0=iut-24
	if (iwumaxn.lt.ind(iut)) then
	iwumaxn=ind(iut)
	iutun=iut0
	endif
	enddo
C  North WL
       read(14,33,end=54) (ind(k),k=0,71)  ! WLn
	iwlminn=10
	iutln=0
	do iut=0,71
	iut0=iut-24
	if (iwlminn.gt.ind(iut)) then
	iwlminn=ind(iut)
	iutln=iut0
	endif
	enddo
C  North WE
       read(15,33,end=55) (ind(k),k=0,71)  ! WEn
	iwemaxn=0
	iuten=0
	do iut=0,71
	iut0=iut-24
	if (iwemaxn.lt.ind(iut)) then
	iwemaxn=ind(iut)
	iuten=iut0
	endif
	enddo
CC
C  South WU
       read(16,33,end=56) (ind(k),k=0,71)  ! WUs
	iwumaxs=0
	iutus=0
	do iut=0,71
	iut0=iut-24
	if (iwumaxs.lt.ind(iut)) then
	iwumaxs=ind(iut)
	iutus=iut0
	endif
	enddo
C  South WL
       read(17,33,end=57) (ind(k),k=0,71)  ! WLs
	iwlmins=10
	iutls=0
	do iut=0,71
	iut0=iut-24
	if (iwlmins.gt.ind(iut)) then
	iwlmins=ind(iut)
	iutls=iut0
	endif
	enddo
C  South WE
       read(18,33,end=58) (ind(k),k=0,71)  ! WEs
	iwemaxs=0
	iutes=0
	do iut=0,71
	iut0=iut-24
	if (iwemaxs.lt.ind(iut)) then
	iwemaxs=ind(iut)
	iutes=iut0
	endif
	enddo
CC
C  Global WU
       read(19,33,end=59) (ind(k),k=0,71)  ! WU
	iwumaxg=0
	iutug=0
	do iut=0,71
	iut0=iut-24
	if (iwumaxg.lt.ind(iut)) then
	iwumaxg=ind(iut)
	iutug=iut0
	endif
	enddo
C  Global WL
       read(20,33,end=60) (ind(k),k=0,71)  ! WL
	iwlming=10
	iutlg=0
	do iut=0,71
	iut0=iut-24
	if (iwlming.gt.ind(iut)) then
	iwlming=ind(iut)
	iutlg=iut0
	endif
	enddo
C  Global WE
       read(21,33,end=61) (ind(k),k=0,71)  ! WE
	iwemaxg=0
	iuteg=0
	do iut=0,71
	iut0=iut-24
	if (iwemaxg.lt.ind(iut)) then
	iwemaxg=ind(iut)
	iuteg=iut0
	endif
	enddo
  138 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,I4,1X,I3,2(1X,I4)	 ! Vsw
     +,1X,I3,1X,F4.1,9(1X,I3,1X,I4),1X,I4)						 ! WU, WL, WE
C Output matrices:
      nout=nout+1
 	write(*,138) ryear1,ldam,imn1,idy1,iutm,ivsmin,iutvs,ivsmax,idel
	+,iutwp,wpmax,iutun,iwumaxn,iutln,iwlminn,iuten,iwemaxn
	+,iutus,iwumaxs,iutls,iwlmins,iutes,iwemaxs
	+,iutug,iwumaxg,iutlg,iwlming,iuteg,iwemaxg,iev
 	write(22,138)  ryear1,ldam,imn1,idy1,iutm,ivsmin,iutvs,ivsmax,idel
	+,iutwp,wpmax,iutun,iwumaxn,iutln,iwlminn,iuten,iwemaxn
	+,iutus,iwumaxs,iutls,iwlmins,iutes,iwemaxs
	+,iutug,iwumaxg,iutlg,iwlming,iuteg,iwemaxg,iev
  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)
   62 close(unit=22)
   27 close(unit=10)
C
C
   35      write(*,*) outfile
      pause ' ' 
      STOP
       END

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