C........................................................Dec.2020
C Cnt Monthly Occurrence kp<3 1994-2019
C 
C 
      PROGRAM cntkpq
C
C----------------------------------------------------------------
C
	DIMENSION kpq(12),imon(12),IM(12)
c/	,kap(0:23),kaa(0:23)
C
	CHARACTER*2 AYR,AMN
	CHARACTER*4 AYEAR
C	+,DYR(1132),DMN(1132),DDY(1132),DUT(1132)
      CHARACTER*128 INFILE,outfilkp
c/     +,outfilap,outfilaa !kp,ap,aa
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
      DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C++
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
	infile='d:/apkp/AA/aakpYEAR' !kp, aa, ap
C
	outfilkp='cntkpq.txt' ! monthly number of 3h kp<3, %
c/	outfilap='hssap1d.txt' !total file for 1996-2019 =1185 lines x 24 cols superposed epoch
c/	outfilaa='hssaa1d.txt' !total file for 1996-2019 =1185 lines x 24 cols superposed epoch
	OPEN(11,FILE=OUTFILKP)
c/	OPEN(12,FILE=OUTFILAP)
c/	OPEN(13,FILE=OUTFILAA)
C
C HSS/Dst 455 storms from 1996 to 2019
C
   28 format(1X,F8.3,3(1X,I2),3(1X,F6.0))
C   29 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0))
   29 format(1X,F8.3,1X,I3,3(1X,I2),1X,I4,2(1X,I4),1X,I3,2(1X,I4))
C	infhss='extrhssut.txt' ! 1132 HSS events
C-	infhss='outhss100.txt' ! 941 HSS events
C Cycle on year ====================================================
C
	DO 177 iyear=1994,2019
       call blet4(iyear,AYEAR)
	ryear=float(iyear)
	infile(16:19)=AYEAR
	open(15,file=infile,action='READ')
c
 	z1=iyear/4.0
      jz=int(z1)*4

      IF(jz.EQ.iyear) THEN
               IM(2)=29
	ndnyr=366
        ELSE
                IM(2)=28
	  ndnyr=365
	       ENDIF
	dev=1./12.
 	do k=1,12
	imon(k)=0
	kpq(k)=0
c/	inap(k)=0
c/	inaa(k)=0
	enddo
	iyr=iyear-iyear/100*100
	call blet2(iyr,AYR)
C
C
      
	DO 101 k=1,ndnyr
	  do i=0,7
C	read(15,137,end=102) jyear,jmn,jdy,jut,jkp,jap,jaa
	read(15,*,end=102) jyear,jmn,jdy,jut,jkp,jap,jaa
	imon(jmn)=imon(jmn)+1
	if (jkp.lt.30) then
	kpq(jmn)=kpq(jmn)+1
	endif
	  enddo
  101	CONTINUE
  102	close(unit=15)
C
         
        do imn=1,12
	call blet2(imn,AMN)
      pkp=float(kpq(imn))/imon(imn)*100.
	xyear=ryear+dev*(imn-1.)
  138 format(1X,F8.3,1X,A2,1X,F7.2)
C Output matrices:
 	write(*,138) xyear,amn,pkp
	write(11,138) xyear,amn,pkp
	enddo
  177	CONTINUE
   27 close(unit=11)
C
C
   35      write(*,*) infile
      pause ' ' 
      STOP
       END

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