	program extpchwp1m
C....................................................Jan. 2019
C Observed Wp storms including moderate Wp>=4.0 during 0,1,...,5 days after Pch peak
C Pch,HSS common List
C
C Wp = magn coord. map
C	nind ! peak index for d0+5 days
C	nday !  day of delay from d0 to d0+5 days: (nday=0,1,...5)
C
C Extract geom. indices for 2011.04-2018.12 at Pch-peaks>THR (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+(47h?)+5 days
C outfile='extpchhss.txt'
c
	integer IM(12)
	dimension ihss(5,500) ! iyr,imn,idy,iut,lda
	+,hss(500),years(500)		   ! Wp peak
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*65 infhss,infpch,outwp4,outpch
	+,outfile,txt
	CHARACTER*2 AYR,AMN,ADY
	CHARACTER*4 AYEAR
		CHARACTER*6 YYMMDD
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
Crem	infhss='cnthss.res'
Crem       infhss='wpstmax1.txt'
       infhss='whstrms4o.out'
	outwp4='whstrs4o.res' ! only ryear for Wp-peaks >=4.0
	OPEN(11,file=outwp4)
	outpch='delpchpeak2.res'
	OPEN(12,file=outpch)      ! Only Pch for +ryear
C?	write(*,*) ' Enter YEAR:'
C?	read(*,*) IYEAR
	outfile='extpchwp1m.txt' !total file for 2011-2018 =556 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,F4.1))  ! Vsigma
   32 format(12X,3I2,2X,I2,2(1X,I2),2X,F4.1)
C  170	FORMAT(1X,A6,I3,2X,A6,I4,F6.1)
  170	FORMAT(1X,A6,I3,2X,3(I2),I4,F6.1)
   39 format(1X,F8.3,3(1X,I2),1X,F4.1)
      icntot=0
C
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
       OPEN(10,file=infhss,action='READ')
c-	read(10,*) txt
C read Wp events:
	 do ii=1,500
	read(10,170,end=111) YYMMDD,iii,iyr,imn,idy,iut,hss(ii)
		ryear=float(iyr)+2000.
	iyyyy=int(ryear)
		if(int(ryear/4.)*4.eq.iyyyy) THEN 
	ndnyr=366
	                          ELSE
	ndnyr=365
	ENDIF
       delyr=1./ndnyr
	lda=ndoy(iyr,imn,idy)
	ryear=ryear+delyr*(lda-1)
	years(ii)=ryear
	ihss(1,ii)=iyr
	ihss(2,ii)=imn
	ihss(3,ii)=idy
	ihss(4,ii)=iut
	ihss(5,ii)=lda
	write(*,39) ryear,imn,idy,iut,hss(ii)
      write(11,39) ryear,imn,idy,iut,hss(ii)
	 enddo
 111	close(unit=10)
      close(unit=11)
C start cycle on year: =====================================
C
       iyear=2010
	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
	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       !==============================================
C
   35 format(F9.3,2(1X,I2),3(1X,F7.2),1X,I4)
C
C+
	infpch='delpchpeak.res'  ! 2011-2018
C
	OPEN(15,file=infpch,action='READ')
	read(15,*) txt ! extra line
C
C Cycle on Pch peak events
C
	iev=0
	ipc=0
C
	do 28 jj=1,556           ! Pch peak list for 2011-2018
  228 read(15,35,end=27,err=27) ryear,kmn,kdy,pchmin,pchmax,dpch,kev
C
      if (ryear.lt.0.) GOTO 28 ! Avoid double-triple dates
	ipc=ipc+1
	write(*,35) ryear,kmn,kdy,pchmin,pchmax,dpch,ipc
      write(12,35) ryear,kmn,kdy,pchmin,pchmax,dpch,ipc
C
      kyear=int(ryear)
C
	if (kyear.ne.iyear) then
	GOTO 28
	endif
C
	kyr=kyear-(kyear/100)*100
	klda=ndoy(kyr,kmn,kdy)
	klda2=klda+5
C
C Select peak indices during from current day of PCH-max +5 days
C
C+	nxxday !  nday of delay of XX from d0 to d0+5 days: (nday=0,1,...5)
C
C Check HSS array
C
	nswday=-1
	nlda=0
	DO 26 nn=1,480
	nyr=ihss(1,nn)
	if (nyr.ne.kyr) goto 26
	nlda=ihss(5,nn)
	if (nlda.lt.klda) goto 26
	if (nlda.gt.klda2) exit
	if ((nlda.ge.klda).and.(nlda.lt.klda2)) then  !+
	xyear=years(nn)
	wp=hss(nn)
	nmn=ihss(2,nn)
	call blet2(nmn,AMN)
	ndy=ihss(3,nn)
	call blet2(ndy,ADY)
	nut=ihss(4,nn)
      nswday=nlda-klda
C Output results
      iev=iev+1
	write(*,33) ryear,kmn,kdy,pchmin,pchmax,dpch,xyear,amn,ady,nut
	+,nswday,wp,iev
	write(16,33)  ryear,kmn,kdy,pchmin,pchmax,dpch,xyear,amn,ady,nut
	+,nswday,wp,iev
	endif						!+
  26	CONTINUE
C
C
C>        if (nswday.ge.0) then
C
C>      iev=iev+1
C>	write(*,33) ryear,kmn,kdy,pchmin,pchmax,dpch,ayr,amn,ady,nut
C>	+,nswday,wp,iev
C>	write(16,33)  ryear,kmn,kdy,pchmin,pchmax,dpch,ayr,amn,ady,nut
C>	+,nswday,wp,iev
C>        endif
 
  28	CONTINUE
   27 close(unit=15)
c
C
   33 format(1X,F8.3,2(1X,I2),3(1X,F7.2),1X,1X,F8.3,2(1X,A2),2(1X,I2)
     +,1X,F4.1,1X,I4)
C
C
C
  400	CONTINUE ! next year
C	
      close(unit=12)
      close(unit=16)
	goto 900
    2 CONTINUE
           write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
  900 pause ' '
      STOP
      END

