C........................................................Jun 2023
C Produce catalog Apo-peak / month, Apomax(month) 1995-2023.06
C
C
      PROGRAM extpeakapomn
C
C----------------------------------------------------------------
C
C
      CHARACTER*128 INFILE,outfile  !
		 CHARACTER*2 AMN,ADY,AUT
	CHARACTER*4 AYEAR
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
C
      ICALLS=0
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
C
	infile='d:\Apkp\Hpo\Hpo19952023.txt' ! total file for 1995-2023 Apo(tauy6)
	outfile='catapopeakmn.txt'
C
C Start 
C
C
    7	OPEN(11,FILE=OUTFILE)
C
   28 format(1X,F8.3,3(1X,I2),3(1X,F6.0))
   29 format(A20,1X,I4,3(1X,I2),1X,F5.0)
   38 format(48(1X,I4))
C++   36 format(1X,F9.4,3(1X,I2),2X,F5.0,2X,F6.2)	 ! hourly Apo,Apo(tau_6)
C--   36 format(1X,I4,3(1X,I2),2X,F5.0,2X,F6.2)	 ! hourly Apo(tau_6),
   36 format(I4,3(1X,I2),41X,F4.0)	 ! hourly Apo

C
	open(10,file=infile,action='READ')
C
C
        apmax=0.
	mon=1
	nn=0
    1	CONTINUE
    2  read(10,36,end=102) iyear,iMN,iDY,iUT,apo
C?      ryear=float(iyear)
C
C Select monthly peak Apo(tau6)
	IF (imn.eq.mon) THEN           !
	    if (apo.gt.apmax) then
	apmax=apo
	iyearmax=iyear
	imnmax=imn
	idymax=idy
	iutmax=iut
	      goto 1
	               else
	goto 1
	               endif
	                  ELSE
	backspace(10)
	mon=mon+1
	if (mon.gt.12) mon=1
C
        call blet4(iyearmax,AYEAR)
       call blet2(imnmax,AMN)
	call blet2(idymax,ADY)
	call blet2(iutmax,AUT)
C--	 iyear=int(ryearmax)
	iyr=iyearmax-iyearmax/100*100
C
	lda=ndoy(iyr,imnmax,idymax) ! 
		year1=float(iyearmax)
	if(int(year1/4.)*4.eq.iyearmax) THEN 
	dnyr=366
	                          ELSE
	dnyr=365
	ENDIF
        del=1./dnyr
	ryearmax=year1+(lda-1)*del
C
C Output Catalog
	nn=nn+1
      write(*,37) ryearmax,lda,AMN,ADY,AUT,apmax,nn
      write(11,37) ryearmax,lda,AMN,ADY,AUT,apmax,nn
	 apmax=0.
	GOTO 1
	                  ENDIF
  177	CONTINUE
  102 close(unit=10)
      close(unit=11)
C
   37	format(1X,F8.3,2(1X,I3,3(1X,A2),1X,F5.0),2(1X,I4))
C
   35      write(*,*) infile
      pause ' ' 
      STOP
       END

C***********************************************************
