C........................................................July 2023
C dGEC detrended, %
C........................................................Apr 2023
C Produce catalog Apo-peak, t(dGEC+),t0,t(dGec-),dGECmax+,dGECmin-
C Add for t0(dgec=0): lda0,mn0,dd0,ut0
C
C Extract dGEC  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 Extract dGEC  for -12h<t0< +36h for Apo events (t0 at Apo > 100 nT)
C 
C Select period of 48hrs starting from t0-12h, ending t0+35h; 
C 
      PROGRAM extpeakgec90
C Input HSSUT.txt 1995-2023...........................Jan 2020
C
C----------------------------------------------------------------
C
	DIMENSION inpn(0:47) ! 1h indices for 48h file 
C	+,ind24(0:23)
C
      CHARACTER*128 INFILE,INFHSS
	+,outfile  !
		 CHARACTER*2 AMN,ADY,AUT,DMN,DDY,DUT
	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='dgecapomn90.txt' !dGEC total file for 1995-2023: 90 Apo-storms =nev lines x 48 cols superposed epoch	! 3
  	infhss='catgecavmn90.txt'  ! Apo 90 storms Apo>=90 nT + GECav-pre-storm 24hrs
	outfile='catapodgec90.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,F5.2,1X,I4)
   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,gecav,ninp
C	read(15,38,end=103) (inpn(k),k=0,47)
	read(15,*,end=103) inpn				   ! dgec*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
c	xyear=float(iyear)
c		if(int(xyear/4.)*4.eq.iyear) THEN 
c	ndnyr=366
c	                          ELSE
c	ndnyr=365
c	ENDIF
c	del=1./ndnyr
c	xyear=ryear+(lda1-1)*del
	kapot0=12         ! peak Apo
C
C peak dGEC+
       kdmax=0
	ktmax=0
       do k=0,24
	if (inpn(k).gt.kdmax) then
	ktmax=k
	kdmax=inpn(k)
	endif
	enddo
C
C min dGEC-
       kdmin=300
	ktmin=0
       do k=ktmax,47
	if (inpn(k).lt.kdmin) then
	ktmin=k
	kdmin=inpn(k)
	endif
	enddo
C
C t0 at intesection dGEC+ and dGec-
C-	kt0=kapot0+12  ! median t(dGECmin)
	kt0=ktmax  !  t(dGECmin)
C       if (kdmax.eq.0) then
C-	  kt0=-12
C-	endif
	do 123 k=ktmax,ktmin-1
	if (inpn(k)*inpn(k+1).le.0) then
	if (inpn(k).eq.0) then
	kt0=k
	exit
               else
	kt0=k+1
	exit
	endif
	                             endif
  123	continue
	kdtmax=ktmax-kapot0
	kdtmin=ktmin-kapot0
	kdt0=kt0-kapot0
	 ldapp=lda1
	 	iutpp=iut1+kdtmax
	if (iutpp.lt.0) then 
	ldapp=lda1-1
	iutpp=iutpp+24
	endif
	iut00=iut1+kdt0
	lda00=lda1
	if (iut00.gt.23) then
	lda00=lda00+1
	iut00=iut00-24
	endif
	iutnn=iut1+kdtmin
	ldann=lda1
	if (iutnn.gt.24) then
	ldann=ldann+1
	iutnn=iutnn-24
	endif
C
          GOTO 333
C lda0,imn0,idy0,iut0 for dGEC=0
	 lda0=lda1
	imn0=imn1
	idy0=idy1
	iut0=iut1
       IF (kdt0.eq.0) goto 111
	     IF (kdt0.lt.0) THEN
	iut0=iut1+kdt0
	  if (iut0.ge.0) then
	  goto 111
	                 else
        iut0=iut0+24
	  lda0=lda1-1
	call submmdd(lda0,iyr,imn0,idy0)
              goto 111
	endif
	                      ELSE
	iut0=iut1+kdt0
	  if (iut0.le.23) then
	  goto 111
	                 else
        iut0=iut0-24
	  lda0=lda1+1
	call submmdd(lda0,iyr,imn0,idy0)
              goto 111
	endif
	                      ENDIF
C
C Output catalog
  111	call blet2(imn0,DMN)
	call blet2(idy0,DDY)
	call blet2(iut0,DUT)
C   
 333      dmax=kdmax/10.
	dmin=kdmin/10.
      write(*,37) xyear,lda1,AMN,ADY,AUT,aep,gecav,ldapp,iutpp,kdtmax
	+,lda00,iut00,kdt0,ldann,iutnn,kdtmin,dmax,dmin,iev
      write(11,37) xyear,lda1,AMN,ADY,AUT,aep,gecav,ldapp,iutpp,kdtmax
	+,lda00,iut00,kdt0,ldann,iutnn,kdtmin,dmax,dmin,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,1X,F5.2,9(1X,I3)
     +,2(1X,F6.2),1X,I4)
C
   35      write(*,*) infile
      pause ' ' 
      STOP
       END

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