C........................................................Jan.2021
C Cnt Monthly Occurrence Dst>-30 nT 1957-2020
C 
C 
      PROGRAM cntdstq
C
C----------------------------------------------------------------
C
	DIMENSION kdst(12),imon(12),IM(12)
	+,idst(0:23)
C
	CHARACTER*2 AYR,AMN
	CHARACTER*4 AYEAR
      CHARACTER*128 INFILE,outfildst
	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/dst/dstYEAR' ! dst
C
	outfildst='cntdstq.txt' ! monthly number of 1h dst>-30, %
	OPEN(11,FILE=OUTFILDST)
	write(*,*) ' dst> -30'
	write(11,*) ' dst> -30'
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=1957,2020
       call blet4(iyear,AYEAR)
	ryear=float(iyear)
	iyr=iyear-(iyear/100)*100
      AYR=AYEAR(3:4)
c
      infile(16:19)=AYEAR
	OPEN(15,file=infile,action='READ')
 	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
	kdst(k)=0
	enddo
	iyr=iyear-iyear/100*100
	call blet2(iyr,AYR)
C
C
   35 format(3X,2I2,1X,I2,10X,24(I4))
      
	DO 101 k=1,ndnyr
	read(15,35,end=102) jyr,jmn,jdy,(idst(k),k=0,23)
	  do i=0,23
	imon(jmn)=imon(jmn)+1
	if (idst(i).gt.-30) then
	kdst(jmn)=kdst(jmn)+1
	endif
	  enddo
  101	CONTINUE
  102	close(unit=15)
C
C         
        do imn=1,12
	call blet2(imn,AMN)
      pdstq=float(kdst(imn))/imon(imn)*100.
	xyear=ryear+dev*(imn-1.)
	pdstd=100.-pdstq
  138 format(1X,F8.3,1X,A2,1X,F7.2)
C Output matrices:
 	write(*,138) xyear,amn,pdstd
	write(11,138) xyear,amn,pdstd
	enddo
  177	CONTINUE
   27 close(unit=11)
C
C
         write(*,*) infile
      pause ' ' 
      STOP
       END

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