	program extromni
C....................................................May 2016
C Read solar wind and IMF indices for 1999-2015 
C Include B, Bs=Bstep(3h),dB/dt, Bz,Vsw,Np,dTp/dt extraction from OMNI files during 24 hrs after ICME
C
C quiet: ap(tau)<=10; apmax<=15;aamax<=24;AE(t)<400 & AEmax<400 (at t-6h),Dstmin>-30 (at t and t-1 h)
C
c
	integer imn,kut1
	dimension IM(12)
     +,eb1(0:26),db1(0:26),bz1(0:26),sw1(0:26),dsw1(0:26)
 	+,anp1(0:26),atp1(0:26),bs1(0:26),dtp1(0:26) !
     +,eb2(0:47),bs2(0:47),db2(0:47),bz2(0:47),sw2(0:47),dsw2(0:47)
	+,anp2(0:47),atp2(0:47),dtp2(0:47)
     +,eb(0:24),bs(0:24),db(0:24),bz(0:24),sw(0:24),dsw(0:24)
	+,anp(0:24),atp(0:24),dtp(0:24)
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*65 outfileb,outfildb,outfilbz,outfilsv,outfildv
	+,outfilnp,infeq,outfiltp,outfilbs,outfildt
	CHARACTER*2 AMN,AYR,ADY,AUT,BYR
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ 
	CHARACTER*4 AYEAR,BYEAR
C
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C

	outfileb='omnieb24.txt'  !  IMF B for ICME 1999- during 12 hrs 
	outfilbs='omnibs24.txt'  !  IMF Bstep3h  for ICME 1999- during 12 hrs 
	outfildb='omnidb24.txt'  ! DB/DT for ICME 1999- during 12 hrs 
	outfilbz='omnibz24.txt'  !  Bz for ICME 1999- during 12 hrs 
	outfilsv='omnisv24.txt'  !  Vsw for ICME 1999- during 12 hrs 
	outfildv='omnidv24.txt'  !  dVsw/dt for ICME 1999- during 12 hrs 
	outfilnp='omninp24.txt'  ! Np for ICME 1999- during 12 hrs 
	outfiltp='omnitp24.txt'  ! Tp for ICME 1999- during 12 hrs 
	outfildt='omnidt24.txt'  ! dTp/dt for ICME 1999- during 12 hrs 
C
	OPEN(11,FILE=OUTFILEB)
	OPEN(12,FILE=OUTFILBS)
	OPEN(13,FILE=OUTFILDB)
	OPEN(14,FILE=OUTFILBZ)
	OPEN(15,FILE=OUTFILSV)
	OPEN(16,FILE=OUTFILDV)
	OPEN(17,FILE=OUTFILNP)
	OPEN(18,FILE=OUTFILTP)
	OPEN(19,FILE=OUTFILDT)
   36 format(1X,I4,A1)
	iev=0
C
      infeq='listicme1.txt'	 ! full ICME list 1999-2015
	OPEN(20,file=infeq,action='READ')
C
C Cycle on hour-to-hour UT
  100	icntots=0
c 100   icntotq=0

c   35	format(1X,A4,2(A2),1X,F5.2)
   35	format(A4,2(1X,A2),1X,F5.2)
C
C+
	 jj=0
  101	read(20,35,end=27,err=2) AYEAR,AMN,ADY,UT1
      jj=jj+1
	iev=jj
	do k=0,24
	eb(k)=0.
	db(k)=0.
	bz(k)=0.
	sw(k)=0.
	dsw(k)=0.
	anp(k)=0.
	atp(k)=0.
	enddo

	BYR=AYEAR(3:4)
	read(byr,*) ryr
 	iyr=int(ryr)
	read(amn,*) rmn
 	imn=int(rmn)
	read(ady,*) rdy
 	idy=int(rdy)
		if(int(ryr/4.)*4.eq.iyr) THEN 
		 im(2)=29
	ndr=366
	                          ELSE
	IM(2)=28
	ndr=365
	ENDIF
C
      dhr=-1.0
C
C cycle on UT=0, 1,...,24 after ICME
C
      ihout=0
       kut1=nint(ut1)

	BYEAR=AYEAR
	call blet2(kut1,AUT)
C	BYEAR(3:4)=AYR
	ldar=ndoy(iyr,imn,idy)
	call subimfsw(ldar,BYEAR,eb1,bs1,db1,bz1,sw1,dsw1,anp1,atp1,dtp1)
C
	do k=0,23
	eb2(k)=eb1(k)
	bs2(k)=bs1(k)
	db2(k)=db1(k)
	bz2(k)=bz1(k)
	sw2(k)=sw1(k)
	dsw2(k)=dsw1(k)
	anp2(k)=anp1(k)
	atp2(k)=atp1(k)
	dtp2(k)=dtp1(k)
	enddo
	ldar2=ldar+1
	if (ldar2.gt.ndr) then
	ldar2=1
	iyr=iyr+1
	if (iyr.eq.100) iyr=0
	call blet2(iyr,AYR)
	BYEAR(3:4)=AYR
	endif
	call subimfsw(ldar2,BYEAR,eb1,bs1,db1,bz1,sw1,dsw1,anp1,atp1,dtp1)
	do k=0,23
	eb2(k+24)=eb1(k)
	bs2(k+24)=bs1(k)
	db2(k+24)=db1(k)
	bz2(k+24)=bz1(k)
	sw2(k+24)=sw1(k)
	dsw2(k+24)=dsw1(k)
	anp2(k+24)=anp1(k)
	atp2(k+24)=atp1(k)
	dtp2(k+24)=dtp1(k)
	enddo
C
	kutend=kut1+24
C
	DO ihr=0,24
	ihr1=kut1+ihr
	eb(ihr)=eb2(ihr1)
	bs(ihr)=bs2(ihr1)
	db(ihr)=db2(ihr1)
	bz(ihr)=bz2(ihr1)
      sw(ihr)=sw2(ihr1)
	dsw(ihr)=dsw2(ihr1)
     	anp(ihr)=anp2(ihr1)
	atp(ihr)=atp2(ihr1)
	dtp(ihr)=dtp2(ihr1)
	ENDDO
C
  399 continue	! end of hourly cycle for EQ h=0,1,...24 h after ICME

	write(*,34) AYEAR,AMN,ADY,UT1,(eb(k),k=0,24)
	write(11,34) AYEAR,AMN,ADY,UT1,(eb(k),k=0,24)
	write(*,34) AYEAR,AMN,ADY,UT1,(bs(k),k=0,24)
	write(12,34) AYEAR,AMN,ADY,UT1,(bs(k),k=0,24)
	write(*,34) AYEAR,AMN,ADY,UT1,(db(k),k=0,24)
	write(13,34) AYEAR,AMN,ADY,UT1,(db(k),k=0,24)
	write(*,34) AYEAR,AMN,ADY,UT1,(bz(k),k=0,24)
	write(14,34) AYEAR,AMN,ADY,UT1,(bz(k),k=0,24)
	write(*,33) AYEAR,AMN,ADY,UT1,(sw(k),k=0,24)
	write(15,33) AYEAR,AMN,ADY,UT1,(sw(k),k=0,24)
	write(*,34) AYEAR,AMN,ADY,UT1,(dsw(k),k=0,24)
	write(16,34) AYEAR,AMN,ADY,UT1,(dsw(k),k=0,24)
	write(*,34) AYEAR,AMN,ADY,UT1,(anp(k),k=0,24)
	write(17,34) AYEAR,AMN,ADY,UT1,(anp(k),k=0,24)
	write(*,32) AYEAR,AMN,ADY,UT1,(atp(k),k=0,24)
	write(18,32) AYEAR,AMN,ADY,UT1,(atp(k),k=0,24)
	write(*,32) AYEAR,AMN,ADY,UT1,(dtp(k),k=0,24)
	write(19,32) AYEAR,AMN,ADY,UT1,(dtp(k),k=0,24)
	 goto 101        ! next ICME
  428	CONTINUE
C
   27 close(unit=20)
c
      close(unit=11)
	close(unit=12)
	close(unit=13)
	close(unit=14)
	close(unit=15)
	close(unit=16)
	close(unit=17)
	close(unit=18)
	close(unit=19)
C
   32 format(1X,A4,2A2,1X,F5.2,25(1X,F8.0))
   33 format(1X,A4,2A2,1X,F5.2,25(1X,F5.0))
   34 format(1X,A4,2A2,1X,F5.2,25(1X,F5.1))
C


C	
	write(*,*) AYEAR,iev
	goto 900
    2 CONTINUE
           write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
  900 pause ' '
      STOP
      END

