	program extrdinpn24
C....................................................May 2016
C Read geom. and Dm+, Dm- indices for 1999-2015 
C Include Dst, AE,ap(tau),aa,ap, Dm+, Dm- indices extraction during 24 hrs after ICME (415 events)
C
C quiet: ap(tau)<14; apmax<30;aamax<45; AEmax<500 ,Dstmin>-30; Dm+ <10%, Dm- <10% 
C
c
	integer imn,kut1
	dimension IM(12)
     +,iap1(0:7),iaa1(0:7),iae1(0:23),idst1(0:23),apt1(0:7)
	+,idmp1(0:23),idmn1(0:23)
     +,iap2(0:15),iaa2(0:15),iae2(0:47),idst2(0:47),apt2(0:15)
	+,idmp2(0:47),idmn2(0:47)
	+,iap(0:24),iaa(0:24),iae(0:24),idst(0:24),apt(0:24)
	+,idmp(0:24),idmn(0:24)
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*65 outfilae,outfildst,outfilaa,outfilap,outfilapt,infeq
C	+,outxhi
     +,outdmp,outdmn
	CHARACTER*2 AMN,AYR,ADY,AUT,BMN,BYR,BDY
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ 
C		common/const/	umr
	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
C		 PI=ATAN(1.0)*4.
C        UMR=PI/180.

	outfilae='icmaei24.txt'  !  AE for ICME 1999- during 12 hrs 
	outfildst='icmdst24.txt'  ! Dst for ICME 1999- during 12 hrs 
	outfilaa='icmaai24.txt'  !  aa for ICME 1999- during 12 hrs 
	outfilap='icmapi24.txt'  !  ap for ICME 1999- during 12 hrs 
	outfilapt='icmapt24.txt'  ! apt for ICME 1999- during 12 hrs 
	outdmp='icmdmp24.txt'  ! Dm+ for ICME 1999- during 12 hrs 
	outdmn='icmdmn24.txt'  ! Dm- for ICME 1999- during 12 hrs 
	OPEN(11,FILE=OUTFILAE)
	OPEN(12,FILE=OUTFILDST)
	OPEN(13,FILE=OUTFILAA)
	OPEN(14,FILE=OUTFILAP)
	OPEN(15,FILE=OUTFILAPT)
	OPEN(16,FILE=OUTDMP)
	OPEN(17,FILE=OUTDMN)
   36 format(1X,I4,A1)
	iev=0
C
c+	infeq='exteqlons1.txt'	  !EIA storm EQs
c	infeq='exteqlonq1.txt'	  !EIA quiet EQs
      infeq='listicme1.txt'
	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,BMN,BDY,UT1
      jj=jj+1
	iev=jj
	do k=0,24
	iap(k)=0
	iaa(k)=0
	iae(k)=0
	idst(k)=0
	apt(k)=0.
	idmp(k)=0
	idmn(k)=0
	enddo

	BYR=AYEAR(3:4)
	read(byr,*) ryr
 	iyr=int(ryr)
	read(bmn,*) rmn
 	imn=int(rmn)
	read(bdy,*) 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,...,12 after EQ
C
CREM      DO 399 ihout=0,24
      ihout=0
C
	dhr=dhr+1.0
	IF (ut1.lt.0.) THEN
	kut1=0
	                ELSE
	ut2=ut1+dhr   ! nearest+dhr, h UT
C?	kut1=int(ut2)+1
       kut1=nint(ut2)

c/	rlt=ut2+glon/15.
c/	if (rlt.ge.24.) rlt=rlt-24.
c/	if (rlt.lt.0.) rlt=rlt+24.

C?  177	mcntm=mcntm+1
	if (kut1.ge.24) then
	kut1=kut1-24
	idy=idy+1
	   if (idy.gt.im(imn)) then
	   idy=1
	   imn=imn+1
      	if (imn.gt.12) then
      	imn=1
      	iyr=iyr+1
      	endif
	   endif
      endif
	ENDIF
	call blet2(iyr,AYR)
	call blet2(imn,AMN)
	call blet2(idy,ADY)
	call blet2(kut1,AUT)
	BYEAR(3:4)=AYR
	if (iyr.lt.30) then
	BYEAR(1:2)='20'
	else
      BYEAR(1:2)='19'
	endif
	ldar=ndoy(iyr,imn,idy)
	call subgindexnp(ldar,BYEAR,iaa1,iap1,iae1,idst1,apt1,idmp1,idmn1)
c/	call soco(ldar,rlt,glat,glon,dec1,xhi1,sr1,ss1)  ! corrected XHI for EIA control area
C
	do k=0,7
	iaa2(k)=iaa1(k)
	iap2(k)=iap1(k)
	apt2(k)=apt1(k)
	enddo
	do k=0,23
	iae2(k)=iae1(k)
	idst2(k)=idst1(k)
	idmp2(k)=idmp1(k)
	idmn2(k)=idmn1(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 subgindexnp(ldar2,BYEAR,iaa1,iap1,iae1,idst1,apt1
	+,idmp1,idmn1)
	do k=0,7
	iaa2(k+8)=iaa1(k)
	iap2(k+8)=iap1(k)
	apt2(k+8)=apt1(k)
	enddo
	do k=0,23
	iae2(k+24)=iae1(k)
	idst2(k+24)=idst1(k)
	idmp2(k+24)=idmp1(k)
	idmn2(k+24)=idmn1(k)
	enddo
C
C?	iut3=kut1/3
	kutend=kut1+24
C
	DO ihr=0,24
	iut3=(kut1+ihr)/3
	iaa(ihr)=iaa2(iut3)
	iap(ihr)=iap2(iut3)
	apt(ihr)=apt2(iut3)
C
	ihr1=kut1+ihr
      iae(ihr)=iae2(ihr1)
	idst(ihr)=idst2(ihr1)
c	xhieq(ihout)=xhi1
      	idmp(ihr)=idmp2(ihr1)
	idmn(ihr)=idmn2(ihr1)
	ENDDO
C
  399 continue	! end of hourly cycle for EQ h=0,1,...12 h after EQ

	write(*,33) AYEAR,AMN,ADY,UT1,(iae(k),k=0,24)
	write(11,33) AYEAR,AMN,ADY,UT1,(iae(k),k=0,24)
	write(*,33) AYEAR,AMN,ADY,UT1,(idst(k),k=0,24)
	write(12,33) AYEAR,AMN,ADY,UT1,(idst(k),k=0,24)
	write(*,33) AYEAR,AMN,ADY,UT1,(iaa(k),k=0,24)
	write(13,33) AYEAR,AMN,ADY,UT1,(iaa(k),k=0,24)
	write(*,33) AYEAR,AMN,ADY,UT1,(iap(k),k=0,24)
	write(14,33) AYEAR,AMN,ADY,UT1,(iap(k),k=0,24)
	write(*,34) AYEAR,AMN,ADY,UT1,(apt(k),k=0,24)
	write(15,34) AYEAR,AMN,ADY,UT1,(apt(k),k=0,24)
c/	write(*,34) AYEAR,AMN,ADY,UT1,(xhieq(k),k=0,12)
c/	write(16,34) AYEAR,AMN,ADY,UT1,(xhieq(k),k=0,12)
	write(*,33) AYEAR,AMN,ADY,UT1,(idmp(k),k=0,24)
	write(16,33) AYEAR,AMN,ADY,UT1,(idmp(k),k=0,24)
	write(*,33) AYEAR,AMN,ADY,UT1,(idmn(k),k=0,24)
	write(17,33) AYEAR,AMN,ADY,UT1,(idmn(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)
C
   33 format(1X,A4,2A2,1X,F5.2,25(1X,I5))
   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

