      program lagapostar17
C...........................................................Oct 2023
C -12:to:+11h Hpo>=5, Apo to=0 at 17 storms Starlink launch
C
       DIMENSION hpo24(24),iapo24(24),ires(24)
	CHARACTER*128 INFHSS,INFILE,outhpo,outapo
C	+,OUTFILE
	CHARACTER*2 AMN,ADY,AUT,AMM
	CHARACTER*4 AYEAR
C
       infhss='cathpoapostr17.txt'
	infile='d:\Apkp\Hpo\HpoYEAR.txt'
C
C-	outfile='cathpoapostr17.txt'
	outhpo='hpoprof17.txt'
	outapo='apoprof17.txt'
	OPEN(11,file=infhss,action='READ')
C
C	OPEN(10,file=outfile)
	OPEN(13,file=outhpo)
	OPEN(14,file=outapo)
C
   28 format(I3,1X,I4,4(1X,I2))
   29 format(I4,3(1X,I2),33X,F6.3,2X,I3)
  32	FORMAT(1X,F8.3,1X,I3,4(1X,I2),1X,I3,1X,I2,1X,I3,F6.2,2(1X,I3))
C
C
	DO 177 iev=1,17
C-      read(11,28,end=127) nn,iyear,imn1,idy1,iut1,imm
      read(11,32,end=127) xyear,lda1,imn1,idy1,iut1,imm,lda0,iut0,kdtmax
	+,hpomax,iapomax,inn
	iyear=int(xyear)
	call blet4(iyear,AYEAR)
	if (iyear.eq.2020) then
	ndyr=366
	else
	ndyr=365
	endif
	del=1./ndyr
C
      iyr1=iyear-iyear/100*100
	 lda1=ndoy(iyr1,imn1,idy1)
	xyear=iyear+del*(lda1-1)
C
	lda0=lda1
	iut0=iut1-12
	if (iut0.lt.0) then
	lda0=lda1-1
	iut0=iut0+24
	endif
C
	infile(16:19)=AYEAR
      OPEN(12,file=infile,action='READ')
	nut2=1
    1	read(12,29,end=128) iyear2,imn2,idy2,iut2,hpo,iapo
      iyr2=iyear2-iyear2/100*100
	 lda2=ndoy(iyr2,imn2,idy2)
      IF (lda2.lt.lda0) GOTO 1  
C
       	IF (nut2.gt.24) then               !1
		GOTO 2 !
	                    ELSE               !1
C	
       hpo24(nut2)=hpo
	 iapo24(nut2)=iapo
	nut2=nut2+1
	GOTO 1
	ENDIF                                    !1
C
    2	CONTINUE
      call blet2(imn1,AMN)
	call blet2(idy1,ADY)
	call blet2(iut1,AUT)
	call blet2(imm1,AMM)
C
  23	iapomax=0 
      DO kk=1,24
	if (iapomax.lt.iapo24(kk)) then
      iapomax=iapo24(kk)
	hpomax=hpo24(kk)
      kdtmax=kk-13
C	if (kdtmax.gt.0) then
C	continue
C	 kdtmax=kk
C	endif
	endif
	ires(kk)=nint(hpo24(kk)*100)
	ENDDO
C Prepare lag (tapomax-t1)
C
C?        lagt=iut0-iut1
C?       if (lda1.eq.lda0) then
C?	 GOTO 23
C?	endif
C
C?	if (lda2.gt.lda1) then
C?	 lagt=iut2+24-iut1
C?	else
C?	lagt=iut2-24-iut1
C?	                 endif
C
C?	natau=natau+1
C      write(*,32) xyear,lda1,amn,ady,aut,amm,lda0,iut0,kdtmax,hpomax
C	+,iapomax,iev
C	write(10,32) xyear,lda1,amn,ady,aut,amm,lda0,iut0,kdtmax,hpomax
C	+,iapomax,iev
	write(*,33) (ires(k),k=1,24)
	write(13,33) (ires(k),k=1,24)
	write(*,33) (iapo24(k),k=1,24)
	write(14,33) (iapo24(k),k=1,24)
  128 close(12)
C	
  177	CONTINUE
  127 close(11)
C      close(10)
      close(13)
      close(14)
  33	FORMAT(24(1X,I4))
       pause ' '
	STOP
	END