C........................................................Dec.2020
C Count monthly Vsw kp<3.0, ap<15, aa<32
C 
C 
      PROGRAM cntzerokp
C
C----------------------------------------------------------------
C
	DIMENSION IM(12),icmon(12)
	+,kkp(12),kap(12),kaa(12) ! monthly cnts of quiet 3h indice
C
	CHARACTER*2 AYR,AMN
	CHARACTER*4 AYEAR
      CHARACTER*128 INFILE,outfile !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
	outfile='cntzerokp.txt' !total file for 1996-2019
	OPEN(10,FILE=OUTFILE)
C
C
   28 format(1X,F8.3,3(1X,I2),3(1X,F6.0))
   29 format(1X,F8.3,1X,I3,2(1X,I2),1X,I3,1X,F6.0,1X,I2,2(1X,F6.0))

C
C Yearly Cycle ====================================================
C
	DO 40 iyear=1994,2020
      call blet4(iyear,AYEAR)
      AYR=AYEAR(3:4)
	read(AYR,*) ryr
	iyr=int(ryr)
	if(int(ryr/4.)*4.eq.iyr) THEN 
 	im(2)=29
	ndyr=366
	                          ELSE
	im(2)=28
	ndyr=365
	ENDIF
	del=1./12.
      nhrs=ndyr*8
C
C
	infile(16:19)=AYEAR
	open(15,file=infile,action='READ')
C
      do ii=1,12
	icmon(ii)=0  ! number of hours/month
      kkp(ii)=0
	kap(ii)=0
	kaa(ii)=0
	enddo

C  day-to-day cycle
C
       DO 41 lda=1,nhrs
C
	read(15,*,end=102) jyear,jmn,jdy,jut,jkp,jap,jaa
		icmon(jmn)=icmon(jmn)+1
	if (jkp.lt.30) kkp(jmn)=kkp(jmn)+1
	if (jap.lt.15) kap(jmn)=kap(jmn)+1
	if (jaa.lt.32) kaa(jmn)=kaa(jmn)+1
  41	CONTINUE
  102	close(unit=15)
C Output:
      do imn=1,12
	call blet2(imn,AMN)
       ryear=float(iyear)+del*float(imn-1)
      pkp=float(kkp(imn))/icmon(imn)*100.
	pap=float(kap(imn))/icmon(imn)*100.
	paa=float(kaa(imn))/icmon(imn)*100.
	write(*,34) ryear,pkp,pap,paa
	write(10,34) ryear,pkp,pap,paa
	enddo 
C
   34 format(1X,F8.3,3(1X,F6.2))
  40	CONTINUE
   27 close(unit=10)
C
C
      pause ' ' 
      STOP
       END

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