	program histhss50
c .......................................................Jan 2019
C Histogram of occurrence HSS50
C for 1996-2019
C
c
	DIMENSION ikp(0:3),idv(0:3),ivs(0:3),iap(0:3),iaa(0:3)
	+,iae(0:3),ids(0:3),twp(0:3)
	+,nkp(0:3),ndv(0:3),nvs(0:3),nap(0:3),naa(0:3)
 	+,nae(0:3),nds(0:3),nwp(0:3)
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*64,infile,outfile,txt
	CHARACTER*2 AMN,ADY
	DATA ikp/0,30,50,60/,iap/0,15,48,80/,iaa/0,42,70,108/
	+,iae/0,450,900,1150/
	+,ids/0,-20,-45,-75/,twp/0.0,3.5,5.3,6.3/,idv/0,55,95,135/
     +,ivs/100,400,550,630/
C
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
		  outfile='histhss50.res'
	OPEN(11,FILE=OUTFILE,ACCESS='APPEND')
C
   36	format(1X,F8.3,2(1X,A2),9X,I4,3X,I4,6X,I4,3(5X,I4),4X,F4.1,4X,I2)

C
	infile='exthssmag50k.txt'
		OPEN(10,FILE=infile,ACTION='READ')
	read(10,*) txt ! title line
C
 	icntot=0 ! count of dPch
   1	read(10,36,end=155) RYEAR,AMN,ADY,kvs,kdv,kae,kaa,kap,kds,wp,kkp
      icntot=icntot+1
C
	if (kvs.lt.ivs(1)) then
	 nvs(0)=nvs(0)+1
	goto 51
	endif
	if (kvs.ge.ivs(3)) then 
	nvs(3)=nvs(3)+1
	goto 51
	endif
	if ((kvs.ge.ivs(1)).and.(kvs.lt.ivs(2))) then
	nvs(1)=nvs(1)+1
	goto 51
	endif
	if ((kvs.ge.ivs(2)).and.(kvs.lt.ivs(3))) then
	nvs(2)=nvs(2)+1
	endif
   51	CONTINUE      
C
	if (kdv.lt.idv(1)) then
	 ndv(0)=ndv(0)+1
      goto 52
	endif
	if (kdv.ge.idv(3)) then
	ndv(3)=ndv(3)+1
	goto 52
 	endif
	if ((kdv.ge.idv(1)).and.(kdv.lt.idv(2))) then
	 ndv(1)=ndv(1)+1
	goto 52
 	endif
	if ((kdv.ge.idv(2)).and.(kdv.lt.idv(3))) then 
	ndv(2)=ndv(2)+1
 	endif
   52	CONTINUE      
C
	if (kae.lt.iae(1)) then
	nae(0)=nae(0)+1
	goto 53
 	endif
	if (kae.ge.iae(3)) then
	nae(3)=nae(3)+1
		goto 53
  	endif
	if ((kae.ge.iae(1)).and.(kae.lt.iae(2))) then
	nae(1)=nae(1)+1
		goto 53
  	endif
	if ((kae.ge.iae(2)).and.(kae.lt.iae(3))) then
	nae(2)=nae(2)+1
  	endif
   53	CONTINUE      
C
	if (kaa.lt.iaa(1)) then
	naa(0)=naa(0)+1
		goto 54
  	endif
	if (kaa.ge.iaa(3)) then
	naa(3)=naa(3)+1
			goto 54
   	endif
	if ((kaa.ge.iaa(1)).and.(kaa.lt.iaa(2))) then
	naa(1)=naa(1)+1
			goto 54
   	endif
	if ((kaa.ge.iaa(2)).and.(kaa.lt.iaa(3))) then
	naa(2)=naa(2)+1
   	endif
   54	CONTINUE      
C
	if (kap.lt.iap(1)) then
	nap(0)=nap(0)+1
		goto 55
  	endif
	if (kap.ge.iap(3)) then
	nap(3)=nap(3)+1
		goto 55
  	endif
	if ((kap.ge.iap(1)).and.(kap.lt.iap(2))) then
	nap(1)=nap(1)+1
		goto 55
  	endif
	if ((kap.ge.iap(2)).and.(kap.lt.iap(3))) then
	nap(2)=nap(2)+1
  	endif
   55	CONTINUE      
C
	if (kds.gt.ids(1)) then
	nds(0)=nds(0)+1
		goto 56
  	endif
	if (kds.le.ids(3)) then
	nds(3)=nds(3)+1
		goto 56
  	endif
	if ((kds.le.ids(1)).and.(kds.gt.ids(2))) then
	nds(1)=nds(1)+1
		goto 56
  	endif
	if ((kds.le.ids(2)).and.(kds.gt.ids(3))) then
	nds(2)=nds(2)+1
  	endif
   56	CONTINUE      
C
	if (kkp.lt.ikp(1)) then
	nkp(0)=nkp(0)+1
		goto 57
  	endif
	if (kkp.ge.ikp(3)) then
	nkp(3)=nkp(3)+1
		goto 57
  	endif
	if ((kkp.ge.ikp(1)).and.(kkp.lt.ikp(2))) then
	nkp(1)=nkp(1)+1
		goto 57
  	endif
	if ((kkp.ge.ikp(2)).and.(kkp.lt.ikp(3))) then
	nkp(2)=nkp(2)+1
  	endif
   57	CONTINUE      
C
	if (wp.lt.twp(1)) then
	nwp(0)=nwp(0)+1
		goto 58
  	endif
	if (wp.ge.twp(3)) then
	nwp(3)=nwp(3)+1
		goto 58
  	endif
	if ((wp.ge.twp(1)).and.(wp.lt.twp(2))) then
	nwp(1)=nwp(1)+1
		goto 58
  	endif
	if ((wp.ge.twp(2)).and.(wp.lt.twp(3))) then
	nwp(2)=nwp(2)+1
  	endif
   58	CONTINUE      
      goto 1
 155  CLOSE(unit=10)
C start Vsw
      write(*,*) icntot
	write(11,*) icntot
	write(*,790) ivs(0),ivs(1),ivs(2),ivs(3)
	write(11,790) ivs(0),ivs(1),ivs(2),ivs(3)
	write(*,790) nvs(0),nvs(1),nvs(2),nvs(3)
	write(11,790) nvs(0),nvs(1),nvs(2),nvs(3)
C dVsw
	write(*,790) idv(0),idv(1),idv(2),idv(3)
	write(11,790) idv(0),idv(1),idv(2),idv(3)
	write(*,790) ndv(0),ndv(1),ndv(2),ndv(3)
	write(11,790) ndv(0),ndv(1),ndv(2),ndv(3)
C AE
	write(*,790) iae(0),iae(1),iae(2),iae(3)
	write(11,790) iae(0),iae(1),iae(2),iae(3)
	write(*,790) nae(0),nae(1),nae(2),nae(3)
	write(11,790) nae(0),nae(1),nae(2),nae(3)
C kp
	write(*,790) ikp(0),ikp(1),ikp(2),ikp(3)
	write(11,790) ikp(0),ikp(1),ikp(2),ikp(3)
	write(*,790) nkp(0),nkp(1),nkp(2),nkp(3)
	write(11,790) nkp(0),nkp(1),nkp(2),nkp(3)
C ap
	write(*,790) iap(0),iap(1),iap(2),iap(3)
	write(11,790) iap(0),iap(1),iap(2),iap(3)
	write(*,790) nap(0),nap(1),nap(2),nap(3)
	write(11,790) nap(0),nap(1),nap(2),nap(3)
C aa
	write(*,790) iaa(0),iaa(1),iaa(2),iaa(3)
	write(11,790) iaa(0),iaa(1),iaa(2),iaa(3)
	write(*,790) naa(0),naa(1),naa(2),naa(3)
	write(11,790) naa(0),naa(1),naa(2),naa(3)
C Dst
	write(*,790) ids(0),ids(1),ids(2),ids(3)
	write(11,790) ids(0),ids(1),ids(2),ids(3)
	write(*,790) nds(0),nds(1),nds(2),nds(3)
	write(11,790) nds(0),nds(1),nds(2),nds(3)
C Wp
	write(*,791) twp(0),twp(1),twp(2),twp(3)
	write(11,791) twp(0),twp(1),twp(2),twp(3)
	write(*,790) nwp(0),nwp(1),nwp(2),nwp(3)
	write(11,790) nwp(0),nwp(1),nwp(2),nwp(3)






 105	CONTINUE
 790  format(4(1X,I4))
 791  format(4(1X,F4.1))
C  %
c   

  800 CONTINUE             

	CLOSE(unit=11)
	goto 900
    2 CONTINUE
           write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
  900 pause ' '
      STOP
      END

