      program extvdeqr1
C......................................................................Dec 2022
C Random EQs set 2000-2022 at SSN > 0
C
C..Add peak delVc=(TEC-TECmed)/std index from 1x1 GIM-DV maps..for random EQs (ev = 686)
C JPL Vc 1x1 indices 
C |Wc| peak from -1d:tEQ:+1d (SSN = 0) =from 4 W indices: at dlati=1.0o, dlong=1o near EQ=Mmax
C 
C 
C
      CHARACTER*64 outfile,infileq
	CHARACTER*2 AYR,AMN,ADY,AUT,AMM,SYR,SMN,SDY,SUT,SMM
	DIMENSION vd(0:287)
C
C
      infileq='cateqrnd1.txt' ! Random set for SSN>0  2000-2022
	outfile='addvieqr1.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)
     +,4(1X,I4))
   33 format(3I2,24(1X,F4.1))
C
	ndy=0
C
	DO 41 iev=1,686	     !  random EQ norm
    	read(11,30,end=50) ryear,lda,imn,idy,iuteq,imm,glats,glons,kmds
  	+,aeqmax,eqav,kk,knum,issn,ndyeq
      iyear=int(ryear)
	if (iev.lt.787) goto 41  !TEMP +Tohoku EQ
C
      DO j=0,287
	vd(j)=0.0
	enddo
C
C
C 	 produce lag for day 
C++ READ 15min Vi
		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) then
	iyear_pre=iyear-1
       iyr_pre=iyear_pre-iyear_pre/100*100
	call blet2(iyr_pre,syr)
	 smn='12'
	 sdy='31'
	             else
	call submmdd(lda0,iyr,imn0,idy0)
	call blet2(imn0,smn)
	call blet2(idy0,sdy)
	syr=ayr
	             endif
C
C Read DVi for prec day :
C
  43          ind=0
C 
      DO 141 iut=0,23
	call blet2(iut,sut)
C
        DO 142 imm=0,45,15
	call blet2(imm,smm)
	call subinterpv1x1(glats,glons,syr,smn,sdy,sut,smm,res)
	ind=ind+1
	vd(ind)=res
  142	CONTINUE
  141	CONTINUE
C
C
C Read DVi for curr day
      DO 143 iut=0,23
      call blet2(iut,sut)
C
      DO 144 imm=0,45,15
	call blet2(imm,smm)
      call subinterpw(glats,glons,ayr,amn,ady,sut,smm,res)
	ind=ind+1
	vd(ind)=res
  144	CONTINUE
  143	CONTINUE
C
      lda1=lda+1
	if (lda1.gt.ndnr) then 
	iyear_nex=iyear+1
       iyr_nex=iyear_nex-iyear_nex/100*100
	call blet2(iyr_nex,syr)
	 smn='01'
	 sdy='01'
	             else
	call submmdd(lda1,iyr,imn1,idy1)
	call blet2(imn1,smn)
	call blet2(idy1,sdy)
	syr=ayr
			endif
C
   44 DO 145 iut=0,23
	call blet2(iut,sut)
C
      DO 146 imm=0,45,15
	call blet2(imm,smm)
	call subinterpw(glats,glons,ayr,smn,sdy,sut,smm,res)
	ind=ind+1
	vd(ind)=res
  146	CONTINUE
  145	CONTINUE
C
  45    niteq=iuteq+24
       vdeq=vd(niteq)
C Wc-peak_pre
      wc_pre=0.
	awc_pre=0.
	it_pre=0
       kt1=niteq-24
	kt2=niteq+23
C
	do k=niteq-1,kt1,-1
      abswc=abs(vd(k))
	if ((abswc.gt.awc_pre)) then
	awc_pre=abswc
	wc_pre=vd(k)
	it_pre=k
            endif
	enddo
	jtw_pre=it_pre-niteq
c-	if ((wc_pre.eq.0.0).and.(it_pre.eq.0)) jtw_pre=0
C
C Wc-preak_nex
      wc_nex=0.0
	awc_nex=0.0
	it_nex=0
      	do k=niteq+1,kt2
      abswc=abs(vd(k))
	if ((abswc.gt.awc_nex)) then
	awc_nex=abswc
	wc_nex=vd(k)
	it_nex=k
            endif
	enddo
	jtw_nex=it_nex-niteq
C Output
      write(*,32) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
 	+,aeqmax,eqav,kk,knum,vdeq,jtw_pre,wc_pre,jtw_nex,wc_nex,issn,ndyeq

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

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),2(1X,I4))
   50	close(unit=11)
	close(unit=12)
	pause ' '
	STOP
	END