!=====================================================================
! NGHG: Histogram, A Utility to Creating Bar Charts
!=====================================================================
!
! Histograms (bar charts) are used to show the distribution of values
! in a like-sample dataset. The individual values are sorted by size
! into a number of value ranges called "class intervals." The number
! of samples out of the total that fall into a class interval are
! represented as a histogram bar height. The height of each histogram
! bar is proportional to the number of samples in that class interval.
!
! There are five user-callable entries within the Histogram utility.
! HISTGR is called to generate a histogram. HSTOPC, HSTOPI, HSTOPL,
! and HSTOPR are called before HISTGR to set parameters (options) that
! affect the output histogram. All parameters have an original default
! setting.
!
! NG_HSTOPL - to specify various LOGICAL type internal parameters
! NG_HSTOPC - to specify various CHARACTER type internal parameters
! NG_HSTOPI - to specify various INTEGER type internal parameters
! NG_HSTOPR - to specify various REALArray type internal parameters
!
! NG_HISTGR - to generate a histogram plot
!
!------------
!
! NG_HSTRST - to reset all internal parameters (added by CNCARG)
! NG_HGRSET - to reset all internal parameters (same as NG_HSTRST)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_HISTGR( DAT1, NDIM, NPTS, IFLAG, CLASS, NCLASS,&
! bardraw, chrsize, minortk, overlay, offaxis, grdinfo, barinfo )
!
! Routine to plot a histogram with various options including
! specification of class values, spacing between histogram bars,
! shading of bars, windowing (i.e. scaling), specification of color,
! labels, titles, etc. Data values are partitioned into classes;
! histogram bars represent either number of occurrences within each
! class, or a Y-value associated with that class (user choice).
!
! Options are set by calls to subroutines HSTOPL, HSTOPR, HSTOPC, and
! HSTOPI before the call to HISTGR.
!
!---------
!
! *** Original ast two "working array arguments" have been removed by CNCARG
!
! *** CNCARG add seven optional arguments: bardraw, chrsize, minortk, overlay,
! offaxis, grdinfo, barinfo
!
!---------
!
! Variables:
!
! INTEGER, INTENT(IN ) :: NDIM, NPTS, IFLAG, NCLASS
! REAL, INTENT(IN ) :: DAT1(NDIM,2)
! REAL, INTENT(INOUT) :: CLASS(NCLASS+1)
!
! EXTERNAL :: bardraw
! OPTIONAL :: bardraw ! user defined bar shade/outline routine
! REAL, INTENT(IN ), OPTIONAL :: chrsize ! scaling "factor" of all characters sizes, default is 1.0
! INTEGER, INTENT(IN ), OPTIONAL :: minortk(2) ! number of minor ticks in x-CLASS/y-FREQUENCY(PERCENT) axes, default is (/0,0/)
! LOGICAL, INTENT(IN ), OPTIONAL :: overlay ! use last-time-left feequency/percent-axis if overlay is .TRUE., default is .FALSE.
! INTEGER, INTENT(IN ), OPTIONAL :: offaxis ! turn off drawing axis: 1=CLASS, 2=FREQUENCY, 3=CLASS+FREQUENCY
! REAL, INTENT( OUT), OPTIONAL :: grdinfo(8) ! viewport(1:4)/window(5:8) coordinates
! REAL, INTENT( OUT), OPTIONAL :: barinfo(3,NCLASS,2) ! (x-top-left,x-top-right,y-height) of "2" sets "NCLASS" bars
!
!---------
!
! DAT1 Two dimensional real array containing data of one
! of two types, either values to be collected into
! class intervals before plotting, or values which
! have already been assigned to class intervals and
! only need to be displayed. See argument IFLAG
! for a more complete description of HISTGR input
! data options. DAT1 is dimensioned: DAT1(NDIM,2).
!
! NDIM The size of the first dimension of DAT1 as set
! in the dimension statement of the calling program.
!
! NPTS Number of values actually stored into DAT1 on this
! call. NPTS must always be less than or equal to
! NDIM.
!
! IFLAG An integer flag which selects one of four options
! provided by the HISTGR utility. The options are:
!
! IFLAG = 0; A single array of length NPTS is loaded
! into the DAT1 array. HISTGR computes
! NCLASS equally sized class intervals
! that vary from the minimum value in
! DAT1 to the maximum value in steps of
! (MAX-MIN)/NCLASS.
!
! All values of DAT1 that fall in each
! class interval are separately accumulated
! for that interval. The final tabulations
! are plotted as a histogram of NCLASS bars.
! The bar height can be labeled with the
! number of points that fall within this
! particular class interval (bin size),
! or it can be given as a percentage of
! the number of values input, NPTS.
!
! Note that under IFLAG = 0, the user
! has no control over the range of the
! class intervals. They are internally
! determined from the range of the data.
!
! When missing values are present:
!
! NPTS = Total input points
! MISS = # of missing values
! NMVA = NPTS - MISS
!
! If MVA = ON, and NMV = OFF, the bin
! percentages are computed relative to
! NPTS.
!
! If MVA = ON, and NMV = ON, the bin
! percentages are computed relative to
! NMVA.
!
! If MVA = OFF, no checking is done for
! missing values.
!
! IFLAG = 1 This option is similar to the IFLAG = 0
! option except that the user can select
! the range of the class intervals into
! which the data are collected. For
! example, say the user wants to collect
! the number of occurrences of the DAT1
! values that fall within 5 equally spaced
! intervals in the value range from 0. to
! 10. The user would then input NCLASS+1
! class interval end points into array
! CLASS, namely 0., 2., 4., 6., 8., and
! 10. These values need not be entered in
! monotonically increasing order and need
! not be equally spaced.
!
! IFLAG = 2 This option allows the user to enter
! and display data which has already
! been accumulated into class intervals,
! i.e., already available histograms.
! The data input to DAT1 thus have
! percentage of total, or number of
! occurrences values. In this case the
! number of points in DAT1, NPTS, is
! equal to the number of class intervals
! (histogram bars), NCLASS. The NCLASS
! class interval midpoints are loaded
! into array CLASS. They do not have to
! be of equal width.
!
! IFLAG = 3 This option is the same as option
! IFLAG = 2 except that two histograms
! can be displayed for comparison purposes.
! The first histogram is loaded into
! DAT1(NPTS,1). The second histogram is
! loaded into DAT1(NPTS,2). The first
! histogram can partially shade or obscure
! the second histogram by the appropriate
! selection of the SPAC and OVERLP options.
!
! Note that NPTS = NCLASS when IFLAG = 2 or 3.
!
! CLASS Real array containing class values, dimensioned
! (NCLASS+1). This array has the following IFLAG
! dependencies:
! IFLAG = 0 CLASS is not used.
! IFLAG = 1 NCLASS+1 class interval end points are
! loaded into array CLASS. They will be
! sorted into a monotonically increasing
! order, if not input in that order. The
! intervals need not be of equal width.
! IFLAG = 2 NCLASS midpoint intervals are loaded
! into array CLASS. They must be in
! monotonically increasing order, but
! need not be of equal widths. The
! histogram bars will however be displayed
! with equal widths.
! IFLAG = 3 Same as for IFLAG = 2.
!
! NCLASS Number of class intervals (histogram bars) specified.
! NCLASS must be >= 1.
!
! Note: The frequency axis label values will be integers
! if the maximum Y-value (calculated within HISTGR)
! is an integer multiple of 4. Otherwise, real
! values with format F11.1 are used.
!
!-------------------
! Optional arguments added by CNCARG
!-------------------
!
! bardraw - User specified shade/outline drawing routine for bars
!
! SUBROUTINE bardraw(iset, ibar, idraw, np, px, py)
! USE CNCARG
! IMPLICIT NONE
!
! INTEGER, INTENT(IN) :: iset ! Historgam Set (1=first/2=second)
! INTEGER, INTENT(IN) :: ibar ! Current Bar/Bin Number
! INTEGER, INTENT(IN) :: idraw ! Shade or Outline (1=GFA, 2=GPL)
! INTEGER, INTENT(IN) :: np
! REAL, INTENT(IN) :: px(np), py(np)
!
! !---------------
! ! for each SET "iset" and each BAR "ibar"
! ! the default case (i.e., "BARDRAW" not present)
! !---------------
!
! SELECT CASE( idraw )
! CASE( 1 )
! CALL NG_GFA(np, px, py)
! CASE( 2 )
! CALL NG_GPL(np, px, py)
! END SELECT
!
! END SUBROUTINE bardraw
!
!---------
!
! chrsize - scaling "factor" for characters size, default is 1.0 if not present
!
! minortk - number of minor ticks in CLASS/FREQUENCY(PERCENT) axes, default is (/0,0/) if not present
!
! overlay - use last-time-left feequency/percent-axis if overlay is .TRUE., default is .FALSE.
!
! offaxis - turn off axis drawing: 1=CLASS, 2=FREQUENCY, 3=CLASS+FREQUENCY
!
! griinfo - returned viewport/window coordinates, if argument present
!
! barinfo - returned (x-top-left,x-top-right,y-height) of bars, if argument present
!
!=======================================================================
! A description of the option-setting entries of the package follows.
!=======================================================================
!
! SUBROUTINE NG_HSTOPL( LOPT )
!
! Routine to specify various LOGICAL variables to be used by the HISTGR
! package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: LOPT
!
! LOPT A character string (which may have up
! to seven characters) where the first
! 2 or 3 characters are abbreviations for
! the option followed by '=', followed by
! 'ON' or 'OFF'. 'OFF' may be abbreviated
! by 'OF'. Imbedded spaces are not allowed.
!
! Example: CALL HSTOPL('PER=OFF')
!
! The following options are turned 'ON' or 'OFF' by this
! routine (all defaults are listed at the end of the
! package documentation):
!
! HOR Horizontal.
! The histogram bars are drawn horizontally if 'HOR=ON'.
! If 'HOR=OFF', they are drawn vertically.
!
! PER Percent axis.
! If 'PER=ON', a labeled percent axis is drawn on the
! right side of the histogram (or on top if
! horizontal.) If 'PER=OFF', the percent axis is
! not drawn.
!
! MID Midvalues.
! If 'MID=ON', the class labels are put at the
! midpoint of each interval. If 'MID=OFF', the class
! interval end points are labeled. MID defaults
! to ON if IFLAG = 2 or 3.
!
! SHA Shading.
! If 'SHA=ON', the histogram rectangles are shaded.
! If 'SHA=OFF', the bars are not shaded. Laser printers
! may vary as to how they interpret shading;
! some will shade the bars black, others
! will only draw the outline, etc., depending
! on whether or not they support FILL AREA in
! hardware. On color terminals, the shading
! will correspond to whatever the RGB color
! table assigns to color index 1, even when
! the color option, 'COL=OFF', (and all
! other portions of the histogram are white).
! Terminals which do not support FILL AREA or
! color will show the outline of the 'shaded'
! histogram bars in white (they will appear to
! be unshaded).
!
! DRL Draw lines.
! If 'DRL=ON', lines are drawn through the histogram
! rectangles where Y-axis tick marks would occur.
! When IFLAG = 3 (when comparing two datasets
! in one histogram), lines are drawn through
! the bars associated with the first dataset
! only. If 'DRL=OFF', lines are not drawn.
!
! MED Median.
! If 'MED=ON', a line is drawn through the median
! of all points. If 'MED=OFF', this line is not drawn.
! MED does not apply when assigning Y-values to
! X-values; it is valid only for IFLAG = 1 or 2.
!
! NMV Normalize minus missing values.
! If 'NMV=ON', histogram bar percentages will be
! calculated with respect to the number of input
! data values (NPTS) minus the number of detected
! missing values (MISS), or NMVA = NPTS - MISS.
!
! If 'NMV=OFF', histogram bar percentages will be
! normalized to NPTS.
!
! PMV Print missing value count.
! If 'PMV=ON', missing value counts will be written
! on the plot. If 'NMV=OFF', they will not.
!
! PRM Perimeter.
! If 'PRM=ON', a perimeter is drawn around the
! histogram. If 'PRM=OFF', no perimeter is drawn.
!
! FRA Frame advance.
! If 'FRA=ON', the frame is advanced automatically
! after the histogram is drawn.
! If 'FRA=OFF', the frame is not advanced, and the
! user must call FRAME.
! *** CNCARG disable this option, 2016-07-28 ***
!
! LIS List options.
! If 'LIS=ON', all the options along with their values
! are printed on the standard output.
! If 'LIS=OFF', nothing is printed on the standard output.
!
! DEF Global defaults.
! If 'DEF=ON', all the options are set to their default
! values; see list of default values below.
! 'DEF=OFF' has no effect.
!
!-----------------------------------------------------------------------
!
! SUBROUTINE NG_HSTOPC( COPT, STRING, NUMBER, ILCH )
!
! Routine to specify various CHARACTER variables to be used by the
! HISTGR package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: COPT
! CHARACTER(*), INTENT(IN) :: STRING
! INTEGER, INTENT(IN) :: NUMBER, ILCH
!
! COPT A character string specifying which
! option is to be set. Valid options are:
!
! 'FOR=ON', or 'FOR=OFF'
! 'TIT=ON', or 'TIT=OFF'
! 'LAB=ON', or 'LAB=OFF'
! 'FQN=ON', or 'FQN=OFF'
! 'PTI=ON', or 'PTI=OFF'
! 'CHR=ON', or 'CHR=OFF'
!
! By choosing the ON form for an option, the user
! can override the default setting of that option.
! A subsequent call to HSTOPC with the OFF form
! for an option returns the option to the default
! setting. All defaults are listed below.
!
! STRING A character string up to 45(?) characters long.
! !---> chiangtp, 2016-07-29
! max chars:s 96 for 'TIT' (Main Title)
! 55 'FQN' (FreQueNcy axis label)
! 55 'PTI' (Percent axis label)
! 55 'LAB' (Class axis LABel)
! 55 'FOR' (FORmat for class labels)
! 100x15 'CHR' (Class interval label string)
! !---> chiangtp, 2016-07-29
!
! This argument depends upon the ON form being
! selected for an option. For example, if 'TIT=ON',
! a main title is input through argument STRING.
!
! NUMBER An integer variable which only applies to the
! following three options:
!
! 'FOR=ON' The maximum number of class intervals
! (histogram bars) which will be labeled.
!
! 'FOR=OFF' Defaults to 9 labels for vertical bars
! and 15 labels for horizontal bars.
!
! 'CHR=ON' Must be set to NCLASS, an argument of
! the subsequent call to be made to HISTGR.
!
! NUMBER is not used under any other option setting.
!
! Calls to HSTOPC with both 'FOR=ON' and 'CHR=ON'
! may be performed in any order; the parameters set
! by NUMBER are mutually exclusive in either case.
!
! ILCH An integer variable specifying the number of
! characters in each label of a class interval
! (histogram bar). This argument is only used with
! the 'CHR=ON' option.
!
! ILCH cannot be greater than 15.
!
!---------------------------------------
!
! The following options are defined by this subroutine:
!
! FOR Format for class labels. The 'FOR=OFF' default
! format is '(G10.3)'. Although class values
! are real numbers, integer formats are allowed,
! in which case HISTGR will convert from real to
! integer before plotting labels.
!
! TIT A main title. The 'TIT=OFF' default is no title.
! It can be up to 96 characters. If it is greater
! than 45 characters it will be written in multiple
! centered lines at no more than 45 characters per line.
!
! LAB A label for the class interval(histogram bar) axis. The
! 'LAB=OFF' default value is 'CLASS INTERVALS' when
! the HSTOPL option 'MID=OFF' is selected, and 'CLASS
! MIDVALUES' otherwise.
!
! In order to delete this axis label select 'LAB=ON'
! for COPT and 'NOLABEL' for STRING.
!
! FQN The frequency axis label. The 'FQN=OFF' default value
! is 'FREQUENCY'.
!
! In order to delete this axis label select 'FQN=ON'
! for COPT and 'NOLABEL' for STRING.
!
! PTI The percent axis label. The 'PTI=OFF' default value
! is 'PERCENT OCCURRENCE' when IFLAG = 0, or 1,
! 'PERCENT of MAXIMUM' when IFLAG = 2, or 3.
! In order to delete this axis label select 'PTI=ON'
! for COPT and 'NOLABEL' for STRING.
!
! CHR Character labels.
! Use a character string containing ILCH*NUMBER
! characters to specify alphanumeric labels for the
! class intervals (histogram bars). This is a packed
! sting of ILCH characters per class interval label.
!
! The character string must contain NUMBER(=NCLASS)
! class interval labels, even though all may not be
! used. See the definition of argument NUMBER.
!
! EXAMPLE:
!
! PARAMETER (NCLASS=12, ILCH=3)
! CHARACTER*36 LABEL
! CALL HSTOPC ('TIT=ON','MONTHLY PRECIPITATION in 1987',12,3)
! LABEL = 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'
! CALL HSTOPC ('CHR=ON',LABEL,12,3)
! CALL HSTOPC ('FOR=ON','(F3.0)',12,3)
!
! In the above example, there will be 12 alphanumeric
! class interval labels, each containing 3 characters
! to specify the months of the year. The main title
! indicates that the histogram depicts monthly precipitation
! in 1987.
!
! The call to HSTOPC with 'FOR=ON' and NUMBER = 12
! overrides the default number (9) of labels which would
! be plotted. Note that the '(F3.0)' format is ignored
! because 'CHR=ON'.
!
!-----------------------------------------------------------------------
!
! SUBROUTINE NG_HSTOPI( IOPT, PARAM1, PARAM2, ICOL, LCOL )
!
! Routine to specify various INTEGER variables to be used by the
! HISTGR package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: IOPT
! INTEGER, INTENT(IN) :: PARAM1, PARAM2, LCOL
! INTEGER, INTENT(IN) :: ICOL(LCOL)
!
! IOPT A character string specifying which
! option is to be set. Valid options are:
!
! 'COL=ON', or 'COL=OFF'
! 'CLA=ON', or 'CLA=OFF'
!
! By choosing the ON form for an option, the user
! can override the default setting of that option.
! A subsequent call to HSTOPI with the OFF form
! for an option returns the option to the default
! setting. All defaults are listed below.
!
! PARAM1 Integer variable used to set character height of
! class labels when 'CLA=ON'; 1 = small, 2 = medium
! 3 = large; default is 2 when 'CLA=OFF'.
!
! Not used when 'COL=ON', or 'COL=OFF'.
!
! PARAM2 Integer variable used to set orientation of class
! labels, from 0 (horizontal) to 90 (vertical) degrees
! when 'CLA=ON'; default is 0 degrees when 'CLA=OFF'.
!
! Not used when 'COL=ON', or 'COL=OFF'.
!
! ICOL Integer array containing values defining color
! indices 1-8, for use with 'COL=ON'.
!
! The eight components of the plot for which color
! indicies can be set are:
!
! ICOL(1) = color index used for shading rectangles
! ICOL(2) = color index used for shading second set
! of rectangles (comparing two datasets
! when IFLAG=3).
! ICOL(3) = color index used for rectangle outlines
! ICOL(4) = color index used for drawing axes
! ICOL(5) = color index used for drawing median line
! ICOL(6) = color index used for text ouput (labels)
! ICOL(7) = color index used for title
! ICOL(8) = color index used for drawing perimeter
!
! The default color index is 1 for all (when 'COL=OFF').
!
! ICOL is not used when 'CLA=ON', or 'CLA=OFF'.
!
! LCOL Integer variable specifying length of array ICOL.
! LCOL must be set to 8.
!
! LCOL is not used when 'CLA=ON', or 'CLA=OFF'.
!
!-----------------------------------------------------------------------
!
! SUBROUTINE NG_HSTOPR( ROPT, ARRAY, LARR )
!
! Routine to specify various REAL arrays to be used by the HISTGR
! package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: ROPT
! INTEGER, INTENT(IN) :: LARR
! REAL, INTENT(IN) :: ARRAY(LARR)
!
! ROPT A character string specifying which
! option is to be set. Valid options are:
!
! 'WIN=ON', or 'WIN=OFF'
! 'SPA=ON', or 'SPA=OFF'
! 'MVA=ON', or 'MVA=OFF'
!
! WIN defines the portion of the frame which will
! receive the histogram. SPA determines the spacing
! between histogram bars.
!
! ARRAY A real array of length LARR.
!
! LARR Dimension of ARRAY.
!
!---------------------------------------
!
! The following arrays may be defined by this routine:
!
! Windowing:
!
! ROPT is 'WIN=ON'
! LARR = 4
! ARRAY(1) = XMIN
! ARRAY(2) = XMAX
! ARRAY(3) = YMIN
! ARRAY(4) = YMAX
!
! Assumptions: These coordinates define a rectangular
! region of the total frame where the current histogram
! is to be plotted. The range of allowed values is:
!
! 0. <= XMIM < XMAX <= 1.
! 0. <= YMIM < YMAX <= 1.
!
! For example, XMIN=0., XMAX=0.5, YMIN=0.5, and YMAX=1.0
! would specify the upper left quadrant of the frame.
!
! If 'WIN=OFF', the default window for the histogram
! will be the entire frame.
!
! EXAMPLE: REAL WINDOW(4)
! DATA WINDOW /.3,.7,.3,.7/
! CALL HSTOPR('WIN=ON',WINDOW,4)
!
!-------------------
!
! Spacing:
!
! ROPT is 'SPA=ON'
! LARR = 2
! ARRAY(1) = SPAC
! ARRAY(2) = OVERLP
!
! SPAC Real value used to set spacing of histogram bars; valid
! values are 0.0 (no spacing) to 4.0 (maximum spacing).
! Default spacing is SPAC = 2.0. If 'SPA=OFF', the result
! is the same as if SPAC = 0.0, and the value supplied in
! ARRAY(1) is ignored by HISTGR. Lines will be drawn
! around the histogram bars when 'SPA=OFF' by default.
! These may not be visible if 'SHA=ON' and the first
! color index is set to white in the color table; it is
! a good idea to set color index 1 to gray if 'SPA=OFF',
! and 'SHA=ON' (for terminals without color capabilty, this
! does not apply; see notes on 'SHA' above). If IFLAG = 3,
! there is a minimum amount of spacing supplied, even if
! SPAC = 0.0, to allow room for the histogram bars of the
! second dataset.
!
! OVERLP Real value used to set overlap of adjacent histogram
! bars when comparing two datasets in one histogram;
! valid values are -4.0 (maximum overlap) to 4.0 (little
! or no overlap). OVERLP applies only when IFLAG = 3.
! Default overlap is OVERLP = -1.0. If 'SPA=OFF',
! OVERLP is ignored by HISTGR. If no overlap is desired,
! set OVERLP to 4.0, and SPAC to 3.0 or greater.
!
! EXAMPLE: REAL ARRAY(2)
! IFLAG = 3
! ARRAY(1) = 2.0
! ARRAY(2) = -1.5
! CALL HSTOPR('SPA=ON',ARRAY,2)
!
! The above example would cause two sets of histograms
! to have overlapping bars for comparison purposes.
!
!-------------------
!
! Special value detection:
!
! MVA Special value flag. If MVA=ON
! ARRAY(1) = The special value to be ignored
! when it is observed in the input data.
! ARRAY(2) = The epsilon to use in comparing the
! input data to the special value.
!
! EXAMPLE: ARRAY(1) = -9999.
! ARRAY(2) = 1.E-10
! CALL HSTOPR('MVA=ON',ARRAY,2)
!
!-----------------------------------------------------------------------
! SUMMARY OF OPTION DEFAULTS:
!-----------------------------------------------------------------------
!
! HSTOPL:
! 'HOR=OFF', histogram bars will be vertical.
! 'PER=ON', a labeled percent axis is drawn on the right side
! of the histogram (or on top if horizontal.)
! 'MID=ON', labels are placed at the midpoint of each histogram bar.
! 'SHA=ON', the histogram rectangles are shaded.
! 'DRL=OFF', lines corresponding to plotted scale values are not
! drawn through the histogram bars.
! 'MED=OFF', a line denoting the median of all points is not
! drawn on the histogram.
! 'NMV=ON', histogram bar percentages will be calculated
! with respect to (Input points - missing values.)
! 'PMV=ON', missing value counts will be written on the plot.
! NMV and PMV will only occur if HSTOPR
! option MVA=ON.
! 'PRM=OFF', a perimeter around the histogram is not drawn.
! 'FRA=ON', a frame advance will occur after the call to HISTGR. (option disabled)
! 'LIS=OFF', nothing is printed on the standard output unit.
!
! HSTOPC:
! 'TIT=OFF', no main title is drawn.
! 'FQN=OFF', a frequency axis title 'FREQUENCY' is drawn.
! 'PTI=OFF', a percent axis title 'PERCENT OCCURRENCE' is drawn
! when IFLAG = 0, or 1, 'PERCENT of MAXIMUM' when
! IFLAG = 2, or 3.
! 'LAB=OFF', class interval axis title defaults to 'CLASS INTERVALS'
! when 'MID=OFF' and 'CLASS MIDVALUES' when 'MID=ON'.
! 'FOR=OFF', class label format = '(G10.3)'.
! 'CHR=OFF', generate numeric (real or integer) class labels.
!
! HSTOPI:
! 'COL=OFF' default color indices used are current PLCI/FACI/TXCI colors
! 'CLA=ON', default values: 2 = medium, 0 = horizontal labels.
!
! HSTOPR:
! 'WIN=OFF', the histogram will be drawn within the maximum viewport
! of 0.0 to 1.0 in both the horizontal and vertical.
! 'SPA=ON', default values: spacing = 2.0, overlap = -1.0
! This will yield spacing between bars on a single
! histogram and overlap of bars in the comparison
! of two histograms.
! 'MVA=OFF', No checking of data will be done for special values.
!
!---------------------------------------------------------------------
! Parameter(Type) Set by Brief description
!---------------------------------------------------------------------
! FOR (Character) HSTOPC FORmat for class labels
! Default: '(G10.3)'
!
! TIT (Character) HSTOPC A main TITle
! Default: No title
!
! LAB (Character) HSTOPC Class interval axis LABel
! Default: 'CLASS INTERVALS' ('MID=OFF')
! 'CLASS MIDVALUES' ('MID=ON')
!
! FQN (Character) HSTOPC FreQueNcy axis label
! Default: 'FREQUENCY'
!
! PTI (Character) HSTOPC Percent axis label
! Default: 'PERCENT OCCURRENCE' (IFLAG=0/1)
! 'PERCENT of MAXIMUM' (IFLAG=2/3)
!
! CHR (Character) HSTOPC Class interval label string
! Default: Internal numeric labels
!
! COL (Integer) HSTOPI 8 COLorable graphic components
! Default: none
!
! CLA (Integer) HSTOPI Size of CLAss labels
! Default: Medium size characters
! Orientation of class labels
! Default: Horizontal labels
!
! HOR (Logical) HSTOPL Direction of histogram bars
! Default: Vertical
!
! PER (Logical) HSTOPL PERcentage axis opposite the frequency axis
! Default: The axis is drawn
!
! MID (Logical) HSTOPL Location of class interval labels
! Default: Placed at interval midpoints
!
! SHA (Logical) HSTOPL SHAding of histogram bars
! Default: Bars are shaded
!
! DRL (Logical) HSTOPL Grid lines through bars
! Default: No lines are drawn
!
! MED (Logical) HSTOPL A line drawn at data MEDian
! Default: No line is drawn
!
! PRM (Logical) HSTOPL A PeRiMeter around the histogram
! Default: No perimeter is drawn
!
! FRA (Logical) HSTOPL Advance the FRAme (*** dsiabled by CNCARG)
! Default: The frame is advanced (no function in CNCARG)
!
! NMV (Logical) HSTOPL Normalize minus missing values
! Default: Minus missing values
!
! PMV (Logical) HSTOPL Print missing value count
! Default: Print
!
! LIS (Logical) HSTOPL LISt parameter values on output
! Default: No printed list
!
! DEF (Logical) HSTOPL Reset all parameters to DEFaults
!
! WIN (Real) HSTOPR Region of frame to put histogram
! Default: The entire frame
!
! SPA (Real) HSTOPR SPAcing between histogram bars
! Default: Spacing = 2.0
! Dual histogram overlap
! Default: Overlap = -1.0
!
! MVA (Real) HSTOPR Activate special value checking
! Default: Not check
!=======================================================================
! Refer "NCAR menu" for interfacing HISTOGRAM in detail
!=======================================================================