C.........................................................July 2023
C Apo(tau6)max <= 90 nT
C........................................................June 2023
C Apo(tau6) for Apo storms. 
C  Search new t0 = t(Apo_tau6) peak [after peak t(Apomax)]
C retrive new t0-12h ... t0(Apo_tau6) peak ... t0+35 h ===total 48 hrs
C
C Extract Apo index and GEC  for -12h<t0< +36h for 223 Apo > 100 nT events 1995-2021
C or test storms 224-230 events 2022-2023
C
C........................................................Mar. 2023
C 
C t0 at Apo smoothed>=100nT storm peak
C
C Extract Apo smoothed-index and GEC  for -24h<t0< +48h for Apo events 
C 
C Select period of 72hrs starting from t0-24h, ending t0+48h; t0 @ AEmax_hour
C 
      PROGRAM deapotaumn12
C Input HSSUT.txt 1996-2019...........................Jan 2020
C add: select from -24h < to <+48h for HSS-events
C
C----------------------------------------------------------------
C
	DIMENSION apo(0:48) ! 1h indices for 48h file 
	+,apotau(0:48),inpn(0:48)
C
	CHARACTER*4 AYEAR,CYEAR
      CHARACTER*128 INFILE,INFHSS,outprof
C	+,outfile
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
      CHARACTER*2 AYR,AMN,ADY,AUT,CYR,CMN,CDY,CUT
	+,DYR(0:48),DMN(0:48),DDY(0:48),DUT(0:48)
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
      infile='d:\Apkp\Hpo\Apotau6.txt'
C
C	outfile='catapotaust12.txt' !Catalogue for 1995-2023 Apo(tau6)-storms 
	outprof='apotaumn90.txt' ! Apo(tau6) storm profiles: t0-12...t0+35 (48 hourly Apo(tau6)
  	infhss='catgecavmn90.txt'  ! Apo(tau6) monthly peak
C
C Start 
C
    1	CONTINUE
C
    7	OPEN(11,FILE=OUTPROF)
C    7	OPEN(11,FILE=OUTPROF,access='APPEND')
C
C Kp_1_2 nev storms from 1994 to 2021
C
   28 format(1X,F8.3,1X,I3,3(1X,I2),1X,F5.0)
  197 format(3X,2A2,1X,A2,10X,24(1X,I4))
C
	open(10,file=infhss,action='READ')
C
C
C Cycle on events ====================================================
C
Cnorm	nev=945 1995- 2023.02
C       	nev=342 ! total Apo monthly peak	1995-2023.06
       	nev=90 ! 
C
	open(15,file=infile,action='READ')	 !+++++++++++++++++++++++++!!!!!!!!!!
	DO 177 iev=1,nev
C
      read(10,28,end=27) xyear,lda1,imn1,idy1,iut1,aep
C--	if (iev.lt.301) GOTO 177  ! test outputTEMPPPPPPPPP
C
        call blet2(imn1,AMN)
      call blet2(idy1,ADY)
	call blet2(iut1,AUT)

	iutcnt=0
	iyear=int(xyear)
	iyr=iyear-iyear/100*100
	iut0=iut1-12
C
C
       nhr=0
	khr=0
C
C--------------------------------------------------
  222	CONTINUE
C       lda2=lda1+2
		if(int(xyear/4.)*4.eq.iyear) THEN 
	ndnyr=366
	                          ELSE
	ndnyr=365
	ENDIF
C	if (lda2.gt.ndnyr) lda2=lda2-ndnyr
	
C------------------------------------------------------
C
   36 format(1X,I4,3(1X,A2),2X,F5.0,2X,F6.2)	 ! hourly Apo,Apo(tau_6)
   37	format(A4,2(1X,A2),44X,I3)
C
C
C read all years:
C
C
1135       call blet4(iyear,AYEAR)
        AYR=AYEAR(3:4)
C
C	open(15,file=infile,action='READ')	 !+++++++++++++++++++++++++!!!!!!!!!!
C
C============================================
       iflag=0
	napo=48
	DO k=0,48
      DYR(k)='  '
	DMN(k)='  '
	DDY(k)='  '
	DUT(k)='  '
	ENDDO
C
  333 read(15,36,end=102) jyear,CMN,CDY,CUT,apo(48),apotau(48)
C        jyear=int(ryear)
	call blet4(jyear,CYEAR)
	CYR=CYEAR(3:4)
       DYR(48)=CYR
	DMN(48)=CMN
	DDY(48)=CDY
	DUT(48)=CUT
	read(CUT,*) xut
	jut=int(xut)
C
C Move data up 1 line
        do kk=0,47
	apo(kk)=apo(kk+1)
	apotau(kk)=apotau(kk+1)
	DYR(kk)=DYR(kk+1)
	DMN(kk)=DMN(kk+1)
	DDY(kk)=DDY(kk+1)
	DUT(kk)=DUT(kk+1)
	  enddo
C
C?	     IF (iflag.eq.2) GOTO 555
C?	     IF (iflag.eq.1) GOTO 334
C
      IF ((AYR.eq.DYR(12)).and.(AMN.eq.DMN(12)).and.(ADY.eq.DDY(12))
	+.and.(AUT.eq.DUT(12))) THEN
C	 iflag=1
	 GOTO 335       
	                 ELSE
	GOTO 333 
	                 ENDIF
C
  334	napo=napo-1
	if (napo.eq.12) then 
	             GOTO 335
	                else
              	GOTO 333
	               endif
C
C Find peak Apo(tau_6)
C
  335	CONTINUE                     !kutapo=iut1+12
      aptmax=0.
	kaptmax=12
      do kk=12,47
     	if (apotau(kk).gt.aptmax) then
	aptmax=apotau(kk)
	kaptmax=kk
	endif
	enddo
C
   33 FORMAT(1X,3A2,1X,A2,1X,F7.2,1X,I3)
   38 format(48(1X,I4))
C Output pf Catalogue Apo(tau_6)
C-      write(*,33) DYR(kaptmax),DMN(kaptmax),DDY(kaptmax),DUT(kaptmax)
C-	+,apotau(kaptmax),iev
C-      write(12,33) DYR(kaptmax),DMN(kaptmax),DDY(kaptmax),DUT(kaptmax)
C-	+,apotau(kaptmax),iev
C
       kkcnt=kaptmax
      iflag=2
555	if (kkcnt.gt.12) then
	kkcnt=kkcnt-1
	GOTO 333
	                 endif
C Output matrices:
       do m=0,47
	inpn(m)=nint(apotau(m)*10.)
	enddo
 	write(*,38) (inpn(k),k=0,47)
	write(11,38) (inpn(k),k=0,47)
C
  177	CONTINUE
  102 close(15)
   27 close(unit=10)
      close(unit=11)
c	close(unit=12)
C
C
   35      write(*,*) infile
      pause ' ' 
      STOP
       END

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