C........................................................Nov 2023
C By for Catalogue of montly peak Apo(tau6) . 
C 
C 
C
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 devbymn12
C 
C----------------------------------------------------------------
C
	DIMENSION vsw(0:48) ! 1h indices for 48h file 
	+,bz(0:48),iebz(0:47),ieby(0:47),by(0:48),bt(0:48),ebz(0:48)
	+,eby(0:47)
	+,jDYR(0:48),jDMN(0:48),jDDY(0:48),jDUT(0:48)
     +,kDYR(0:48),kDMN(0:48),kDDY(0:48),kDUT(0:48)
C
	CHARACTER*4 AYEAR
      CHARACTER*128 INFILE1,INFILE2,INFHSS,outeby,outebz,txt 
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
      CHARACTER*2 AYR,AMN,ADY,AUT
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
	infile1='d:\Apkp\OMNI\swYEAR.txt'  ! OMNI data Vsw
      infile2='d:\Apkp\OMNI\bxyzYEAR.txt'  ! OMNI data B,BY,BZ,EBz
C
  	infhss='catapo6mn90.txt'  ! Apo(tau6) monthly peak
C
c--	outfile='catgecavmn90.txt'  !Catalogue for 1995-2023 + GECav at pre-event 24hrs 
	outebz='ebzapomn90.txt' ! EBz(Vsw,Bz) profiles: t0-12...t0+35 (48 hourly )
	outeby='ebyapomn90.txt' ! EBy(Vsw,B,By) profiles: t0-12...t0+35 (48 hourly)
C
C Start 
        PI=ATAN(1.0)*4.
        UMR=PI/180.
C
    1	CONTINUE
C
C    7	OPEN(11,FILE=OUTFILE,access='APPEND')
C      OPEN(12,FILE=OUTGEC,access='APPEND')
C	OPEN(13,FILE=OUTDEV,access='APPEND')
C--    7	OPEN(11,FILE=OUTFILE)
    7	CONTINUE
      OPEN(12,FILE=OUTEBZ)
	OPEN(13,FILE=OUTEBY)
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)		 ! infhss
   29 format(1X,F8.3,1X,I3,3(1X,A2),1X,F5.0,1X,F5.2,1X,I4)
  197 format(3X,2A2,1X,A2,10X,24(1X,I4))
C
	open(10,file=infhss,action='READ')
C
C
C Cycle on events ====================================================
C
              	nev=90 ! total Apo(tau6)>=90 nT monthly peak	1995-2023.06
C
	DO 177 iev=1,nev
C
      read(10,28,end=27) xyear,lda1,imn1,idy1,iut1,aep
C
        call blet2(imn1,AMN)
      call blet2(idy1,ADY)
	call blet2(iut1,AUT)

	iutcnt=0
	iyear=int(xyear)
	call blet4(iyear,AYEAR)
	infile1(16:19)=AYEAR
	infile2(18:21)=AYEAR
C
	OPEN(15,file=infile1,action='READ')	 !+++++++++++++++++++++++++!!!!!!!!!! Vsw
	OPEN(16,file=infile2,action='READ')	 !+++++++++++++++++++++++++!!!!!!!!!! B,By,Bz,EBz
	do k=1,9
	read(15,*) txt  ! extra lines
	read(16,*) txt  ! extra lines
	enddo
C
	iyr=iyear-iyear/100*100
	iut0=iut1-12
	lda0=lda1-1 ! pre-event day
C
C
       nhr=0
	khr=0
C
C--------------------------------------------------
  222	CONTINUE
C
		if(int(xyear/4.)*4.eq.iyear) THEN 
	ndnyr=366
	                          ELSE
	ndnyr=365
	ENDIF
C
C------------------------------------------------------
C
   36 format(I4,1X,I3,1X,I2,1X,F4.2)	 ! hourly gec
   37	format(A4,2(1X,A2),7X,F5.1,16X,F5.0)
C
C
C read all years:
C
C	   call blet4(iyear,AYEAR)
1135    CONTINUE   
        AYR=AYEAR(3:4)
C
C============================================
       iflag=0
	napo=48
C
C
C-  333 read(15,36,end=102) jyear,jDMN(48),jDDY(48),jDUT(48),gec(48)
CC  333 read(15,36,end=102) jyear,lda,jDUT(48),bz,vsw(48)
  333 read(15,*,end=102) jyear,lda,jDUT(48),bh,bzj,tp,enp,vsw(48)
C       
C?	call blet4(jyear,CYEAR)
	jyr=jyear-jyear/100*100
	call submmdd(lda,jyr,jmn,jdy)
	jDYR(48)=jyr
	jDMN(48)=jmn
	jDDY(48)=jdy
C      vbz(48)=-1.*bz*vsw(48)
C
C
C Move data up 1 line
        do kk=0,47
	vsw(kk)=vsw(kk+1)
C	vbz(kk)=vbz(kk+1)
	jDYR(kk)=jDYR(kk+1)
	jDMN(kk)=jDMN(kk+1)
	jDDY(kk)=jDDY(kk+1)
	jDUT(kk)=jDUT(kk+1)
	  enddo
C
C
C continue read event profile:
C
  334	IF ((jDYR(12).eq.iYR).and.(jDMN(12).eq.iMN1).and.
     +(jDDY(12).eq.iDY1).and.(jDUT(12).eq.iut1)) THEN		 !==
         GOTO 335
	                else				 !==
              	GOTO 333
	               endif				 !==
C
  335	CONTINUE   
C Read B,By,Bz,EBz                    !
      read(16,*,end=103) kyear,klda,kDUT(48),bt(48),bx,by(48),bz(48)
	+,ebz(48)
	kyr=kyear-kyear/100*100
	call submmdd(klda,kyr,kmn,kdy)
	kDYR(48)=kyr
	kDMN(48)=kmn
	kDDY(48)=kdy
C
C Move data up 1 line
        do kk=0,47
      bt(kk)=bt(kk+1)
      by(kk)=by(kk+1)
      bz(kk)=bz(kk+1)
	ebz(kk)=ebz(kk+1)
	kDYR(kk)=kDYR(kk+1)
	kDMN(kk)=kDMN(kk+1)
	kDDY(kk)=kDDY(kk+1)
	kDUT(kk)=kDUT(kk+1)
	  enddo
C
C continue read event profile:
C
  336	IF ((kDYR(12).eq.iYR).and.(kDMN(12).eq.iMN1).and.
     +(kDDY(12).eq.iDY1).and.(kDUT(12).eq.iut1)) THEN		 !==
         GOTO 337
	                else				 !==
              	GOTO 335
	               endif				 !==
C
C............................................................
  337	CONTINUE   
      do kk=0,47
	if ((kk.gt.0).and.(bt(kk).gt.999.)) bt(kk)=bt(kk-1)
	if ((kk.gt.0).and.(by(kk).gt.999.)) by(kk)=by(kk-1)
	if ((kk.gt.0).and.(bz(kk).gt.999.)) bz(kk)=bz(kk-1)
	if ((kk.gt.0).and.(ebz(kk).gt.999.)) ebz(kk)=ebz(kk-1)
	if ((kk.gt.0).and.(vsw(kk).gt.9990.)) vsw(kk)=vsw(kk-1)
c	              ELSE
c	write(*,*) iyear,lda1,iev,kk
c	pause ' '
C                        ENDIF
	iebz(kk)=nint(ebz(kk)*10.)
C
C Produce Em
C
       if (bz(kk).eq.0.) bz(kk)=0.1
	 gteta=atan(abs(by(kk))/bz(kk))
C	dtan=tand(abs(by(kk))/bz(kk))
C      dtan=gtan/UMR	 ! grad
      teta=gteta/umr
      if ((teta.lt.0.).and.(teta.ge.-90.)) teta=teta+180.
	if ((teta.lt.-90.).and.(teta.lt.-180.)) teta=teta+360.
	BTYZ=sqrt(by(kk)**2+bz(kk)**2)
	eby(kk)=vsw(kk)*BTYZ*(sin(teta/2.*umr)**2)/1000.
	ieby(kk)=nint(eby(kk)*10.)
	enddo
C
   33 FORMAT(1X,3A2,1X,A2,1X,F7.2,1X,I3)
   38 format(48(1X,I4))
   39 format(48(1X,I5))
C Output 
 	write(*,39) (iebz(k),k=0,47)
	write(12,39) (iebz(k),k=0,47)
C
 	write(*,38) (ieby(k),k=0,47)
	write(13,38) (ieby(k),k=0,47)
  102 close(15)
  103 close(16)
  177	CONTINUE
   27 close(unit=10)
      close(unit=11)
	close(unit=12)
	close(unit=13)

C
C
   35      write(*,*) infile1,infile2
      pause ' ' 
      STOP
       END

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