      program extkp3ssn0
C......................................................May  2022
C
C......................................................Aug. 2021
C extract Kp<3 for SSN2=0 1954-1995
C
      character*128 infilkp,outfile3,outfile0
      character*2 AYR,AMN,ADY
	character*4 AYEAR
	dimension inkp(0:7),inkp0(0:7),inkp3(0:7)
C
      infilkp='d:\apkp\kpap\kpYEAR'
	outfile3='kp3ssn0n.txt'
	outfile0='kp0ssn0n.txt'
      OPEN(12,file=outfile0,access='APPEND')
	OPEN(13,file=outfile3,access='APPEND')
	icnt0=0
	icnt3=0
C
C      DO 50 iyear=1996,2021
      DO 50 iyear=1940,2022
	call blet4(iyear,AYEAR)
	iyr=iyear-(iyear/100)*100
	AYR=AYEAR(3:4)
	infilkp(16:19)=AYEAR
	OPEN(10,file=infilkp,action='READ')

C
       	xyear=float(iyear)
		if(int(xyear/4.)*4.eq.iyear) THEN 
	ndnyr=366
	                          ELSE
	ndnyr=365
	ENDIF
	del=1./ndnyr
C
   30	format(3I2,6X,8(I2),I3,31X,I3)
   1	read(10,30,end=150) iyr,imn,idy,inkp,isumkp,issn
      call blet2(iyr,ayr)
	call blet2(imn,amn)
	call blet2(idy,ady)
	lda=ndoy(iyr,imn,idy)
	ryear=xyear+del*(lda-1)
	ikpmax=0
	itkp=0
	do k=0,7
	if (inkp(k).gt.ikpmax) then
	ikpmax=inkp(k)
	itkp=k*3
	endif
	enddo
	xkpmax=ikpmax/10. 
C
      if (issn.gt.0) GOTO 1
C exclude Kp >=3
       iflag0=0
   3   do j=0,7
       inkp0(j)=0
	inkp3(j)=0
         if (inkp(j).lt.30) then
	inkp0(j)=inkp(j)
	iflag0=iflag0+1
	                     else
	inkp3(j)=inkp(j)
	   endif
   	enddo
	if (iflag0.eq.8) then
		icnt0=icnt0+1
C      write(*,31) icnt0,AYR,AMN,ADY,(inkp0(k),k=0,7)
	write(*,31) ryear,lda,amn,ady,itkp,xkpmax,isumkp,icnt0
C	write(12,31) icnt0,AYR,AMN,ADY,(inkp0(k),k=0,7)
      write(12,31) ryear,lda,amn,ady,itkp,xkpmax,isumkp,icnt0
	                  else
	 icnt3=icnt3+1
C      write(*,31) icnt3,AYR,AMN,ADY,(inkp3(k),k=0,7)
      write(*,31) ryear,lda,amn,ady,itkp,xkpmax,isumkp,icnt3
C	write(13,31) icnt3,AYR,AMN,ADY,(inkp3(k),k=0,7)
      write(13,31) ryear,lda,amn,ady,itkp,xkpmax,isumkp,icnt3
	                  endif
	GOTO 1
  150 close(unit=10)
C
   31	format(1X,F8.3,1X,I3,2(1X,A2),1X,I2,1X,F4.1,1X,I3,1X,I4)
   50 CONTINUE
  151 close(unit=12)
      close(unit=13)
	pause ' '
	STOP
	END
