	program extpcharc4
C....................................................Oct. 2019
C ARn,ARp,ANn,ANp-storm from GEOMAG. coord. GIM-TEC  from 04/2011 - to 09/2019
C Pch Catalogue
C
C magn coord. map
C....................................................Jan 2017
C outfile='extpcharc4.txt' for Pchg dmax+5 days
C....................................................Dec 2016
C
C Extract auroral indices for 2011.04-2019.09 at Pch-peaks>100i.u. (>10% substorm) 
C ARp (woYRun.txt),ARn(woYRln.txt),ANp (woYRus.txt),ANn(woYRls.txt) indices extraction
C select EXTREME values for time to=nint(to_Pch):to+5 days
C outfile='extpchmag4.txt'
c
	integer IM(12)
	dimension iun(0:371),iln(0:371)  ! +5 days from next year
     +,ind24(0:23) ! Input 1h indices AE,Dst,Wp,(Vp,Vn) => select peak
     +,ius(0:371),ils(0:371)
C	nind ! peak index for d0+5 days
C	nday !  day of delay from d0 to d0+5 days: (nday=0,1,...5)
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*65 infun,infus,infln,infls,infpch
	+,outfile,txt
	CHARACTER*2 AYR
	CHARACTER*4 AYEAR,AYEAR_nex
C	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ 
C
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C

	infun='c:/msdev/projects/storm/woYRun.txt' ! ARp
	infln='c:/msdev/projects/storm/woYRln.txt' ! ARn
	infus='c:/msdev/projects/storm/woYRus.txt' ! ANp
	infls='c:/msdev/projects/storm/woYRls.txt' ! ANp
C?	write(*,*) ' Enter YEAR:'
C?	read(*,*) IYEAR
CREM	outfile='extrgicme1.txt'  ! 	total file for 1999-2016 =376 ICME List t0+47 hrs
	outfile='extpcharc4.txt' !total file for 2011-2019 =349 Pch-peak(-3d+3d) List t0+5days
C Enter Pch peak list for 2011-2018
   30	format(A50)
  31	format(39X,I4)
   36 format(1X,I4,A1)
   37 format(20X,24(I4))	 ! AE
  137 format(13X,2(1X,I3)) ! ap,aa
  237 format(6X,8(1X,F5.1))  ! ap(tau)
   34 format(6X,24(1X,I4))  ! (ARp, ARn, ANp, ANn) 
      icntot=0
C Cycle on years 1999-2016
	iyear=2010   !TEMP	  Year_pre
C	iyear=2015	 !Temp
	call blet4(iyear,AYEAR)
c//	outfile(6:9)=AYEAR
		OPEN(16,FILE=OUTFILE,access='APPEND')
	nicmes=0	   ! total Pch-peak events 2011/03-2018/12
C
C start cycle on year: =====================================
C
C+	do 400 KK=1,52	! 1964-2015
	do 400 KK=1,9	! 2011-2019
C-	kk=1 !Temp
C//	if (kk.gt.1) ndyr0=ndnyr
	iyear=iyear+1
Crem	iyear=2015 !TEMP
	call blet4(iyear,AYEAR)
C
      if (iyear.lt.2019) then
	iyear_nex=iyear+1
	else
	iyear_nex=iyear
	endif
      call blet4(iyear_nex,AYEAR_nex)
	ryear=float(iyear)
	AYR=AYEAR(3:4)
	read(ayr,*) ryr
	iyr=int(ryr)
		if(int(ryr/4.)*4.eq.iyr) THEN 
		 im(2)=29
	ndnyr=366
	                          ELSE
	IM(2)=28
	ndnyr=365
	ENDIF
C       !==============================================
	do nn=1,ndnyr+5
	iln(nn)=0
	iun(nn)=0
	ils(nn)=0
	ius(nn)=0
	enddo
C
C
C Reading ARn file
	infln(27:28)=AYR
	OPEN(10,FILE=infln,action='READ')
		do idd=1,ndnyr
	read(10,34,end=139) (ind24(ii),ii=0,23)
	ilnmax=0
	do ii=0,23
	if (ilnmax.lt.ind24(ii)) ilnmax=ind24(ii) 
	enddo
	iln(idd)=ilnmax
	enddo
  139	close(unit=10)
C+ 5 days from next year
	infln(27:28)=AYEAR_nex(3:4)
	OPEN(10,FILE=infln,action='READ')
	do idd=ndnyr+1,ndnyr+5
	read(10,34,end=239) (ind24(ii),ii=0,23)
		ilnmax=0
	do ii=0,23
	if (ilnmax.lt.ind24(ii)) ilnmax=ind24(ii) 
	enddo
	iln(idd)=ilnmax
	enddo
  239	close(unit=10)
C
C Reading ARp file
	infun(27:28)=AYR
	OPEN(10,FILE=infun,action='READ')
		do idd=1,ndnyr
	read(10,34,end=339) (ind24(ii),ii=0,23)
	iunmax=0
	do ii=0,23
	if (iunmax.lt.ind24(ii)) iunmax=ind24(ii) 
	enddo
	iun(idd)=iunmax
	enddo
  339	close(unit=10)
C+ 5 days from next year
	infun(27:28)=AYEAR_nex(3:4)
	OPEN(10,FILE=infun,action='READ')
	do idd=ndnyr+1,ndnyr+5
	read(10,34,end=439) (ind24(ii),ii=0,23)
		iunmax=0
	do ii=0,23
	if (iunmax.lt.ind24(ii)) iunmax=ind24(ii) 
	enddo
	iun(idd)=iunmax
	enddo
  439	close(unit=10)
C
C Reading ANn file
	infls(27:28)=AYR
	OPEN(10,FILE=infls,action='READ')
		do idd=1,ndnyr
	read(10,34,end=539) (ind24(ii),ii=0,23)
	ilsmax=0
	do ii=0,23
	if (ilsmax.lt.ind24(ii)) ilsmax=ind24(ii) 
	enddo
	ils(idd)=ilsmax
	enddo
  539	close(unit=10)
C+ 5 days from next year
	infls(27:28)=AYEAR_nex(3:4)
	OPEN(10,FILE=infls,action='READ')
	do idd=ndnyr+1,ndnyr+5
	read(10,34,end=639) (ind24(ii),ii=0,23)
		ilsmax=0
	do ii=0,23
	if (ilsmax.lt.ind24(ii)) ilsmax=ind24(ii) 
	enddo
	ils(idd)=ilsmax
	enddo
  639	close(unit=10)
C
C Reading ANp file
	infus(27:28)=AYR
	OPEN(10,FILE=infus,action='READ')
		do idd=1,ndnyr
	read(10,34,end=739) (ind24(ii),ii=0,23)
	iusmax=0
	do ii=0,23
	if (iusmax.lt.ind24(ii)) iusmax=ind24(ii) 
	enddo
	ius(idd)=iusmax
	enddo
  739	close(unit=10)
C+ 5 days from next year
	infus(27:28)=AYEAR_nex(3:4)
	OPEN(10,FILE=infus,action='READ')
	do idd=ndnyr+1,ndnyr+5
	read(10,34,end=839) (ind24(ii),ii=0,23)
		iusmax=0
	do ii=0,23
	if (iusmax.lt.ind24(ii)) iusmax=ind24(ii) 
	enddo
	ius(idd)=iusmax
	enddo
  839	close(unit=10)

C
   35 format(1X,F8.3,2(1X,I2),3(1X,F7.2),1X,I4)
C
C+
	infpch='delpchcat100.txt'  ! 2011-2019
C
	OPEN(15,file=infpch,action='READ')
	read(15,*) txt ! extra line
C
C Cycle on Pch peak events
C
	iev=0
C
	do 28 jj=1,349           ! Catalogue Pch peaks for 2011-2019
  228 read(15,35,end=27,err=27) ryear,kmn,kdy,pchmin,pchmax,dpch,kev
      kyear=int(ryear)
C
C Remove -2018.04.15 
	if (kev.ge.281) kev=kev-1
	if (kyear.ne.iyear) GOTO 28
C
	kyr=kyear-(kyear/100)*100
	klda=ndoy(kyr,kmn,kdy)
	klda2=klda+5
C
C Select peak indices during from currend day of PCH-max +5 days
C
C+	nxxmax ! peak daily index XX for d0+5 days
C+	nxxday !  nday of delay of XX from d0 to d0+5 days: (nday=0,1,...5)
C
C Select peak ARn
	nlnday=0
	nlnmax=0
	do lda=klda,klda2
	if (iln(lda).gt.nlnmax) then
	nlnmax=iln(lda)
      nlnday=lda-klda
	endif
	enddo
C
C Select peak APp
	nunday=0
	nunmax=0
	do lda=klda,klda2
	if (iun(lda).gt.nunmax) then
	nunmax=iun(lda)
      nunday=lda-klda
	endif
	enddo
C
C Select peak ANn
	nlsday=0
	nlsmax=0
	do lda=klda,klda2
	if (ils(lda).gt.nlsmax) then
	nlsmax=ils(lda)
      nlsday=lda-klda
	endif
	enddo
C Select peak ANp
	nusday=0
	nusmax=0
	do lda=klda,klda2
	if (ius(lda).gt.nusmax) then
	nusmax=ius(lda)
      nusday=lda-klda
	endif
	enddo
C
C Output results
C
	write(*,33) ryear,kmn,kdy,pchmin,pchmax,dpch,nlnday,nlnmax
	+,nunday,nunmax,nlsday,nlsmax,nusday,nusmax,kev
	write(16,33) ryear,kmn,kdy,pchmin,pchmax,dpch,nlnday,nlnmax
	+,nunday,nunmax,nlsday,nlsmax,nusday,nusmax,kev
C Remove -2018.04.15 
  28	CONTINUE
   27 close(unit=15)
c
C
C   33 format(1X,F8.3,2(1X,I2),3(1X,F7.2),6(1X,I2,1X,I5),1X,I4)
   33 format(1X,F8.3,2(1X,I2),3(1X,F7.2),4(1X,I2,1X,I5),1X,I4)
C?   31 format(1X,A4,2(1X,I5))
C
C
C
  400	CONTINUE ! next year
C	
      close(unit=16)
	goto 900
    2 CONTINUE
           write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
  900 pause ' '
      STOP
      END

