C........................................................July 2023
C VBz peak
C........................................................Apr 2023
C Produce catalog VBz-peak, t(Vbzmax), Vbzmax
C Add for t0(dgec=0): lda0,mn0,dd0,ut0
C
C Extract VBz  for -12h<t0< +36h for 236 Apo > 100 nT events 1995-2023
C
C........................................................Mar. 2023
C 
C t0 at Apo >=100nT storm peak
C
C 
C Select period of 48hrs starting from t0-12h, ending t0+35h; 
C 
      PROGRAM extpeakvbz90
C Input HSSUT.txt 1995-2023...........................Jan 2020
C
C----------------------------------------------------------------
C
	DIMENSION inpn(0:47) ! 1h indices for 48h file 
C
      CHARACTER*128 INFILE,INFHSS
	+,outfile  !
		 CHARACTER*2 AMN,ADY,AUT
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
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
	infile='vbzapomn90.txt' !VBz total file for 1995-2023: 90 Apo-storms =nev lines x 48 cols superposed epoch	! 3
  	infhss='catapo6mn90.txt'  ! Apo 90 storms Apo>=90 nT + GECav-pre-storm 24hrs
	outfile='catapovbz90.txt'
C
C Start 
C
    1	CONTINUE
C
    7	OPEN(11,FILE=OUTFILE)
C
   28 format(1X,F8.3,1X,I3,3(1X,I2),1X,F5.0,1X,I3)
   29 format(A20,1X,I4,3(1X,I2),1X,F5.0)
   38 format(48(1X,I4))
C
	open(10,file=infhss,action='READ')
	open(15,file=infile,action='READ') ! dGEC(t) -12h...t0...t0+35h
C
C
C Cycle on events ====================================================
C
       	nev=90 ! intense Apo(tau6)>=90 nT monthly peak storms	
C
	DO 177 iev=1,nev
      read(10,28,end=27) xyear,lda1,imn1,idy1,iut1,aep,ninp
C	read(15,38,end=103) (inpn(k),k=0,47)
	read(15,*,end=103) inpn				   ! VBz/10 to-12...t0...to+35 hrs
C
       call blet2(imn1,AMN)
	call blet2(idy1,ADY)
	call blet2(iut1,AUT)
	iyear=int(xyear)
	iyr=iyear-iyear/100*100
C
	kapot0=12         ! peak Apo
C
C peak VBz
       kdmax=0
	ktmax=0
       do k=0,24
	if (inpn(k).gt.kdmax) then
	ktmax=k
	kdmax=inpn(k)
	endif
	enddo
C
C
	kdtmax=ktmax-kapot0
	 ldapp=lda1
	 	iutpp=iut1+kdtmax
	if (iutpp.lt.0) then 
	ldapp=lda1-1
	iutpp=iutpp+24
	endif
C
C Output catalog
C   
 333      dmax=kdmax*10.
      write(*,37) xyear,lda1,AMN,ADY,AUT,aep,ldapp,iutpp,kdtmax
	+,dmax,iev
      write(11,37) xyear,lda1,AMN,ADY,AUT,aep,ldapp,iutpp,kdtmax
	+,dmax,iev
  177	CONTINUE
   27 close(unit=10)
  103	close(unit=15)
      close(unit=11)
C
   37	format(1X,F8.3,1X,I3,3(1X,A2),1X,F5.0,3(1X,I3)
     +,1X,F7.0,1X,I3)
C
   35      write(*,*) infile
      pause ' ' 
      STOP
       END

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