C........................................................Dec.2020
C Cnt Monthly Occurrence aa<27 1868-2020
C 
C 
      PROGRAM cntaaq
C
C----------------------------------------------------------------
C
	DIMENSION kaa(12),imon(12),IM(12)
	+,iaa(0:7)
C
	CHARACTER*2 AYR,AMN
	CHARACTER*4 AYEAR
      CHARACTER*128 INFILE,outfilaa
	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/aa18682020.txt' ! aa 
	OPEN(15,file=infile,action='READ')
C
	outfilaa='cntaaq.txt' ! monthly number of 3h aa<27, %
	OPEN(11,FILE=OUTFILAA)
	write(*,*) ' aa < 27'
	write(11,*) ' aa < 27'
C
C HSS/Dst 455 storms from 1996 to 2019
C
   28 format(1X,F8.3,3(1X,I2),3(1X,F6.0))
   29 format(1X,F8.3,1X,I3,3(1X,I2),1X,I4,2(1X,I4),1X,I3,2(1X,I4))
C
C Cycle on year ====================================================
C
	DO 177 iyear=1868,2020
       call blet4(iyear,AYEAR)
	ryear=float(iyear)
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
	kaa(k)=0
	enddo
	iyr=iyear-iyear/100*100
	call blet2(iyr,AYR)
C
C
   35 format(I4,2I2,8(I3),F5.1)
      
	DO 101 k=1,ndnyr
	read(15,35,end=102) jyear,jmn,jdy,(iaa(k),k=0,7),ave
	if (jyear.eq.iyear) then
	  do i=0,7
	imon(jmn)=imon(jmn)+1
	if (iaa(i).lt.27) then
	kaa(jmn)=kaa(jmn)+1
	endif
	  enddo
	else
	backspace(15)
	endif
  101	CONTINUE
C
C         
        do imn=1,12
	call blet2(imn,AMN)
      paaq=float(kaa(imn))/imon(imn)*100.
	xyear=ryear+dev*(imn-1.)
	paad=100.-paaq
  138 format(1X,F8.3,1X,A2,1X,F7.2)
C Output matrices:
 	write(*,138) xyear,amn,paad
	write(11,138) xyear,amn,paad
	enddo
  177	CONTINUE
  102	close(unit=15)
   27 close(unit=11)
C
C
         write(*,*) infile
      pause ' ' 
      STOP
       END

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