      program extwcpiaeq
C..Add peak Wc(pia)..for EQs at SSN0 (Kp0=1183, Kp3=609)...............June 2022
C JPL Wc indices 
C Wc peak from 3-days (SSN = 0) =regional from 4 W indices: at dlati=2.5o, dlong=5o around EQ=Mmax
C Wc = combined  with weights from 4 W-indices surrounding EQ daily peak
C 
C 
C
      CHARACTER*64 outfile,infileq
	CHARACTER*2 AYR,AMN,ADY,AUT,AMM,SMN,SDY,SUT
	DIMENSION wp(0:71)
C
      infileq='addeqkp3.txt' ! Kp>3	 nn=699  1994-2020
	outfile='addeqwckp3.txt'
C+      infileq='addeqkp0.txt' ! Kp0	 nn=1273  1994-2020
C+	outfile='addeqwckp0.txt'
C
       OPEN(11,file=infileq,action='READ')
       OPEN(12,file=outfile,access='APPEND')
   30 format(1X,F8.3,1X,I3,4(1X,I2),2(1X,F6.2),1X,I4,2(1X,F4.1)
     +,3(1X,I4))
   33 format(3I2,24(1X,F4.1))
C
	DO k=0,71
	wp(k)=0.
	ENDDO
	ndy=0
C
	DO 41 iev=1,699	   ! kp3
C+	DO 41 iev=1,1273	   ! kp0
C++	DO 41 iev=1,1274	   ! Kp0 SSN2=49i.u.
    	read(11,30,end=50) ryear,lda,imn,idy,iuteq,imm,glats,glons,kmds
 	+,aeqmax,eqav,kk,knum,ndy
c	IF (NDY.lt.1274) GOTO 41  !TEMPPPPPPPPPPPPP
C
      DO j=0,71
	wp(j)=0.0
	enddo
C
C
C 	 produce lag for day 
C++ READ 1h Wp
      iyear=int(ryear)
		z1=iyear/4.0
      jz=int(z1)*4
      IF(jz.EQ.iyear) THEN
	ndnr=366
		  ELSE
                ndnr=365
		       ENDIF

	iyr=iyear-iyear/100*100
	call blet2(iyr,AYR)
	call blet2(imn,amn)
	call blet2(idy,ady)
	call blet2(iuteq,aut)
	call blet2(imm,amm)
C
	lda0=lda-1
	if (lda0.lt.1) GOTO 43
	call submmdd(lda0,iyr,imn0,idy0)
	call blet2(imn0,smn)
	call blet2(idy0,sdy)
C
  43    DO iut=0,23
	call blet2(iut,sut)
	call subinterpw(glats,glons,ayr,smn,sdy,sut,res)
	wp(iut)=res
	ENDDO
C
      DO iut=0,23
      call blet2(iut,sut)
      call subinterpw(glats,glons,ayr,amn,ady,sut,res)
	wp(iut+24)=res
	ENDDO
C
      lda1=lda+1
	if (lda1.gt.ndnr) GOTO 44
	call submmdd(lda1,iyr,imn1,idy1)
	call blet2(imn1,smn)
	call blet2(idy1,sdy)
      DO iut=0,23
	call blet2(iut,sut)
	call subinterpw(glats,glons,ayr,smn,sdy,sut,res)
	wp(iut+48)=res
	ENDDO
  44    niteq=iuteq+24
       wpeq=wp(niteq)
C Wpmax
      wc_pre=0.
	it_pre=0
       kt1=niteq-24
	kt2=niteq+24
C	do k=0,71  !new
	do k=niteq,kt1,-1
C+	do k=kt1,kt2  !new
       if (wpeq.eq.0.0) then		!+++++++++++
	if ((wp(k-1).lt.0.0).or.(wp(k-1).gt.0.0)) then
	wc_pre=wp(k-1)
	it_pre=k-25
	exit
            endif
	                  else       !+++++++++++           
	if (wp(k)*wp(k-1).le.0) then  !change of sign
	wc_pre=wp(k-1)
	it_pre=k-25
	exit
	endif
	                endif         !++++++++++
	enddo
	jtw_pre=it_pre-iuteq
	if ((wc_pre.eq.0.0).and.(it_pre.eq.0)) jtw_pre=0
C
C Wpmin
      wc_nex=0.0
	it_nex=0
C	do k=0,71  !new
c+	do k=kt1,kt2  !new
      	do k=niteq,kt2
       if (wpeq.eq.0.0) then		!+++++++++++
	if ((wp(k+1).lt.0.0).or.(wp(k+1).gt.0.0)) then
	wc_nex=wp(k+1)
	it_nex=k-23
	exit
            endif
	                  else       !+++++++++++           
	if (wp(k)*wp(k+1).le.0) then   !change of sign
	wc_nex=wp(k+1)
	it_nex=k-23
	exit
	endif
	                endif         !++++++++++
	enddo
	jtw_nex=it_nex-iuteq
	if ((wc_nex.eq.0.0).and.(it_nex.eq.0)) jtw_nex=0
C Output
      write(*,32) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
 	+,aeqmax,eqav,kk,knum,wpeq,jtw_pre,wc_pre,jtw_nex,wc_nex,ndy

	write(12,32) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
 	+,aeqmax,eqav,kk,knum,wpeq,jtw_pre,wc_pre,jtw_nex,wc_nex,ndy

C
   41 continue
   32 format(1X,F8.3,1X,I3,4(1X,A2),2(1X,F6.2),1X,I4,2(1X,F4.1)
     +,2(1X,I4),1X,F5.2,2(1X,I3,1X,F5.2),1X,I4)
   50	close(unit=11)
	close(unit=12)
	pause ' '
	STOP
	END