      program exthpoeqr
C..Add peak Hpo (1h proxy pf kp)..for EQs at SSN-random 1995-2020...............Oct 2022
C Random set of EQs
C
      CHARACTER*64 outfile,infileq,infile
	+,txt
	CHARACTER*2 AMN,ADY,AUT,AMM
	DIMENSION hp(0:71),kap(0:71),kp(0:47)
C
      infileq='cateqrnd.txt' ! rnd SSN>0  1995-2020
	outfile='addeqhpornd.txt'  ! peak Hp
	infile='Hpo19952022.txt'
C
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))
   31 format(I4,A64)
   32 format(I4,2(1X,I2),1X,I2,32X,F7.3,1X,I4)
   33 format(3I2,24(1X,F4.1))
C
	DO k=0,71
	hp(k)=0.
	ENDDO
Cini	ndy=0
Ctemp	ndy=478
	ndy=664
C
	DO 41 iev=1,786	!temp
  123	read(11,30,end=50) ryear,lda,imn,idy,iuteq,imm,glats,glons,kmds
 	+,aeqmax,eqav,kk,knum,issn,ndyeq
      iyear=int(ryear)
Cpre		IF (iyear.lt.1995) GOTO 123
C
c1       if (ndyeq.le.518) goto 41  ! temp
c2       if (ndyeq.le.769) goto 41  ! temp
c3       if (ndyeq.le.1004) goto 41  ! temp
c4       if (ndyeq.le.1194) goto 41  ! temp
c5       if (ndyeq.le.1218) goto 41  ! temp
c6       if (ndyeq.le.1644) goto 41  ! temp
c7       if (ndyeq.le.1779) goto 41  ! temp
C       if (ndyeq.le.1895) goto 41  ! temp
Ctemp       if (iyear.lt.2010) goto 41					 !Temp
Ctemp	if ((iyear.eq.2010).and.(lda.le.121)) goto 41  !temp
       if (iyear.lt.2015) goto 41					 !Temp
	if ((iyear.eq.2015).and.(lda.le.183)) goto 41  !temp
C!Hpo data start from 1995
      DO j=0,71
	hp(j)=0.0
	kp(j)=0
	kap(j)=0
	enddo
C
	OPEN(10,file=infile,action='READ')
   1	read(10,31,end=55) kyear,txt
      IF (kyear.lt.iyear) then 
	goto 1
	ELSE
	backspace(10)
	ENDIF

C
C 	 produce lda for day 
C++ READ 1h hp
C
		z1=iyear/4.0
      jz=int(z1)*4
      IF(jz.EQ.iyear) THEN
	ndnr=366
		  ELSE
                ndnr=365
		       ENDIF

	iyr=iyear-iyear/100*100
C
	lda0=lda-1
	lda1=lda+1
	lda_nex=lda1
C+++
	    if (lda0.eq.0) then  !+++++++
C go back for 1 day
	do j=0,23
	backspace(10)
	enddo
C read data for the last day of prec. year
C
    	DO j=0,23					!3
	read(10,32,end=55) kyear,kmn,kdy,kut,hp(j+48),kap(j+48)
	 ENDDO						!3
	    endif				   !+++++++++
C+++
	if (lda1.gt.ndnr) lda_nex=lda
C
  43  	do 44 kk=1,lda_nex            !1
C Move data up:
      do jj=0,23
	hp(jj)=hp(jj+24)
	kap(jj)=kap(jj+24)
	hp(jj+24)=hp(jj+48)
	kap(jj+24)=kap(jj+48)
	 enddo					  !1
    	DO j=0,23					!3
	read(10,32,end=55) kyear,kmn,kdy,kut,hp(j+48),kap(j+48)
	 ENDDO						!3
   44	CONTINUE
C++
       if (lda1.gt.ndnr) THEN  
C	 +Read data for 1 Jan (the next year):
C Move data up:
      do jj=0,23
	hp(jj)=hp(jj+24)
	kap(jj)=kap(jj+24)
	hp(jj+24)=hp(jj+48)
	kap(jj+24)=kap(jj+48)
	 enddo					  !1
    	DO j=0,23					!3
	read(10,32,end=55) kyear,kmn,kdy,kut,hp(j+48),kap(j+48)
	 ENDDO						!3
	endif
C
C
   55	close(10)
      
C
      niteq=iuteq+24
       hpeq=hp(niteq)
	kapeq=kap(niteq)
C hpmax_pre
      hp_pre=0.0
	it_pre=0
       kt1=niteq-24
	kt2=niteq+23
C
	do k=niteq-1,kt1,-1
C
 	if (hp(k).gt.hp_pre) then
	hp_pre=hp(k)
	it_pre=k
	                endif  
	enddo
	jt_pre=it_pre-niteq
C
C hp_nex
      hp_nex=0.0
	it_nex=0
C
	do k=niteq+1,kt2  !new
C
 	if (hp(k).gt.hp_nex) then
	hp_nex=hp(k)
C	it_nex=k+24
	it_nex=k
	                endif  
	enddo
	jt_nex=it_nex-niteq
C Output
	call blet2(imn,AMN)
	call blet2(idy,ADY)
	call blet2(iuteq,AUT)
	call blet2(imm,AMM)
	kk=0
	do k=kt1,kt2
	kp(kk)=nint(hp(k)*10.0)
	kk=kk+1
	enddo
C
C      IF ((hpeq.lt.3.0).and.(hp_pre.lt.3.0).and.(hp_nex.lt.3.0))
Cpre      IF ((hpeq.lt.4.0).and.(hp_pre.lt.4.0).and.(hp_nex.lt.4.0))
Cpre    + THEN	 
       ndy=ndy+1
      write(*,35) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
 	+,aeqmax,eqav,ndyeq,knum,hpeq,jt_pre,hp_pre,jt_nex,hp_nex,issn,ndy
	write(12,35) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
 	+,aeqmax,eqav,ndyeq,knum,hpeq,jt_pre,hp_pre,jt_nex,hp_nex,issn,ndy
c+       write(*,36) (kp(k),k=0,47)
c+	write(13,36) (kp(k),k=0,47)
Cpre	  ELSE
Cpre       ndy2=ndy2+1
Cpre      write(*,35) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
Cpre 	+,aeqmax,eqav,ndyeq,knum,hpeq,jt_pre,hp_pre,jt_nex,hp_nex,ndy2
Cpre	write(14,35) ryear,lda,amn,ady,aut,amm,glats,glons,kmds
Cpre 	+,aeqmax,eqav,ndyeq,knum,hpeq,jt_pre,hp_pre,jt_nex,hp_nex,ndy2
c+       write(*,36) (kp(k),k=0,47)
c+	write(15,36) (kp(k),k=0,47)
Cpre        ENDIF
C
   41 continue
   35 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,F7.3),2(1X,I4))
   36 format(48(1X,I3))
   50	close(unit=11)
	close(unit=12)
c+	close(unit=13)
	close(unit=14)
c+	close(unit=15)
	pause ' '
	STOP
	END