	program exthss50wnpr
C......................................................Dec 2020
C
C Input HSS50f.txt 1996-2019...........................Jan 2020
C Add kp index
C Add Wln and Wup and Wer indices
C....................................................Oct. 2019
C Wp-storm from GEOGR. coord. GIM-TEC  from 01/1996 - to 12/2019
C Pch,Vsw,Dst,Ae,aa,ap,Wpm
C
C geogr. coord. map
C....................................................Jan 2017
C
C Extract geogr. indices for 2011.04-2019.09 at Pch-peaks>100i.u. (Dst_min <= -50 nT, Dst <=-30 nT) 
C                    Include AE,aa,ap,Vp (potocYR.txt),Vn(notocYR.txt) indices extraction
C select EXTREME values for time to=nint(to_Pch):to+5 days
C outfile='exthssmag4.txt'
c
	integer IM(12)
	dimension won(0:371),wop(0:371),wor(0:371)  ! +5 days from next year
     +,pch(371),xwon(0:23),xwop(0:23),xwor(0:23)  
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*71 infhss ! text
C-	+,infaa
     +,infile
	+,infwon,infwop,infwor
	+,outfile,txt
	CHARACTER*2 AYR,AYR_nex
	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

C-	infaa='d:/apkp/AA/aakpYEAR' !kp, aa, ap
C?	write(*,*) ' Enter YEAR:'
C?	read(*,*) IYEAR
C      infwon='d:/web/grif/datw/nptemYR.txt'
      infwon='d:/web/graf/datw/wlnYR.txt'
C	infwop='d:/web/grif/datw/pptemYR.txt'
      infwop='d:/web/graf/datw/wupYR.txt'
      infwor='d:/web/graf/datw/werYR.txt'
      infile='exthssmag50k.txt'
	outfile='exthss50wnpr.txt' !total file for 1996-2019 List t0+5days
C 
   30	format(A71)
C  31	format(39X,I4)
  31	format(1X,3I2,1X,F7.2)
   36 format(1X,I4,A1)
   37 format(20X,24(I4))	 ! AE
  137 format(14X,I2) ! kp
  237 format(6X,8(1X,F5.1))  ! ap(tau)
C   34 format(6X,24(1X,I4))  ! Vp, Vn
   34 format(6X,24(1X,F4.2))  !  Wp, Wop, Won
C
       do i=1,371
      pch(i)=0.
	 enddo
      icntot=0
C Cycle on years 1999-2016
C	iyear=2010   !TEMP	  Year_pre
	iyear=1995   !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 Vsw-peak events 2011/03-2018/12
C
C start cycle on year: =====================================
C
C+	do 400 KK=1,52	! 1964-2015
C	do 400 KK=1,9	! 2011-2019
	do 400 KK=1,24	! 1996-2019
C-	kk=1 !Temp
C//	if (kk.gt.1) ndyr0=ndnyr
	iyear=iyear+1
Crem	iyear=2015 !TEMP
	call blet4(iyear,AYEAR)
C
C-      if (iyear.lt.2019) then
	iyear_nex=iyear+1
C-	else
C-	iyear_nex=iyear
C-	endif
      call blet4(iyear_nex,AYEAR_nex)
	ryear=float(iyear)
	AYR=AYEAR(3:4)
	AYR_nex=AYEAR_nex(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
	wop(nn)=0.
	won(nn)=0.
	wor(nn)=0.
	enddo
C Reading won & wop files
	infwon(21:22)=AYR
	infwop(21:22)=AYR
	infwor(21:22)=AYR
	OPEN(10,FILE=infwon,action='READ')
      	read(10,*) txt ! Extra line
	OPEN(11,FILE=infwop,action='READ')
		read(11,*) txt ! Extra line
	OPEN(12,FILE=infwor,action='READ')
		read(12,*) txt ! Extra line
	do idd=1,ndnyr
	wonmin=0.
	wopmax=0.
	wormax=0.
	read(10,34,end=139) (xwon(k),k=0,23)
	read(11,34,end=140) (xwop(k),k=0,23)
	read(12,34,end=141) (xwor(k),k=0,23)
	do ii=0,23
	if (wonmin.gt.xwon(ii)) wonmin=xwon(ii) 
	if (wopmax.lt.xwop(ii)) wopmax=xwop(ii) 
	if (wormax.lt.xwor(ii)) wormax=xwor(ii) 
	enddo
	won(idd)=wonmin
	wop(idd)=wopmax
	wor(idd)=wormax
	enddo
  139	close(unit=10)
  140 close(unit=11)
  141 close(unit=12)
C
C+ 5 days from next year
		infwon(21:22)=AYR_nex
	infwop(21:22)=AYR_nex
	infwor(21:22)=AYR_nex
	OPEN(10,FILE=infwon,action='READ')
	read(10,*) txt ! Extra line
	OPEN(11,FILE=infwop,action='READ')
	read(11,*) txt ! Extra line
	OPEN(12,FILE=infwor,action='READ')
	read(12,*) txt ! Extra line
	do idd=ndnyr+1,ndnyr+5
	wonmin=0.
	wopmax=0.
	wormax=0.
	read(10,34,end=1139) (xwon(k),k=0,23)
	read(11,34,end=1140) (xwop(k),k=0,23)
	read(12,34,end=1141) (xwor(k),k=0,23)
	do ii=0,23
	if (wonmin.gt.xwon(ii)) wonmin=xwon(ii) 
	if (wopmax.lt.xwop(ii)) wopmax=xwop(ii) 
	if (wormax.lt.xwor(ii)) wormax=xwor(ii) 
	enddo
	won(idd)=wonmin
	wop(idd)=wopmax
	wor(idd)=wormax
	enddo
 1139	close(unit=10)
 1140 close(unit=11)
 1141 close(unit=12)
C
C
Crem   35 format(1X,F8.3,2(1X,I2),3(1X,F7.2),1X,I4)
   35 format(1X,F8.3,2(1X,I2),A71)
C
C+
C-       	infpch='delpchthr.res' ! All Del >Thr except day-by-day
C==       infsw='HSS50f.txt'       
      infile='exthssmag50k.txt'
C
C	OPEN(15,file=infpch,action='READ')
	OPEN(15,file=infile,action='READ')
	read(15,*) txt ! extra line
C
C Cycle on HSS peak events
C
	iev=0
C
	do 28 jj=1,1360        ! Catalogue HSS peaks for 1996-2019
  228 read(15,35,end=27,err=27) ryear,kmn,kdy,infhss
      kyear=int(ryear)
	iev=iev+1
C
C Remove -2018.04.15 
C-	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
	goto 277 ! no Pch data
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 Pch
	npcday=0
	pcmax=0.
	do lda=klda,klda2
	if (pch(lda).gt.pcmax) then
	pcmax=pch(lda)
C      npcday=lda-klda
      npcday=klda-lda
	endif
	enddo
C
C Select peak wop,won,wor
  277	nwopday=0
	wopmax=0.
	do lda=klda,klda2
	if (wop(lda).gt.wopmax) then
	wopmax=wop(lda)
      nwopday=lda-klda
	endif
	enddo
C
      nwonday=0
	wonmin=0.
	do lda=klda,klda2
	if (won(lda).lt.wonmin) then
	wonmin=won(lda)
      nwonday=lda-klda
	endif
	enddo
C
      nworday=0
	wormax=0.
	do lda=klda,klda2
	if (wor(lda).gt.wormax) then
	wormax=wor(lda)
      nworday=lda-klda
	endif
	enddo
C
C Output results
C
C	write(*,33) ryear,kmn,kdy,hssmin,hssmax,dhss,npcday,pcmax
	write(*,33) ryear,kmn,kdy,infhss,nwopday,wopmax,nwonday,wonmin
	+,nworday,wormax,iev
	write(16,33) ryear,kmn,kdy,infhss,nwopday,wopmax,nwonday,wonmin
	+,nworday,wormax,iev
  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)
C   33 format(1X,F8.3,2(1X,I2),3(1X,F6.0),1X,I2,1X,F7.2,4(1X,I2,1X,I5)
   33 format(1X,F8.3,2(1X,I2),A71,3(1X,I2,1X,F4.1),1X,I4)
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

