!=====================================================================
! NGMU: Miscutil, Miscellaneous Utilities
!=====================================================================
!
! A. Color Conversion
!
! B. Graphics Table, X-Y/Map Background, Curve, Fill, Markers, and, ...
!
! C. 2-D and 3-D Coordinates transformations
!
! D. Bivar, Bezier, smoother, and cubic spline Interpolations
!
! E. Pack/Unpack Bits
!
! F. Get points on the globe surface
!
! G. Encd, Encode Real Value to Charcater String
!
! H. Machine Constants
!
!---------------------------------------------------------------------
!
! A. Color Conversion
!
! SUBROUTINE NG_HLSRGB - Convert HLS to RGB
! SUBROUTINE NG_RGBHLS - Convert RGB to HLS
!
! SUBROUTINE NG_HSVRGB - Convert HSV to RGB
! SUBROUTINE NG_RGBHSV - Convert RGB to HSV
!
! SUBROUTINE NG_YIQRGB - Convert YIQ to RGB
! SUBROUTINE NG_RGBYIQ - Convert RGB to YIQ
!
! HLS - Hue, Lightness, Saturation
! HSV - Hue, Saturation, Value
! RGB - Red, Green, Blue
! YIQ - Luminance, Inphase, Quadrature
!
!---------------------------------------
!
! B. Graphics Table, X-Y/Map Background, Curve, Fill, Markers, and, ...
!
! SUBROUTINE NG_TABLE - Draw a table with text
!
! SUBROUTINE NG_XYBACK - Draw a XY-Grid background
! SUBROUTINE NG_MPBACK - Draw a map background
! SUBROUTINE NG_EZLBAR - Draw a label bar
!
! SUBROUTINE NG_DASH - Draw a labeled curve using DASHPACK in a single call
! SUBROUTINE NG_EZDASH - Draw a labeled curve using NCL predefined dash patterns
! SUBROUTINE NG_LABC - Draw a simple labeled curve
!
! SUBROUTINE NG_FILL - Fill an area using SOFTFILL in a single call
! SUBROUTINE NG_EZFILL - Fill an area using NCL predefined fill patterns
! SUBROUTINE NG_FILLCC - Fill any polygon formed by two curves
! SUBROUTINE NG_FILLCY - Fill any polygon formed by a y(x) curve and y-ref line
! SUBROUTINE NG_FILLCX - Fill any polygon formed by a x(y) curve and x-ref line
!
! SUBROUTINE NG_MARKER - Draw a NCL/UNIPLT/NG predefined symbols
! SUBROUTINE NG_DOTS - Draw circles/dots
! SUBROUTINE NG_POINTS - Draw GKS markers
! SUBROUTINE NG_POINT - Draw a point
! SUBROUTINE NG_WSYM - Draw a Weather Symbol
! SUBROUTINE NG_LOGO - Draw a NCAR Logo
! SUBROUTINE NG_SYMB - Draw a UNIPLT predefined symbols
! SUBROUTINE NG_PIE - Draw a pie-chart symbol
!
! SUBROUTINE NG_BOX - Draw box
! SUBROUTINE NG_BAR - Draw bar
! SUBROUTINE NG_POLY - Draw polygon
! SUBROUTINE NG_CIRCL - Draw circle
! SUBROUTINE NG_ELIPS - Draw ellipse
! SUBROUTINE NG_GRID - Draw rectangle with grids
! SUBROUTINE NG_AROHD - Draw arrowhead
! SUBROUTINE NG_SHADE - Shade two-line-polygon
!
!---------------------------------------
!
! C. 2-D and 3-D Coordinates transformations
!
! SUBROUTINE NG_D2TINI - initialize matrix
! SUBROUTINE NG_D2TSET - set matrix
! SUBROUTINE NG_D2TGET - get matrix
! SUBROUTINE NG_D2TMAP - coordinate transformation
!
! SUBROUTINE NG_D2TTR - Translation
! SUBROUTINE NG_D2TRO - Rotation
! SUBROUTINE NG_D2TRO2 - Rotate about a point
! SUBROUTINE NG_D2TSC - Scaling
! SUBROUTINE NG_D2TSC2 - Scaling about a point
! SUBROUTINE NG_D2TRF - Reflecation
!
! !-----------------
!
! SUBROUTINE NG_D3TINI - initialize matrix
! SUBROUTINE NG_D3TSET - set matrix
! SUBROUTINE NG_D3TGET - get matrix
! SUBROUTINE NG_D3TMAP - coordinate transformation
!
! SUBROUTINE NG_D3TTR - Translation
! SUBROUTINE NG_D3TRO - Rotation
! SUBROUTINE NG_D3TRO2 - Rotate about a point
! SUBROUTINE NG_D3TSC - Scaling
! SUBROUTINE NG_D3TSC2 - Scaling about a point
! SUBROUTINE NG_D3TPD - Perpective distance
!
!---------------------------------------
!
! D. Bivar, Bezier, smoother, and cubic spline Interpolations
!
! SUBROUTINE NG_IDRSET()
! SUBROUTINE NG_IDSETI( PNAM, IVAL )
! SUBROUTINE NG_IDSETR( PNAM, RVAL )
! SUBROUTINE NG_IDGETI( PNAM, IVAL )
! SUBROUTINE NG_IDGETR( PNAM, RVAL )
!
! SUBROUTINE NG_IDSFFT( MD, NDP, XD, YD, ZD, NXI, NYI, NZI, XI, YI, ZI, IWK, WK )
! SUBROUTINE NG_IDBVIP( MD, NDP, XD, YD, ZD, NIP, XI, YI, ZI, IWK, WK )
! SUBROUTINE NG_IDPLTR( NDAT, XDAT, YDAT, IWRK )
!
! ---------------
!
! SUBROUTINE NG_BCRSET()
! SUBROUTINE NG_BCSETI( PA, IVAL )
! SUBROUTINE NG_BCSETR( PA, RVAL )
! SUBROUTINE NG_BCGETI( PA, IVAL )
! SUBROUTINE NG_BCGETR( PA, RVAL )
!
! SUBROUTINE NG_BCCURV( BXI, BYI, NO, XO, YO, NPTS )
!
! SUBROUTINE NG_BCFCRV( BXI, BYI, NO, XO, YO )
!
! ---------------
!
! SUBROUTINE NG_MSKRV1( N, X, Y, SLP1, SLPN, XP, YP, TEMP, S, SIGMA, ISLPSW )
! SUBROUTINE NG_MSKRV2( T, XS, YS, N, X, Y, XP, YP, S, SIGMA, ICS, SLP )
! SUBROUTINE NG_MSBSF1( M, N, XMIN, XMAX, YMIN, YMAX, Z, IZ, ZP, TEMP, SIGMA)
! SUBROUTINE NG_MSBSF2( DXMIN, DXMAX, MD, DYMIN, DYMAX, ND, DZ, IDZ, M, N, &
! XMIN, XMAX, YMIN, YMAX, Z, IZ, ZP, WORK, SIGMA )
! SUBROUTINE NG_MSSRF1( M, N, X, Y, Z, IZ, ZX1, ZXM, ZY1, ZYN, ZXY11, ZXYM1, &
! ZXY1N, ZXYMN, ISLPSW, ZP, TEMP, SIGMA, IERR )
! FUNCTION NG_MSSRF2( XX, YY, M, N, X, Y, Z, IZ, ZP, SIGMA )
!
! ---------------
!
! followings routines added by chiangtp
!
! SUBROUTINE NG_LENCSP( C, DC, T, NDIM, NC, ID )
!
! SUBROUTINE NG_OPNCSP( C, DC, T, NDIM, NC, ID )
! SUBROUTINE NG_CLDCSP( C, DC, T, NDIM, NC )
!
! SUBROUTINE NG_CSPDIF( C, DC, T, CC, DCC, TT, NDIM, NC )
!
!---------------------------------------
!
! E. Pack/Unpack Bits
!
! SUBROUTINE NG_SBYTES( NPACK, ISAM, IBIT, NBITS, NSKIP, ITER )
! SUBROUTINE NG_GBYTES( NPACK, ISAM, IBIT, NBITS, NSKIP, ITER )
!
!---------------------------------------
!
! F. Get points on the globe surface
!
! SUBROUTINE NG_GCOG( CLAT, CLON, CRAD, ALAT, ALON, NPTS )
! SUBROUTINE NG_GSOG( SLAT, SLON, SRAD, ALAT, ALON )
!
! SUBROUTINE NG_RITD( IAXS, ANGL, UCRD, VCRD, WCRD )
!
!---------------------------------------
!
! G. Encd, Encode Real Value to Charcater String
!
! SUBROUTINE NG_ENCD( VALU, ASH, IOUT, NC, IOFFD )
!
!---------------------------------------
!
! H. Machine Constants
!
! FUNCTION NG_I1MACH - Default INTEGER
!
! FUNCTION NG_R1MACH - Default REAL
!
! FUNCTION NG_D1MACH - REAL with KIND=SELECTED_REAL_KIND(p=15)
!
!=====================================================================
! A. Color Conversion Utilities
!=====================================================================
!
! SUBROUTINE NG_HLSRGB - Convert HLS to RGB
! SUBROUTINE NG_RGBHLS - Convert RGB to HLS
!
! SUBROUTINE NG_HSVRGB - Convert HSV to RGB
! SUBROUTINE NG_RGBHSV - Convert RGB to HSV
!
! SUBROUTINE NG_YIQRGB - Convert YIQ to RGB
! SUBROUTINE NG_RGBYIQ - Convert RGB to YIQ
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_HLSRGB( H, L, S, R, G, B )
!
! REAL, INTENT(IN ) :: H, L, S
! REAL, INTENT( OUT) :: R, G, B
!
! This subroutine converts a color specification given in the Hue,
! Lightness, and Saturation color space to Red, Green, and Blue
! intensity values in the RGB color space.
!
! Variables:
!
! H - (INPUT, REAL) A real variable in the range
! [0.,360.) which represents the hue of the input color
! in HLS color space. H=0. corresponds to blue.
!
! L - (INPUT, REAL) A real variable in the range
! [0.,100.] which represents the lightness value of the
! input color in HLS color space. Lightness is a measure
! of the quantity of light--a lightness of 0. is black,
! and a lightness of 100. gives white. The pure hues occur
! at lightness value 50.
!
! S - (INPUT, REAL) A real variable in the range
! [0.,100.] which represents the saturation value of the
! input color in HLS color space. Saturation is a measure
! of how much white light is mixed with the color. Colors
! having a satuartion value of 0. represent greys
! with a grey intensity value equal to the lightness L.
! Colors with a saturation value of 100. are
! fully saturated colors. The hue is undefined
! when S=0. The fully saturated pure hues occur when S=100.
! and L=50.
!
! R - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the red intensity component
! of the output color in RGB color space.
!
! G - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the green intensity component
! of the output color in RGB color space.
!
! B - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the blue intensity component
! of the output color in RGB color space.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_RGBHLS( R, G, B, H, L, S )
!
! REAL, INTENT(IN ) :: R, G, B
! REAL, INTENT( OUT) :: H, L, S
!
! This subroutine converts a color specification given as Red, Green,
! and Blue intensity values to a color specification given as Hue,
! Lightness, and Saturation values.
!
! Variables:
!
! R - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the red intensity component
! of the input point in RGB color space.
!
! G - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the green intensity component
! of the input point in RGB color space.
!
! B - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the blue intensity component
! of the input point in RGB color space.
!
! H - (OUTPUT, REAL) A real variable in the range
! [0.,360.) which represents the hue of the input point
! in HLS color space. A value of (0.,0.,B) in the input
! space will result in a hue of 0. in the output space.
!
! L - (OUTPUT, REAL) A real variable in the range
! [0.,100.] which represents the lightness value of the
! input point in HLS color space. Lightness is a measure
! of the quantity of light--a lightness of 0. is black,
! and a lightness of 100. gives white. The pure hues occur
! at lightness value 50. The lightness should be thought
! of as a percentage.
!
! S - (OUTPUT, REAL) A real variable in the range
! [0.,100.] which represents the saturation value of the
! input point in HLS color space. Saturation is a measure
! of how much white light is mixed with the color. Saturation
! values of 0. represent greys (with a grey value equal to
! the lightness value L). Saturation values of 100. are fully
! saturated colors. The hue is undefined when S=0. The
! fully saturated pure hues occur when S=100. and L=50.
! The saturation value should be thought of as a percentage.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_HSVRGB( H, S, V, R, G, B )
!
! REAL, INTENT(IN ) :: H, S, V
! REAL, INTENT( OUT) :: R, G, B
!
! This subroutine converts a color specification given in the Hue,
! Saturation, and Value color space to Red, Green, and Blue
! intensity values in the RGB color space.
!
! Variables:
!
! H - (INPUT, REAL) A real variable in the range
! [0.,360.) which represents the hue of the input color
! in HSV color space.
!
! S - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the saturation value of the
! input color in HSV color space. Saturation is a measure
! of how much white light is mixed with the color. Saturation
! values of 0. represent greys (with a grey value equal to
! the value V). Saturation values of 1. are fully
! saturated colors. The hue is undefined when S=0. The
! fully saturated pure hues occur when S=1. and V=1.
!
! V - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the value of the
! input color in HSV color space.
!
! R - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the red intensity component
! of the output color in RGB color space.
!
! G - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the green intensity component
! of the output color in RGB color space.
!
! B - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the blue intensity component
! of the output color in RGB color space.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_RGBHSV( R, G, B, H, S, V )
!
! REAL, INTENT(IN ) :: R, G, B
! REAL, INTENT( OUT) :: H, S, V
!
! This subroutine converts a color specification given as Red, Green,
! and Blue intensity values to a color specification in the Hue,
! Saturation, Value color space.
!
! Variables:
!
! R - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the red intensity component
! of the input point in RGB color space.
!
! G - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the green intensity component
! of the input point in RGB color space.
!
! B - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the blue intensity component
! of the input point in RGB color space.
!
! H - (OUTPUT, REAL) A real variable in the range
! [0.,360.) which represents the hue of the input point
! in HSV color space. A value of (R,0.,0.) in the input
! space will result in a hue of 0. in the output space.
!
! S - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the saturation value of the
! input point in HSV color space. Saturation is a measure
! of how much white light is mixed with the color. Saturation
! values of 0. represent greys (with a grey value equal to
! V). Saturation values of 1. are fully saturated colors.
! The hue is technically undefined when S=0; the code leaves
! H at its previous value when S=0. (0. initially). The
! fully saturated pure hues occur when S=1. and V=1.
!
! V - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the value in HSV space.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_YIQRGB( Y, I, Q, R, G, B )
!
! REAL, INTENT(IN ) :: Y, I, Q
! REAL, INTENT( OUT) :: R, G, B
!
! This subroutine converts a color specification given in the YIQ
! coordinate system to the equivalent color specification in the
! Red, Green, Blue coordinate system.
!
! Variables:
!
! Y - (INPUT, REAL) A real variable in the range
! [0.,1.] . Y is the color component of a television
! signal which is shown on black-and-white televisions;
! Y minimizes the effect of two colors appearing different
! to the human eye but mapping to similar monochrome
! intensities.
!
! I - (INPUT, REAL) A real variable in the range
! [-.6,.6] .
!
! Q - (INPUT, REAL) A real variable in the range
! [-.52,.52].
!
! R - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the red intensity component
! of the output color in RGB color space.
!
! G - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the green intensity component
! of the output color in RGB color space.
!
! B - (OUTPUT, REAL) A real variable in the range
! [0.,1.] which represents the blue intensity component
! of the output color in RGB color space.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_RGBYIQ( R, G, B, Y, I, Q )
!
! REAL, INTENT(IN ) :: R, G, B
! REAL, INTENT( OUT) :: Y, I, Q
!
! This subroutine converts a color specification given as Red, Green,
! and Blue intensity values to a color specification in the YIQ color
! space.
!
! Variables:
!
! R - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the red intensity component
! of the input point in RGB color space.
!
! G - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the green intensity component
! of the input point in RGB color space.
!
! B - (INPUT, REAL) A real variable in the range
! [0.,1.] which represents the blue intensity component
! of the input point in RGB color space.
!
! Y - (OUTPUT, REAL) A real variable in the range
! [0.,1.] . Y is the color component of a television
! signal which is shown on black-and-white televisions;
! Y minimizes the effect of two colors appearing different
! to the human eye but mapping to similar monochrome
! intensities.
!
! I - (OUTPUT, REAL) A real variable in the range
! [-.6,.6] . I attains its maximum when the input triple
! is (1.,0.,0.); I attains its minimum when the input triple
! is (0.,1.,1.) .
!
! Q - (OUTPUT, REAL) A real variable in the range
! [-.52,.52]. Q attains its maximum when the input triple
! is (1.,0.,1.); Q attains its minimum when the input triple
! is (0.,1.,0.).
!
!=====================================================================
! B. Graphics Table, X-Y/Map Background, Curve, Fill, Markers, and, ...
!=====================================================================
!
! SUBROUTINE NG_TABLE - Draw a table with text
!
! SUBROUTINE NG_XYBACK - Draw a XY-Grid background
! SUBROUTINE NG_MPBACK - Draw a map background
!
! SUBROUTINE NG_DASH - Draw a labeled curve using DASHPACK in a single call
! SUBROUTINE NG_EZDASH - Draw a labeled curve using NCL predefined dash patterns
! SUBROUTINE NG_LABC - Draw a simple labeled curve
!
! SUBROUTINE NG_FILL - Fill an area using SOFTFILL in a single call
! SUBROUTINE NG_EZFILL - Fill an area using NCL predefined fill patterns
! SUBROUTINE NG_FILLCC - Fill any polygon formed by two curves
! SUBROUTINE NG_FILLCY - Fill any polygon formed by a y(x) curve and y-ref line
! SUBROUTINE NG_FILLCX - Fill any polygon formed by a x(y) curve and x-ref line
!
! SUBROUTINE NG_MARKER - Draw a NCL/UNIPLT/NG predefined symbol
! SUBROUTINE NG_DOTS - Draw circles/dots
! SUBROUTINE NG_POINTS - Draw GKS markers
! SUBROUTINE NG_POINT - Draw a point
! SUBROUTINE NG_WSYM - Draw a Weather Symbol
! SUBROUTINE NG_LOGO - Draw a NCAR Logo
! SUBROUTINE NG_SYMB - Draw a UNIPLT predefined symbol
! SUBROUTINE NG_PIE - Draw a pie-chart symbol
!
! SUBROUTINE NG_BOX - Draw box
! SUBROUTINE NG_BAR - Draw bar
! SUBROUTINE NG_POLY - Draw polygon
! SUBROUTINE NG_CIRCL - Draw circle
! SUBROUTINE NG_ELIPS - Draw ellipse
! SUBROUTINE NG_GRID - Draw rectangle with grids
! SUBROUTINE NG_AROHD - Draw arrowhead
! SUBROUTINE NG_SHADE - Shade two-line-polygon
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_table(vp, nrow, ncol, text, txbgc, txfgc, txht, txang, txjust )
!
! REAL, INTENT(IN) :: vp(4)
! INTEGER, INTENT(IN) :: nrow, ncol
! CHARACTER(*), INTENT(IN) :: text(nrow,ncol)
! INTEGER, INTENT(IN), OPTIONAL :: txbgc (nrow,ncol)
! INTEGER, INTENT(IN), OPTIONAL :: txfgc (nrow,ncol)
! REAL, INTENT(IN), OPTIONAL :: txht (nrow,ncol)
! REAL, INTENT(IN), OPTIONAL :: txang (nrow,ncol)
! INTEGER, INTENT(IN), OPTIONAL :: txjust(nrow,ncol)
!
! Routine to draw a table with text.
!
! Variables:
!
! vp - viewport of table, vp=(/xmin,xmax,Ymin,ymax/), the beginning
! and ending X and Y locations of the table in NDC coordinates.
!
! nrow - the number of rows for the table
!
! ncol - the number of columns for the table
!
! text - array of strings of dimensions (nrow,ncol), they will be put
! in the center of each cell of the box (by default), starting
! from top-to-bottom, left-to-right.
!
! --------
! optional
! --------
!
! txbgc - Color index of the color used for fill background
! Default is "not fill", if argument not present
!
! txfgc - Color index for the color of text
! Default is "current font color", if argument not present
!
! txht - Height of text in NDC coordinates.
! Default is "0.04", if argument not present
!
! txang - the rotation angle of the text around the justification point.
! The angle is counterclockwise.
! Default is "0.0", if argument not present
!
! txjust - flag of the justification point to each strings
! Default is "5 (CenterCenter)", if argument not present
!
! TopLeft=7 TopCenter=8 TopRight=9
! CenterLeft=4 CenterCenter=5 CenterRight=6
! BottomLeft=1 BottomCenter=2 BottomRight=3
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_XYBACK( tk, dx, dy, sc,&
!
! ib, ib_npos, ib_xloc, ib_clab, ib_sc, ib_ic, ib_co, ib_dg,&
! il, il_npos, il_yloc, il_clab, il_sc, il_ic, il_co, il_dg,&
! it, it_npos, it_xloc, it_clab, it_sc, it_ic, it_co, it_dg,&
! ir, ir_npos, ir_yloc, ir_clab, ir_sc, ir_ic, ir_co, ir_dg,&
!
! cb, cb_sc, cb_ic, cb_ipos, cb_yoff,&
! cl, cl_sc, cl_ic, cl_ipos, cl_xoff,&
! ct, ct_sc, ct_ic, ct_ipos, ct_yoff,&
! cr, cr_sc, cr_ic, cr_ipos, cr_xoff,&
!
! ctl, ctl_sc, ctl_ic, ctl_xoff, ctl_yoff,&
! ctr, ctr_sc, ctr_ic, ctr_xoff, ctr_yoff,&
! ctc, ctc_sc, ctc_ic, ctc_xoff, ctc_yoff,&
! ctt, ctt_sc, ctt_ic, ctt_xoff, ctt_yoff,&
!
! GB_Encoding, GB_Font, GB_Quality, GB_DotLWSC,&
!
! xy_vp, xy_wn, plt_xl, plt_xr, plt_yb, plt_yt,&
! AGUTOL, AGCHNL, AGCHAX )
!
! USE CNCARG, except_this=>NG_XYBACK
! IMPLICIT NONE
!
! REAL, OPTIONAL, INTENT(IN ) :: tk, dx(2), dy(2), sc
!
! INTEGER , OPTIONAL, INTENT(IN ) :: ib , il , it , ir
! INTEGER , OPTIONAL, INTENT(IN ) :: ib_npos , il_npos , it_npos , ir_npos
! REAL, OPTIONAL, INTENT(IN ) :: ib_xloc(*), il_yloc(*), it_xloc(*), ir_yloc(*)
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: ib_clab(*), il_clab(*), it_clab(*), ir_clab(*)
! REAL, OPTIONAL, INTENT(IN ) :: ib_sc , il_sc , it_sc , ir_sc
! INTEGER, OPTIONAL, INTENT(IN ) :: ib_ic , il_ic , it_ic , ir_ic
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: ib_co , il_co , it_co , ir_co
! REAL, OPTIONAL, INTENT(IN ) :: ib_dg , il_dg , it_dg , ir_dg
!
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: cb , cl , ct , cr
! REAL, OPTIONAL, INTENT(IN ) :: cb_sc , cl_sc , ct_sc , cr_sc
! INTEGER, OPTIONAL, INTENT(IN ) :: cb_ic , cl_ic , ct_ic , cr_ic
! INTEGER, OPTIONAL, INTENT(IN ) :: cb_ipos , cl_ipos , ct_ipos , cr_ipos
! REAL, OPTIONAL, INTENT(IN ) :: cb_yoff , cl_xoff , ct_yoff , cr_xoff
!
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: ctl , ctr , ctc , ctt
! REAL, OPTIONAL, INTENT(IN ) :: ctl_sc , ctr_sc , ctc_sc , ctt_sc
! INTEGER, OPTIONAL, INTENT(IN ) :: ctl_ic , ctr_ic , ctc_ic , ctt_ic
! REAL, OPTIONAL, INTENT(IN ) :: ctl_xoff, ctr_xoff, ctc_xoff, ctt_xoff
! REAL, OPTIONAL, INTENT(IN ) :: ctl_yoff, ctr_yoff, ctc_yoff, ctt_yoff
!
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: GB_Encoding
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: GB_Font
! INTEGER, OPTIONAL, INTENT(IN ) :: GB_Quality
! REAL, OPTIONAL, INTENT(IN ) :: GB_DotLWSC
!
! REAL, OPTIONAL, INTENT( OUT) :: xy_vp(4), xy_wn(4)
!
! REAL, OPTIONAL, INTENT( OUT) :: plt_xl, plt_xr, plt_yb, plt_yt
!
! OPTIONAL :: AGUTOL, AGCHNL, AGCHAX
! EXTERNAL :: AGUTOL, AGCHNL, AGCHAX
!
! Routine to draw a simple x-y background, it may be useful in NCARG
! 2-D Contour/Streamline/Vector/X-Y plots. The linear/log nature of the
! current graph, the position of the grid and the X/Y min/max values
! of the mapped window are decided by the last "NG_SET" call.
!
! Variables:
!
! tk - Size (scale) and direction (sign) of the major/minor tickmarks
!
! The normal (for scaling factor ABS(tk)=1.0) sizes are 0.015 and
! 0.009, a fraction of the smaller dimension of the grid window,
! for major and minor tickmarks.
!
! Sign (tk>0 or tk<0) determine the direction (inward or outward)
! of tickmarks (no tickmarks for tk=0.0)
!
! Default value is -1.0 (outward), if argument not present
!
! dx - dx(1) and dx(2), measured in user coordinates, are spacings
! of X-axis major and minor tickmarks separately.
!
! Nice values will be decided by NG_XYBACK, if argument not
! present, present with (dx(1)==0.0 .OR. dx(2)==0.0), or,
! X-axis is logarithmic (whether dx is presentt or not)
!
! dy - dy(1) and dy(2), measured in user coordinates, are spacings
! of Y-axis major and minor tickmarks separately.
!
! Nice values will be decided by NG_XYBACK, if argument not
! present, present with (dy(1)==0.0 .OR. dy(2)==0.0), or,
! Y-axis is logarithmic (whether dy is presentt or not)
!
! sc - Global scaling factor of the size of all labels
!
! The normal (for scaling factor sc=1.0) sizes are 0.020, 0.024,
! 0.0288, and 0.03456, a fraction of the smaller dimension of
! the grid window, for axis-Numeric, axis-Title, plot-(L,C,R),
! and plot-Title labels
!
! Default value is 1.0, if argument not present
!
! ib, il, it, ir - Drawing flags for bottom/left/top/right axes
!
! = 0, nothing to draw
! = 1, draw axis-line only
! = 2, sraw axis-line and tick-marks
! = 3, draw axis-line, tick-marks, and axis numeric labels
! = 4, draw axis-line, customized numeric labels (with major tickmarks)
!
! Default values are 3/3/2/2 for bottom/left/top/right axes,
! if argument(s) not present.
!
!---------
! Customized numeric labels (for ib/il/it/ir = 4)
!---------
!
! ib_npos, il_npos, it_npos, ir_npos - Number of labels (with major tickmarks)
!
! ib_xloc, il_yloc, it_xloc, ir_yloc - Location (in user coordinates) array of label
!
! ib_clab, il_clab, it_clab, ir_clab - String array of label
!
!----
!
! ib_sc, il_sc, it_sc, ir_sc - Label size Scaling factor
!
! The normal (for scaling factor 1.0) sizes are 0.020*sc,
! a fraction of the smaller dimension of the grid window
!
! Default value is 1.0, if argument not present
!
! ib_ic, il_ic, it_ic, ir_ic - Label color index
!
! Default is current setting, if argument not present
!
! ib_co, il_co, it_co, ir_co - Label justification (orientation)
!
! One of following nine justification values:
!
! 'TopLeft' 'TopCenter' 'TopRight'
! 'CenterLeft' 'CenterCenter' 'CenterRight'
! 'BottomLeft' 'BottomCenter' 'BottomRight'
!
! If none of above or argument not present, default is
!
! 'TopCenter', for bottom axis
! 'BottomCenter', for top axis
! 'CenterRight' , for left axis
! 'CenterLeft' , for right axis
!
! ib_dg il_dg, it_dg, ir_dg - Label angle (in degree, contourclockwise)
!
! Default is zseo, if argument(s) not present.
!
!---------
! Axis labels
!---------
!
! cb, cl, ct, cr - Bottom/Left/Top/Right axis title labels
!
! Default is not draw (blank), if argument(s) not present.
!
! cb_sc, cl_sc, ct_sc, cr_sc - Scaling factor of label size
!
! The normal (for scaling factor 1.0) sizes are 0.024*sc,
! a fraction of the smaller dimension of the grid window
!
! Default value is 1.0, if argument not present
!
! cb_ic, cl_ic, ct_ic, cr_ic - Color indices for cb/cl/ct/cr labels
!
! Default is current setting, if argument not present
!
! cb_ipos, cl_ipos, ct_ipos, cr_ipos - label position justification
!
! = +1, Top for cl/cr, Right for cb/ct
! = 0, Center for all
! = -1, Bottom for cl/cr, Left for cb/ct
!
! Default value is 0.0, if argument not present
!
! cb_yoff, cl_xoff, ct_yoff, cr_xoff - X/Y offset, measured relative to label size
!
! Default value is 0.0, if argument not present
!
!---------
! Plot labels
!---------
! Title-Label
!
! Left Center-Label Right
! +--------------------------------+
! | |
! | |
! | |
! | 2-D X-Y Plot |
! | |
! | |
! | |
! +--------------------------------+
!
! ctl, ctr, ctc, ctt - Left-, right-, center-, and title-labels of X-Y Plot
!
! ctl_sc, ctr_sc, ctc_sc, ctt_sc - Scaling factor of label size
!
! The normal (for scaling factor 1.0) sizes are 0.0288*sc and
! 0.03456*sc, a fraction of the smaller dimension of the grid
! window, for (left,right,center) and title labels
!
! Default value is 1.0, if argument not present
!
! ctl_ic, ctr_ic, ctc_ic, ctt_ic - Color indices for ctl/ctr/ctc/ctt labels
!
! Default is current setting, if argument not present
!
! ctl_xoff, ctr_xoff, ctc_xoff, ctt_xoff - X offset, measured relative to label size
!
! Default value is 0.0, if argument not present
!
! ctl_yoff, ctr_yoff, ctc_yoff, ctt_yoff - Y offset, measured relative to label size
!
! Default value is 0.0, if argument not present
!
!---------
! Chinese
!---------
!
! GB_Encoding - Encoding scheme of string characters
!
! = 'U', for UTF-8
! = 'G', for GB2312
!
! Default value is 'U', if argument not present or invalid
!
! GB_Font - Chinese fonts
!
! = 'SV', "Song" font of type "Vector"
! = 'HV', "Hei" font of type "Vector"
! = 'FV', "FangSong" font of type "Vector"
! = 'SD', "Song" font of type "Dot"
! = 'HD', "Hei" font of type "Dot"
! = 'KD', "Kai" font of type "Dot"
! = 'FD', "FangSong" font of type "Dot"
!
! Default value is 'SV', if argument not present or invalid
!
! GB_Quality - n, quality of fonts
!
! a) for "Dot" fonts
!
! n = 1-9, use the font with dot-matrix size of
! "16*n" by "16*n"
!
! n >= 10, use the font with dot-matrix size of
! "n" by "n"
!
! Default value is 4, if argument not present or invalid
!
! b) for "Vector" fonts
!
! n = 0, "fill" polygon only
!
! otherrwise, "fill" first, and then, "outline" with
! line width scaled by factor REAL(ABS(n))/100.0
!
! i.e.,
! ! get current line with
! CALL NG_GQLWSC( a )
! ! set "outline" line width
! CALL NG_GSLWSC( a*REAL(ABS(n))/100.0 )
!
! Default value is 0 for font "HV", and, 100 for
! fonts "SV" and "FV"
!
! Note: Chinese words in character string "string" not
! supported in "VECTOR" font will be drawn using
! "DOT" font of same "Song/Hei/FangSong" type
! with default dot matrix size 64 (n=4) automatically
!
! GB_DotLWSC - Scaling factor of the size (line width) of the dots
! (this argument used for "DOT" font only)
!
! Default value is 1.0, if argument not present
!
!-----------
!
! xy_vp, xy_wn - X-Y Plot viewport and Window coordinates
!
! CALL GETSET(vl, vr, vb, vt, wl, wr, wb, wt, lg)
! xy_vp = (/vl, vr, vb, vt/); xy_wn = (/wl, wr, wb, wt/)
!
! plt_xl, plt_xr - Left and right extreme NDC coordinates of plot
!
! plt_yb, plt_yt - Bottom and top extreme NDC coordinates of plot
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MPBACK( tk, dlon, dlat, ib, il, it, ir, sc,&
! cb, cb_sc, cb_ic, cb_ipos, cb_yoff,&
! cl, cl_sc, cl_ic, cl_ipos, cl_xoff,&
! ct, ct_sc, ct_ic, ct_ipos, ct_yoff,&
! cr, cr_sc, cr_ic, cr_ipos, cr_xoff,&
! ctl, ctl_sc, ctl_ic, ctl_xoff, ctl_yoff,&
! ctr, ctr_sc, ctr_ic, ctr_xoff, ctr_yoff,&
! ctc, ctc_sc, ctc_ic, ctc_xoff, ctc_yoff,&
! ctt, ctt_sc, ctt_ic, ctt_xoff, ctt_yoff,&
! GB_Encoding, GB_Font, GB_Quality, GB_DotLWSC,&
! mp_vp, mp_wn, plt_xl, plt_xr, plt_yb, plt_yt)
!
! REAL, OPTIONAL, INTENT(IN ) :: tk, dlon(2), dlat(2)
! INTEGER, OPTIONAL, INTENT(IN ) :: ib, il, it, ir
! REAL, OPTIONAL, INTENT(IN ) :: sc
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: cb , cl , ct , cr
! REAL, OPTIONAL, INTENT(IN ) :: cb_sc , cl_sc , ct_sc , cr_sc
! INTEGER, OPTIONAL, INTENT(IN ) :: cb_ic , cl_ic , ct_ic , cr_ic
! INTEGER, OPTIONAL, INTENT(IN ) :: cb_ipos , cl_ipos , ct_ipos , cr_ipos
! REAL, OPTIONAL, INTENT(IN ) :: cb_yoff , cl_xoff , ct_yoff , cr_xoff
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: ctl, ctr, ctc, ctt
! REAL, OPTIONAL, INTENT(IN ) :: ctl_sc, ctr_sc, ctc_sc, ctt_sc
! INTEGER, OPTIONAL, INTENT(IN ) :: ctl_ic, ctr_ic, ctc_ic, ctt_ic
! REAL, OPTIONAL, INTENT(IN ) :: ctl_xoff, ctr_xoff, ctc_xoff, ctt_xoff
! REAL, OPTIONAL, INTENT(IN ) :: ctl_yoff, ctr_yoff, ctc_yoff, ctt_yoff
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: GB_Encoding
! CHARACTER(*), OPTIONAL, INTENT(IN ) :: GB_Font
! INTEGER, OPTIONAL, INTENT(IN ) :: GB_Quality
! REAL, OPTIONAL, INTENT(IN ) :: GB_DotLWSC
! REAL, OPTIONAL, INTENT( OUT) :: mp_vp(4), mp_wn(4)
! REAL, OPTIONAL, INTENT( OUT) :: plt_xl, plt_xr, plt_yb, plt_yt
!
! Routine to draw a simple map background (axes lines, major/minor
! tickmarks, and longitude/latitude labels) on a map drawn by EZMAP.
!
! Variables:
!
! tk - Size (scale) and direction (sign) of the major/minor tickmarks
!
! The normal (for scaling factor ABS(tk)=1.0) sizes are 0.015 and
! 0.0075, a fraction of the smaller dimension of the grid window,
! for major and minor tickmarks.
!
! Sign (tk>0 or tk<0) determine the direction (inward or outward)
! of tickmarks (no tickmarks for tk=0.0)
!
! Default value is -1.0 (outward), if argument not present
!
! dlon - dlon(1) and dlon(2), measured in degree, are spacings of
! Longitude-axis major and minor tickmarks separately.
!
! Nice values will be decided by NG_MPBACK, if argument not
! present, or, present with (dlon(1)==0.0 .OR. dlon(2)==0.0)
!
! dlat - dlat(1) and dlat(2), measured in degree, are spacings of
! Latitude-axis major and minor tickmarks separately.
!
! Nice values will be decided by NG_MPBACK, if argument not
! present, or, present with (dlat(1)==0.0 .OR. dlat(2)==0.0)
!
! ib, il, it, ir - Drawing flags for bottom/left/top/right axes
!
! = 0, nothing to draw
! = 1, draw axis-line only
! = 2, sraw axis-line and tick-marks
! = 3, draw axis-line, tick-marks, and longitude/latitude labels
!
! Default values are 3/3/2/2 for bottom/left/top/right axes,
! if argument(s) not present.
!
! sc - Scaling factor of the size of longitude/latitude labels
!
! The normal (for scaling factor sc=1.0) size is 0.025, a
! fraction of the smaller dimension of the grid window
!
! Default value is 1.0, if argument not present
!
! Note:
!
! For azimuthal ST, OR, LE, GN,AE, or SV projections, NG_MPBACK
! "labels the meridians" if and only if the current azimuthal
! projection is centered at one of the poles, and, a circular
! boundary is being used.
!
! -> CALL NG_MAPROJ(JPRJ, PLAT, PLON, ROTA) with PLAT=(90 or -90)
!
! -> CALL NG_MAPSTI('EL - Elliptical-Perimeter Selector', 1)
!
! -> Refer the example program "ncl_proj_azimuthal_b.f90"
!
!---------
! Axis labels
!---------
!
! cb, cl, ct, cr - Bottom/Left/Top/Right axis title labels
!
! Default is not draw (blank), if argument(s) not present.
!
! cb_sc, cl_sc, ct_sc, cr_sc - Scaling factor of label size
!
! The normal (for scaling factor 1.0) sizes are 0.028*sc,
! a fraction of the smaller dimension of the grid window
!
! Default value is 1.0, if argument not present
!
! cb_ic, cl_ic, ct_ic, cr_ic - Color indices for cb/cl/ct/cr labels
!
! Default is current setting, if argument not present
!
! cb_ipos, cl_ipos, ct_ipos, cr_ipos - label position justification
!
! = +1, Top for cl/cr, Right for cb/ct
! = 0, Center for all
! = -1, Bottom for cl/cr, Left for cb/ct
!
! Default value is 0.0, if argument not present
!
! cb_yoff, cl_xoff, ct_yoff, cr_xoff - X/Y offset, measured relative to label size
!
! Default value is 0.0, if argument not present
!
!---------
! Map labels
!---------
! Top-Label
!
! Left Center-Label Right
! +--------------------------------+
! | |
! | |
! | |
! | Map drawn by EZMAP |
! | |
! | |
! | |
! +--------------------------------+
!
! ctl, ctr, ctc, ctt - Left-, right-, center-, and top-labels of map
!
! ctl_sc, ctr_sc, ctc_sc, ctt_sc - Scaling factor of label size
!
! The normal (for scaling factor 1.0) sizes are 0.030*sc and
! 0.040*sc, a fraction of the smaller dimension of the grid
! window, for (left,right,center) and top labels
!
! Default value is 1.0, if argument not present
!
! ctl_ic, ctr_ic, ctc_ic, ctt_ic - Color indices for ctl/ctr/ctc/ctt labels
!
! Default is current setting, if argument not present
!
! ctl_xoff, ctr_xoff, ctc_xoff, ctt_xoff - X offset, measured relative to label size
!
! Default value is 0.0, if argument not present
!
! ctl_yoff, ctr_yoff, ctc_yoff, ctt_yoff - Y offset, measured relative to label size
!
! Default value is 0.0, if argument not present
!
!---------
! Chinese
!---------
!
! GB_Encoding - Encoding scheme of string characters
!
! = 'U', for UTF-8
! = 'G', for GB2312
!
! Default value is 'U', if argument not present or invalid
!
! GB_Font - Chinese fonts
!
! = 'SV', "Song" font of type "Vector"
! = 'HV', "Hei" font of type "Vector"
! = 'FV', "FangSong" font of type "Vector"
! = 'SD', "Song" font of type "Dot"
! = 'HD', "Hei" font of type "Dot"
! = 'KD', "Kai" font of type "Dot"
! = 'FD', "FangSong" font of type "Dot"
!
! Default value is 'SV', if argument not present or invalid
!
! GB_Quality - n, quality of fonts
!
! a) for "Dot" fonts
!
! n = 1-9, use the font with dot-matrix size of
! "16*n" by "16*n"
!
! n >= 10, use the font with dot-matrix size of
! "n" by "n"
!
! Default value is 4, if argument not present or invalid
!
! b) for "Vector" fonts
!
! n = 0, "fill" polygon only
!
! otherrwise, "fill" first, and then, "outline" with
! line width scaled by factor REAL(ABS(n))/100.0
!
! i.e.,
! ! get current line with
! CALL NG_GQLWSC( a )
! ! set "outline" line width
! CALL NG_GSLWSC( a*REAL(ABS(n))/100.0 )
!
! Default value is 0 for font "HV", and, 100 for
! fonts "SV" and "FV"
!
! Note: Chinese words in character string "string" not
! supported in "VECTOR" font will be drawn using
! "DOT" font of same "Song/Hei/FangSong" type
! with default dot matrix size 64 (n=4) automatically
!
! GB_DotLWSC - Scaling factor of the size (line width) of the dots
! (this argument used for "DOT" font only)
!
! Default value is 1.0, if argument not present
!
!-----------
!
! mp_vp, mp_wn - Map viewport and Window coordinates
!
! CALL GETSET(vl, vr, vb, vt, wl, wr, wb, wt, lg)
! mp_vp = (/vl, vr, vb, vt/); mp_wn = (/wl, wr, wb, wt/)
!
! plt_xl, plt_xr - Left and right extreme NDC coordinates of plot
!
! plt_yb, plt_yt - Bottom and top extreme NDC coordinates of plot
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_EZLBAR( IHOV, XLEB, XREB, YBEB, YTEB, NBOX, LFIN,&
! NLBS, LLBS, LBAB, FRAC, HTSC, TEND, FILL,&
! lbco, lbdg, lbsc )
!
! INTEGER, INTENT(IN) :: IHOV
! REAL, INTENT(IN) :: XLEB, XREB, YBEB, YTEB
! INTEGER, INTENT(IN) :: NBOX
! INTEGER, INTENT(IN) :: LFIN(ABS(NBOX))
! INTEGER, INTENT(IN) :: NLBS
! CHARACTER(*), INTENT(IN) :: LLBS(NLBS)
! INTEGER, INTENT(IN) :: LBAB
! REAL, INTENT(IN) :: FRAC, HTSC
! LOGICAL, INTENT(IN) :: TEND
! EXTERNAL :: FILL
! CHARACTER(*), INTENT(IN) :: lbco
! REAL, INTENT(IN) :: lbdg, lbsc
! OPTIONAL :: LBAB, FRAC, HTSC, TEND, FILL, lbco, lbdg, lbsc
!
! Arguments:
!
! Routine to draw a horizontal or vertical label bar to serve as a
! key for a solid-filled plot.
!
! IHOV - Orientation flag of label bar
!
! = 0, a horizontal label bar is to be drawn,
!
! otherwise, a vertical label bar is to be drawn.
!
! XLEB - the left coordniate (in NDC) of the bar.
!
! XREB - the right coordniate (in NDC) of the bar.
!
! YBEB - the bottom coordniate (in NDC) of the bar.
!
! YTEB - the top coordniate (in NDC) of the bar.
!
! NBOX - its absolute value is the number of boxes into which the bar
! is to be divided.
!
! > 0, the boxes will be outlined after being filled;
!
! < 0, the boxes will not be outlined.
! LFIN - a list of indices, each of which specifies, in some manner,
! how one of the solid-filled boxes is to be filled.
! (For example, each may be a color index.)
!
! NLBS - the number of labels in the list LLBS.
!
! If NLBS is equal to ABS(NBOX)-1, then label I applies to the
! line separating box I from box I+1.
!
! If NLBS is equal to NBOX, then label I applies to box I.
!
! If NLBS is equal to ABS(NBOX)+1, then labels 1 and NLBS apply
! to the left and right ends (if IHOV is non-zero, the bottom
! and top ends) of the whole color bar; for values of I not
! equal to 1 or NLBS, label I applies to the line separating
! box I-1 from box I.
!
!---------
!
! LLBS - a list of labels for the solid-filled boxes.
!
! LBAB - a flag specifies on which side of the bar the labels are
! to be written.
!
! = 0, the bar is to be unlabelled,
!
! = 1, the labels are to be below a horizontal bar or to the
! right of a vertical bar,
!
! = 2, the labels are to be above a horizontal bar or to the
! left of a vertical bar
!
! = 3, the labels align with the centers of each box
!
! otherwise, the bar is to be unlabelled,
!
! Default value is 0, if argument not present
!
! FRAC - the width (for horizontal bar) or height (for vertical bar)
! of each little solid-filled box, as fractions of the rectangles
! resulting from the division of the bar into ABS(NBOX) pieces.
!
! Default value is 1.0, if argument not present
!
! HTSC - scaling factor of the label size
!
! Defalut (for HTSC=1.0) maximun label sizes are 0.5 times
! the height (for horizontal bar) or the width (for vertical
! bar) of the label bar
!
! Default value is 1.0, if argument not present
!
! TEND - if set to .TRUE., drawing a labelbar with triangles at each
! end
!
! Default value is .FALSE., if argument not present
!
!---------
!
! FILL - the user defined fill routine
!
! By default, the fill routine NG_SFSGFA in the package NGSF-
! SOFTFILL will be called, with an index from LFIN as the value
! of the argument ICI. (By default, this will result in color
! fill; the value of the SOFTFILL internal parameter 'TY' may
! be changed to select some other kind of fill by SFSGFA.)
!
! FILL is called once for each sub-box in the label bar,
! using a statement of the form
!
! CALL FILL( XCRA, YCRA, NCRA, INDX )
!
! and is expected to fill the sub-box defined by its arguments.
!
! XCRA and YCRA (input arrays of type REAL) are real arrays
! containing the X and Y coordinates of four points defining
! a rectangular box which is to be filled in some manner.
!
! NCRA (an input expression of type INTEGER) is the number of
! points defining the rectangular box
!
! INDX (an input expression of type INTEGER) is one of the
! indices from the array LFIN, in the call to NG_EZLBAR. Its
! value may be used as a color index or as a pattern selector.
!
!---------
!
! lbco - label justification (orientation)
!
! One of following nine justification values:
!
! 'TopLeft' 'TopCenter' 'TopRight'
! 'CenterLeft' 'CenterCenter' 'CenterRight'
! 'BottomLeft' 'BottomCenter' 'BottomRight'
!
! Default justifications are
!
! 'TopCenter' for LBAB=1, IHOV=0
! 'BottomCenter' for LBAB=2, IHOV=0
! 'CenterCenter' for LBAB=3, IHOV=0
!
! 'CenterLeft' for LBAB=1, IHOV=1
! 'CenterRight' for LBAB=2, IHOV=1
! 'CenterCenter' for LBAB=3, IHOV=1
!
! lbdg - label angle (in degree, contourclockwise)
!
! Default is zseo, if argument not present.
!
! lbsc - label size Scaling factor
!
! Default is 1.0, if argument not present.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_DASH(xp, yp, np, NDC, TCS, CDP, SCF,&
! PLC, TXC, PMC,&
! SWS, SWG, SWC,&
! CRS, CRG, CRB,&
! LTL, SAF, SCL,&
! LS1, LS2, MFS,&
! PCF, SBF, EPS)
!
! INTEGER, INTENT(IN) :: np
! REAL, INTENT(IN) :: xp(np), yp(np)
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: TCS
! CHARACTER(*), INTENT(IN), OPTIONAL :: CDP
! INTEGER, INTENT(IN), OPTIONAL :: SCF
! INTEGER, INTENT(IN), OPTIONAL :: PLC, TXC, PMC
! REAL, INTENT(IN), OPTIONAL :: SWS, SWG, SWC
! CHARACTER(1), INTENT(IN), OPTIONAL :: CRS, CRG, CRB
! INTEGER, INTENT(IN), OPTIONAL :: LTL, PCF, SBF
! REAL, INTENT(IN), OPTIONAL :: SAF, SCL, EPS
! REAL, INTENT(IN), OPTIONAL :: LS1, LS2, MFS
!
! Routine to draw a labeled curve using DASHPACK in a single call.
!
! Variables:
!
! xp - X coordinates defining the curve
!
! yp - Y coordinates defining the curve
!
! np - Size of X and Y arrays
!
!-------------------
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! Default NDC is .FALSE, if argument not present
!
! TCS - Tension on Cubic Splines
!
! < 0, draw polylines (turns smoothing off)
! = 0, draw simple (zero tension) cubic splines
! > 0, draw splines under tension (TCS specifies the desired tension)
!
! Note: It's a bad idea to use values of 'TCS' much bigger than
! about 15, as this can cause overflows in the smoothing routines.
!
! Default TCS is -1.0, if argument not present
!
! CDP - Character-string Dash Pattern
!
! A character dash pattern is a string of 256 or fewer characters;
! in such a string, occurrences of the characters specified by the
! values of 'CRG' and 'CRS' specify gaps and solids, respectively.
! Other characters in the dash pattern form label strings to be
! written along a curve.
!
! Within each complete label string of a character dash pattern,
! the character specified by the value of 'CRB' may be used to
! specify "break points" at which the label string may be broken
! into smaller substrings. Alternatively, the single-character
! flag 'SCF' may be set non-zero to say that the label string
! may be broken into single-character substrings.
!
! Default CDP is '$$$$$$$$$$$$$$$$', if argument not present
!
! =====
! Note:
! =====
!
! Dash pattern string 'CDP' may containing some characters that
! are to be treated as symbol generators; symbol-selection
! characters which may be used include the following:
!
! character ACHAR(IACHAR('0')+128) => filled circle
! character ACHAR(IACHAR('1')+128) => filled square
! character ACHAR(IACHAR('2')+128) => filled triangle
! character ACHAR(IACHAR('3')+128) => filled diamond
! character ACHAR(IACHAR('4')+128) => filled star
! character ACHAR(IACHAR('5')+128) => hollow circle
! character ACHAR(IACHAR('6')+128) => hollow square
! character ACHAR(IACHAR('7')+128) => hollow triangle
! character ACHAR(IACHAR('8')+128) => hollow diamond
! character ACHAR(IACHAR('9')+128) => hollow star
!
! For example, to get a dash pattern specifying alternate solid-line
! segments and filled circles, use this:
!
! CDP = '$0' ! '$' means "solid"; '0' selects a "filled circle" symbol
! CDP(2:2) = ACHAR(IACHAR(CDP(2:2))+128)
!
! To get a dash pattern specifying a solid section, the characters
! "I=1", another solid section, and a hollow-circle symbol, use this:
!
! CDP = '$$$I|=|1$$$5' ! A final '5' selects the desired symbol.
! CDP(12:12) = ACHAR(IACHAR(CDP(12:12))+128)
!
! SCF - Single-Character Flag
!
! 0, trun single character mode off
! otherwise, trun single character mode on
!
! when 'SCF' is non-zero, it says that the label-string portions
! of character dash patterns are to be broken into single-character
! pieces, each of which is to be written by a separate call to
! PLCHHQ, PLCHMQ, or PLCHLQ. If 'SCF' = 0, label strings are
! broken into pieces only at the break points indicated by the
! use of "break" characters in the strings.
!
! It is not appropriate to use 'SCF' non-zero when PLCHHQ is
! being used and a label string in the dash pattern contains
! function codes that are meaningful to PLCHHQ; in that case,
! one should leave 'SCF' = 0 and use the "break" character
! 'CRB' in the label string to tell DASHPACK where it can be
! broken.
!
! Default SCF is 0, if argument not present
!
!---------
!
! PLC - PolyLine Color Index
!
! Default PLC is the color index inquired from NG_GQPLCI routine,
! if arguemnt not present
!
! TXC - TeXt label Color Index
!
! Default TXC is the value of PLC, if argument not present
!
! PMC - PolyMarker label Color Index
!
! Default PMC is the value of PLC, if argument not present
!
!---------
!
! SWS - Scaling factor of WOS. WOS is the width of each solid
! in the dashed line.
!
! Default (for SWS=1.0) WOS is 0.0075*MIN((VR-VL),(VT-VB)),
! where, (VR-VL) and (VT-VB) are the viewport width and
! height separately, and, VR, VL, VT and VB are get from
! the call CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SWS is 1.0, if arguemnt not present
!
! SWG - Scaling factor of WOG. WOG is the width of each gap
! in the dashed line.
!
! Default (for SWG=1.0) WOG is 0.0075*MIN((VR-VL),(VT-VB)),
! where, (VR-VL) and (VT-VB) are the viewport width and
! height separately, and, VR, VL, VT and VB are get from
! the call CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SWG is 1.0, if arguemnt not present
!
! SWC - Scaling factor of WOC. WOC is the character width to be
! used in writing labels.
!
! Default (for SWC=1.0) WOC is 0.0150*MIN((VR-VL),(VT-VB)),
! where, (VR-VL) and (VT-VB) are the viewport width and
! height separately, and, VR, VL, VT and VB are get from
! the call CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SWC is 1.0, if arguemnt not present
!
!---------
!
! CRS - CHaracter Representing Solid
! the single character that is to be used in a character dash
! pattern 'CDP' to represent a solid section (of width 'WOS')
! of the curve.
!
! Default CRS is '$', if argument not present
!
! CRG - CHaracter Representing Gap
! the single character that is to be used in a character dash
! pattern 'CDP' to represent a gap (of width 'WOG') in the curve.
!
! Default CRG is '_', if argument not present
!
! CRB - CHaracter Representing Break
! the single character that is to be used in a label string
! in a character dash pattern 'CDP' to represent a break point
! in the label string. (to allow the string to be written
! bending with a curve being drawn.)
!
! Default CRB is '|', if argument not present
!
!---------
!
! LTL - Lines Through Labels, a flag that says whether or not each
! label substring specified by a character dash pattern is to
! be written in a gap ('LTL' = 0) or just on top of the curve
! ('LTL' = 1). The latter is most effective if the line is one
! color and the labels are another color.
!
! Default LTL is 0, if argument not present
!
! SAF - String Angle Flag, specifies how labels are to be oriented.
!
! If 'SAF' = 0, labels are written along a curve in the direction
! in which the curve is being drawn.
!
! If 'SAF' is negative, labels are written in the direction
! ABS('SAF') degrees, but this is done only if 'LTL' is non-zero;
! otherwise, the code behaves as if 'SAF' were zero: labels are
! written in the direction of the curve.
!
! If 'SAF' is greater than zero, labels are written along the
! curve, but the angle is adjusted by adding multiples of 180
! degrees so that the resulting angle lies in the range from
! 'SAF'-90 to 'SAF'+90 degrees.
!
! If a label string is broken into substrings (either because
! there are "break" characters in it or because 'SCF' is non-zero),
! a negative value of 'SAF' will be treated as a zero value; a
! value greater than zero may cause the entire label to be written
! in the opposite direction along the curve if that ensures that
! more characters of the label will be written at angles between
! 'SAF' -90 and 'SAF'+90 degrees.
!
! Generally, when 'SAF' is non-zero, it is either -360 or +360,
! which has the effect of making the labels as nearly upright
! as possible on the frame.
!
! The value of 'SAF" must be in the range from -360 to +360.
!
! Default SAF is 360.0, if argument not present
!
! SCL - Scaling factor of SSL. SSL is the Smoothed Segment Length
! specifies how far apart the points used to draw a smoothed
! curve should be.
!
! Default (for SCL=1.0) SSL is 0.01*MIN((VR-VL),(VT-VB)),
! where, (VR-VL) and (VT-VB) are the viewport width and
! height separately, and, VR, VL, VT and VB are get from
! the call CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SCL is 1.0 if argument not present
!
! LS1 - Label Spacing 1, specifies how much extra gap space to leave
! at the beginning and end of a label. Giving 'LS1' a non-zero
! value helps to ensure that there will be a sufficiently large
! gap to (for example) prevent a leading minus sign from
! appearing to be part of the line.
!
! The value of 'LS1' is given as a multiple of the value of the
! parameter 'WOC' (the width of a character); it must not be
! less than zero nor greater than 10.0
!
! Default LS1 is 0.5, if argument not present
!
! LS2 - Label Spacing 2, specifies how much extra gap space to leave
! for each piece of a broken label. When break characters are
! used or the single-character flag 'SCF' is turned on, 'LS2'
! determines the spacing of the characters along the line.
!
! The value of 'LS2' is given as a multiple of the value of the
! parameter 'WOC' (the width of a character); it must not be
! less than zero nor greater than 10.0
!
! Default LS2 is 0.0, if argument not present
!
! MFS - Multiplier for First Solid, a real multiplier for the length
! of an initial solid portion of a curve drawn by DASHPACK.
!
! The object of using this is to make it possible to slightly
! offset labels on curves that are very nearly parallel to one
! another (as can happen, for example, when drawing contour lines).
!
! The value of 'MFS' must be greater than or equal to zero.
!
! Default MFS is 1.0, if argument not present
!
! PCF - PlotChar Flag, says which PLOTCHAR routine is to be called
! to draw character strings.
!
! = 0, to call NG_PLCHHQ,
! = 1, to call NG_PLCHMQ, and
! = 2, to call NG__PLCHLQ.
!
! Default PCF is 0, if argument not present
!
! SBF - String Buffering Flag, a flag that says whether output of
! labels is to be buffered or not.
!
! = 0, buffering is turned off.
! otherwise, buffering is done.
!
! Default SBF is 1, if argument not present
!
! EPS - EPSilon, says how far apart two points have to be (in X or Y,
! in the fractional coordinate system) in order to be considered
! separate points by the smoothing routine NG_DPSMTH.
!
! Default EPS is 0.000001, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_EZDASH(xp, yp, np, idash, NDC, TCS, LAB, SCF,&
! SC1, SC2, SC3,&
! PLC, TXC, PMC)
!
! INTEGER, INTENT(IN) :: np
! REAL, INTENT(IN) :: xp(np), yp(np)
! INTEGER, INTENT(IN) :: idash
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: TCS
! CHARACTER(*), INTENT(IN), OPTIONAL :: LAB
! INTEGER, INTENT(IN), OPTIONAL :: SCF
! REAL, INTENT(IN), OPTIONAL :: SC1, SC2, SC3
! INTEGER, INTENT(IN), OPTIONAL :: PLC, TXC, PMC
!
! Routine to draw labeled curve using NCL predefined dash patterns.
!
! Variables:
!
! xp - X coordinates defining the curve
!
! yp - Y coordinates defining the curve
!
! np - Size of X and Y arrays
!
! idash - NCL predefined dash pattern, numbered from 0 to 16
!
! = 0, "$ ", "Solid" (SolidLine)
! 1, "$$$$__ ", "D4U2" (Dash)
! 2, "$__ ", "DU2" (dot)
! 3, "$$$$__$__ ", "D4U2DU2" (DashDot)
! 4, "$$$$__$_$__ ", "D4U2DUDU2" (DashDotDot)
! 5, "$$_ ", "D2U"
! 6, "$$$_ ", "D3U"
! 7, "$_$$_ ", "DUD2U"
! 8, "$_$$$_ ", "DUD3U"
! 9, "$$_$$$$_ ", "D2UD4U"
! 10, "$$$$_$$_$_$$_", "D4UD2UDUD2U"
! 11, "$$__ ", "D2U2"
! 12, "$$$$$$__ ", "D6U2"
! 13, "$$$_$$$__ ", "D3UD3U2"
! 14, "$$___ ", "D2U3"
! 15, "$_$___ ", "DUDU3"
! 16, "$$$$$_____ ", "D5U5"
!
! otherwise, Solid
!
!-------------------
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! Default NDC is .FALSE, if argument not present
!
! TCS - Tension on Cubic Splines
!
! < 0, draw polylines (turns smoothing off)
! = 0, draw simple (zero tension) cubic splines
! > 0, draw splines under tension (TCS specifies the desired tension)
!
! Note: It's a bad idea to use values of 'TCS' much bigger than
! about 15, as this can cause overflows in the smoothing routines.
!
! Default TCS is -1.0, if argument not present
!
! LAB - character-string (text and/or symbol) labels
!
! some characters that are to be treated as symbol generators;
!
! character ACHAR(IACHAR('0')+128) => filled circle
! character ACHAR(IACHAR('1')+128) => filled square
! character ACHAR(IACHAR('2')+128) => filled triangle
! character ACHAR(IACHAR('3')+128) => filled diamond
! character ACHAR(IACHAR('4')+128) => filled star
! character ACHAR(IACHAR('5')+128) => hollow circle
! character ACHAR(IACHAR('6')+128) => hollow square
! character ACHAR(IACHAR('7')+128) => hollow triangle
! character ACHAR(IACHAR('8')+128) => hollow diamond
! character ACHAR(IACHAR('9')+128) => hollow star
!
! Default is ' ' (means unlabeled curve), if argument not
! present or LEN_TRIM(LAB)=0
!
! SCF - Single-Character Flag
!
! 0, trun single character mode off
! otherwise, trun single character mode on
!
! when 'SCF' is non-zero, it says that the label-string portions
! of character dash patterns are to be broken into single-character
! pieces, each of which is to be written by a separate call to
! PLCHHQ, PLCHMQ, or PLCHLQ. If 'SCF' = 0, label strings are
! broken into pieces only at the break points indicated by the
! use of "break" characters in the strings.
!
! It is not appropriate to use 'SCF' non-zero when PLCHHQ is
! being used and a label string in the dash pattern contains
! function codes that are meaningful to PLCHHQ; in that case,
! one should leave 'SCF' = 0 and use the "break" character
! 'CRB' in the label string to tell DASHPACK where it can be
! broken.
!
! Default SCF is 0, if argument not present
!
! SC1 - Scaling factor of WOS and WOG. WOS and WOG are the width
! of each solid and gap in the dashed line separately.
!
! Default (for SC1=1.0) WOS (WOC) are 0.0075*MIN((VR-VL),(VT-VB))
! where, (VR-VL) and (VT-VB) are the viewport width and height
! separately, and, VR, VL, VT and VB are get from the call
! CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SC1 is 1.0, if arguemnt not present
!
! SC2 - Scaling factor of WOC. WOC is the width of each character
! of label LAB in the dashed line.
!
! Default (for SC2=1.0) WOC is 0.0150*MIN((VR-VL),(VT-VB))
! where, (VR-VL) and (VT-VB) are the viewport width and height
! separately, and, VR, VL, VT and VB are get from the call
! CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SC2 is 1.0, if arguemnt not present
!
! SC3 - Scaling factor of ARC. ARC is the arc length of each span
! between two labels (>1 and <1 to decrease and increase the
! label density separately)
!
! Default (for SC3=1.0) ARC is 0.3*MIN((VR-VL),(VT-VB))
! where, (VR-VL) and (VT-VB) are the viewport width and height
! separately, and, VR, VL, VT and VB are get from the call
! CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! Default SC3 is 1.0, if arguemnt not present
!
! PLC - PolyLine Color Index
!
! Default PLC is the color index inquired from NG_GQPLCI routine,
! if arguemnt not present
!
! TXC - TeXt label Color Index
!
! Default TXC is the value of PLC, if argument not present
!
! PMC - PolyMarker label Color Index
!
! Default PMC is the value of PLC, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_LABC( xp, yp, np, isd, label, NDC, ic1, ic2, sc1, sc2, sc3 )
!
! INTEGER, INTENT(IN) :: np
! REAL, INTENT(IN) :: xp(np), yp(np)
! INTEGER, INTENT(IN) :: isd
! CHARACTER(*), INTENT(IN) :: label
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! INTEGER, INTENT(IN), OPTIONAL :: ic1, ic2
! REAL, INTENT(IN), OPTIONAL :: sc1, sc2, sc3
!
! Routine to draw a simple labeled curve pass through given points.
!
! Variables:
!
! xp - X coordinates of given points
!
! yp - Y coordinates of given points
!
! np - point count. for closed curve, the first and last
! points must be identical and is counted twice
!
! isd - flag to indicate the type of curve
! = 1, solid line with no label
! = 2, solid line with string label
! = 3, solid line with symbol label
! = -1, dashed line with no label
! = -2, dashed line with string label
! = -3, dashed line with symbol label
! otherwise, default to isd= 1
!
! label - the character string, if isd= 2, -2
! the symbol code number, if isd= 3, -3 (number in text form, code 3 -> '3')
!
!---------
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., xp and yp are fractional/normalized device coordinates
! .FALSE., xp and yp are world/user coordinates
!
! Default NDC is .FALSE, if argument not present
!
! ic1 - color index for drawing curve
! if argumet not present, color index inquired by NG_GQPLCI(...) will be used
!
! ic2 - color index for drawing label, used for ABS(isd)=2,3
! if argumet not present, color index ic1 will be used
!
! sc1 - scaling factor for the line segament length (DL).
!
! Solid curve will be drawn by connecting line segments
! of such length. For dashed curve, DL is the length of
! dash or space between dashes.
!
! Default (sc1=1.0) DL is 0.0075*MIN((VR-VL),(VT-VB)), where,
! (VR-VL) and (VT-VB) are the viewport width and height
! separately, and, VR, VL, VT and VB are get from the call
! CALL NG_GETSET(VL, VR, VB, VT, ...).
!
! sc2 - scaling factor for the labels
!
! Default (sc2=1.0) label size is 0.015*MIN((VR-VL),(VT-VB))
!
! sc3 - scaling factor for the arc length of each span between
! two labels (>1 and <1 to decrease and increase the label
! density separately)
!
! Default (sc3=1.0) arc length is 0.3*MIN((VR-VL),(VT-VB))
!
! if sc3<0.0, single label will be positioned at arc length
! (-sc3)*0.3*MIN((VR-VL),(VT-VB))
!
! if sc3==0.0, single centered label will be drawn
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_FILL( xp, yp, np, ic, NDC, ITY, AID, DBL, ICI,&
! SIZ, ICH, IDP )
!
! INTEGER, INTENT(IN) :: np
! REAL, INTENT(IN) :: xp(np), yp(np)
! INTEGER, INTENT(IN) :: ic
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! INTEGER, INTENT(IN), OPTIONAL :: ITY
! REAL, INTENT(IN), OPTIONAL :: AID, DBL, SIZ
! INTEGER, INTENT(IN), OPTIONAL :: ICI, ICH, IDP(8,8)
!
! Routine to fill an area using SOFTFILL in a single call.
!
! Variables:
!
! xp - the X coordinates of the points defining the area to be filled
!
! yp - the Y coordinates of the points defining the area to be filled
!
! np - the number of points defining the area to be filled.
! "np" must be greater than two.
!
! ic - the fill-area color index
!
!---------
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! The default value is .FALSE, if argument not present
!
! ITY - Type of fill flag
!
! = -4, -3, -2, -1, patterned line fill, to fill the area with
! lines forming a pattern. Optional argument ICI is used
! to select that pattern.
!
! Optional arguments used: AID, DBL and ICI
!
! -----
!
! = 0, solid color fill, same as the routine NG_GFA
!
! Optional arguments used: None
!
! -----
!
! = 1, Simple 1-dir line fill, the area is filled with parallel
! lines
!
! Optional arguments used: AID and DBL
!
! = 2, Simple 2-dir line fill, the area is filled with parallel
! lines and it is then filled again with parallel lines
! perpendicular to the first set
!
! Optional arguments used: AID and DBL
!
! -----
!
! =11, patterned polymarker fill, to fill (by NG_POINTS)
! polygons with polymarkers or selected characters
! arrayed in a regular rectangular pattern IDP.
!
! Optional arguments used: AID, DBL, SIZ, ICH, and IDP
!
! =12, patterned dot fill, to fill (by routine NG_POINTS)
! polygons with dots arrayed in a regular rectangular
! pattern IDP.
!
! Optional arguments used: AID, DBL, SIZ, and IDP
!
! The default value is 0, if argument not present.
!
!---------
!
! AID - "Angle in Degree", the angle of fill lines, in degrees
! counterclockwise from horizontal.
!
! The default value is 0.0, if argument not present.
!
! DBL - "Distance between Lines", the spacing of fill lines, in the
! fractional coordinate system.
!
! The default value is 0.00125, if argument not present.
!
!---------
!
! ICI - Line fill pattern flag, for the cases: ITY= -4, -3, -2, -1
!
! A zero or negative value of ICI will select a blank pattern.
! Positive values of ICI will select patterns which increase
! in density as the value of ICI increases.
!
! ABS(ITY) specifies which set of patterns is to be used;
! the largest usable value of ICI is approximately 5*ABS(ITY),
! beyond that, the pattern becomes essentially solid.
!
! The fill patterns generated may be described as follows:
! Let "n" represent the value ABS(ITY). For ICI=0, no fill
! lines are drawn at all. For each of the next "n" values of
! ICI, the pattern is elaborated by the addition of fill lines,
! 32*DBL units apart, at one of the angles AID, AID+180/n,
! AID+2*180/n, ... . For each of the next "n" values of ICI,
! the pattern is elaborated by halving the distance between
! fill lines at one of the angles. This final step is then
! repeated ad infinitum.
!
! The default value is 2*ABS(ITY), if argument not present.
!
!---------
!
! IDP - Dot pattern (mask) array, for the cases: ITY= 11, 12
!
! An 8x8 array of type INTEGER, containing nothing but 0s (the
! dot is not drawn) and 1s (the dot is drawn), describing the
! dot pattern to be used when 'DO' is set non-zero to select
! dot fill, rather than line fill.
!
! The default value is 1.
!
! SIZ - Polymark/Dot size in NDC, for the cases: ITY= 11, 12
! used in calls to NG_DOTS and NG_POINTS
!
! CALL NG_POINTS(xc, yc, nc, ICH, 0, SZ=SIZ, IC=ic)
! CALL NG_DOTS (xc, yc, nc, SIZ, ic, ID=0)
!
! The default value is 0.01, if argument not present.
!
! ICH - Character selector, for the case: ITY= 11 only
!
! = 0, a dot (.) [a little cross (x) of 1/10 size actually]
!
! -1, a dot (.) [a little cross (x) of 1/10 size actually]
! -2, a plus (+)
! -3, an asterisk (*)
! -4, a circle (o)
! -5, a cross (x)
!
! 32-126, a character "ACHAR(ICH)"
!
! used in calls to NG_POINTS
!
! CALL NG_POINTS(xc, yc, nc, ICH, 0, IC=ic, SZ=SIZ )
!
! The default value is 0, if argument not present.
!
!----------
! Examples:
!----------
!
! ! Solid Color Fill, ITY= 0
! CALL NG_FILL( xp, yp, np, ic, ITY=0 )
!
! ! Simple 1-Dir Line Fill, ITY= 1
! CALL NG_FILL( xp, yp, np, ic, ITY=1,&
! NDC= ,& ! default is .FALSE.
! AID= ,& ! default is 0.0
! DBL= ) ! default is 0.00125
!
! ! Simple 2-Dir Line Fill, ITY= 2
! CALL NG_FILL( xp, yp, np, ic, ITY=2,&
! NDC= ,& ! default is .FALSE.
! AID= ,& ! default is 0.0
! DBL= ) ! default is 0.00125
!
! ! Patterned Line Fill, ITY= -1, -2, -3, or, -4
! CALL NG_FILL( xp, yp, np, ic, ITY=-1, -2, -3, or, -4,&
! NDC= ,& ! default is .FALSE.
! AID= ,& ! default is 0.0
! DBL= ,& ! default is 0.00125
! ICI= ) ! default is 2*ABS(ITY)
!
! ! Patterned Polymark Fill, ITY= 11
! CALL NG_FILL( xp, yp, np, ic, ITY=11,&
! NDC= ,& ! default is .FALSE.
! AID= ,& ! default is 0.0
! DBL= ,& ! default is 0.00125
! IDP= ,& ! default is 1 (an 8x8 array)
! SIZ= ,& ! default is 0.01
! ICH= ) ! default is 0
!
! ! Patterned Dot Fill, ITY= 12
! CALL NG_FILL( xp, yp, np, ic, ITY=12,&
! NDC= ,& ! default is .FALSE.
! AID= ,& ! default is 0.0
! DBL= ,& ! default is 0.00125
! IDP= ,& ! default is 1 (an 8x8 array)
! SIZ= ) ! default is 0.01
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_EZFILL( xp, yp, np, ip, ic, NDC, s1, s2 )
!
! INTEGER, INTENT(IN) :: n
! REAL, INTENT(IN) :: x(n), y(n)
! INTEGER, INTENT(IN) :: ip, ic
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: s1, s2
!
! Routine to fill with one of the NCL predefined fill patterns.
!
! Variables:
!
! xp - The X coordinates array of points defining the area to be filled.
!
! yp - The X coordinates array of points defining the area to be filled.
!
! np - The number of points defining the area to be filled.
!
! ip - The NCL predefined fill pattern selector, ranged from 0 to 17.
!
! ip = 0, solid-color fill
!
! ip = 1-16, hatching-solid-line fill
!
! ip = 17, hatching-dot-line fill
!
! ic - The color index for filling
!
! Note: Nothing to do, if (np < 3) .OR. (ip<0 .OR. ip>17) .OR. (ic < 0)
!
!---------
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! The default value is .FALSE, if argument not present
!
! s1 - The scaling factor for the spacing (in fractional) between
! hatching lines. Default spacing is 0.01 for ip=1-16, and,
! 0.00725 for ip=17. This argument is not used for ip=0.
!
! Default value of s1 is 1.0, if argument not present
!
! s2 - The scaling factor for the size (in fractional) of "dot" in
! the case of ip=17. Default size is 0.3*0.00725. This argument
! is used only for ip=17
!
! Default value of s2 is 1.0, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_FILLCC( X1, Y1, N1, X2, Y2, N2, IC1, IC2, NDC, vert )
!
! INTEGER, INTENT(IN) :: N1, N2
! REAL, INTENT(IN) :: X1(N1), Y1(N1), X2(N2), Y2(N2)
! INTEGER, INTENT(IN) :: IC1, IC2
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! LOGICAL, INTENT(IN), OPTIONAL :: vert
!
! Routine to fill any polygon formed by two curves defined by two
! set of points. Areas where curve Y1>Y2 are filled by using color
! IC1, and, areas where curve Y2>Y1 are filled by using color IC2.
!
! Variables :
!
! X1, Y1 - The arrays containing the X and Y coordinates,
! measured in User coordinates, of the data points
! to be plotted for curve 1.
!
! N1 - The number of data points forming curve 1.
!
! X2, Y2 - The arrays containing the X and Y coordinates,
! measured in User coordinates, of the data points
! to be plotted for curve 2.
!
! N2 - The number of data points forming curve 2.
!
! IC1 - Color index of the color used to fill areas where Y1>Y2.
!
! IC2 - Color index of the color used to fill areas where Y2>Y1.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! The default value is .FALSE, if argument not present
!
! vert - If .TRUE., fill between curves that are vertically oriented.
! (this means curves are ~x(y), fill areas between two X curves)
!
! Default is .FALSE. (the normal case, curves ~y(x), fill areas
! between two Y curves), if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_FILLCY( X, Y, N, YREF, IC1, IC2, NDC )
!
! INTEGER, INTENT(IN) :: N
! REAL, INTENT(IN) :: X(N), Y(N)
! REAL, INTENT(IN) :: YREF
! INTEGER, INTENT(IN) :: IC1, IC2
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to fill any polygon formed by a Y(X) curve and a Y-reference
! line. Areas above Y-reference line (Y>YREF) are filled using color IC1,
! and, areas below reference line (Y<YREF) are filled by color IC2.
!
! Variables :
!
! X, Y - The arrays containing the X and Y coordinates to be plotted
! for the curve.
!
! N - The number of data points forming curve.
!
! YREF - The Y coordinate of the Y-reference line
!
! IC1 - Color index of the color used to fill areas above
! the reference line (Y>YREF).
!
! IC2 - Color index of the color used to fill areas below
! the reference line (Y<YREF).
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X, Y, and YREF are fractional/normalized device coordinates
! .FALSE., X, Y, and YREF are world/user coordinates
!
! The default value is .FALSE, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_FILLCX( X, Y, N, XREF, IC1, IC2, NDC )
!
! INTEGER, INTENT(IN) :: N
! REAL, INTENT(IN) :: X(N), Y(N)
! REAL, INTENT(IN) :: XREF
! INTEGER, INTENT(IN) :: IC1, IC2
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to fill any polygon formed by a X(Y) curve and a X-reference
! line. Areas above X-reference line (X>XREF) are filled using color IC1,
! and, areas below reference line (X<XREF) are filled by color IC2.
!
! Variables :
!
! X, Y - The arrays containing the X and Y coordinates to be plotted
! for the curve.
!
! N - The number of data points forming curve.
!
! XREF - The X coordinate of the X-reference line
!
! IC1 - Color index of the color used to fill areas above (reght)
! the reference line (X>XREF).
!
! IC2 - Color index of the color used to fill areas below (left)
! the reference line (X<XREF).
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X, Y, and XREF are fractional/normalized device coordinates
! .FALSE., X, Y, and XREF are world/user coordinates
!
! The default value is .FALSE, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MARKER( XP, YP, HT, DG, ID, IC, NDC )
!
! REAL, INTENT(IN) :: XP, YP, HT, DG
! INTEGER, INTENT(IN) :: ID, IC
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw a graphics marker at point (XP,YP).
!
! Variables:
!
! XP - X centered position of the marker
!
! YP - Y centered position of the marker
!
! HT - Size of marker, measured in fractional coordinate
!
! DG - Angle in degrees counterclockwise from the positive X axis,
! at which the glyph is to be drawn.
!
! ID - Code number of marker
!
! 0- 16 -> NCL predefined
!
! 20- 99 -> UNIPLT predefined
!
! --- following are glyph from the meteorological 8 fonts ---
! 100-199 -> the glyphs 00-99 of the 'WW' font, Present weather.
! 200-209 -> the glyphs 00-09 of the 'C' font, Cloud types.
! 210-219 -> the glyphs 00-09 of the 'CL' font, Low clouds.
! 220-229 -> the glyphs 00-09 of the 'CM' font, Medium clouds.
! 230-239 -> the glyphs 00-09 of the 'CH' font, High clouds.
! 240-249 -> the glyphs 00-09 of the 'W' font, Past weather.
! 250-259 -> the glyphs 00-09 of the 'N' font, Sky cover.
! 260-269 -> the glyphs 00-09 of the 'a' font, Pressure tendency.
! 270 -> none
! 271 -> the alternate glyph 07 of the 'WW' font
! 272 -> the alternate glyph 93 of the 'WW' font
! 273 -> the alternate glyph 94 of the 'WW' font
! 274 -> the alternate glyph 95 of the 'WW' font
! 275 -> the alternate glyph 97 of the 'WW' font
! 276 -> the alternate glyph 03 of the 'W' font
!
! IC - Color index indicating the color that the marker
! is to be drawn with.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XP and YP are fractional/normalized device coordinates
! .FALSE., XP and YP are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_DOTS( XP, YP, NP, SZ, IC, NDC, ID )
!
! INTEGER, INTENT(IN) :: NP
! REAL, INTENT(IN) :: XP(NP), YP(NP)
! REAL, INTENT(IN) :: SZ
! INTEGER, INTENT(IN) :: IC
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! INTEGER, INTENT(IN), OPTIONAL :: ID
!
! Routine to draw filled or outlined circle at positions defined by
! (XP(I),YP(I),I=1,NP).
!
! Variables :
!
! XP - X coordinates array
!
! YP - Y coordinates array
!
! NP - Size of arrays XP and YP
!
! SZ - Size (diameter) of circle
! (SZ is the diameter along the Y-axis, for NDC=.TRUE.)
!
! IC - Color index of dot/circle
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XP, YP, and SZ are fractional/normalized device coordinates
! .FALSE., XP, YP, and SZ are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! ID - Flag to control whether NG_DOTS draws circles or dots
!
! = 0, dot (filled circle);
! otherwise, circle (outlined circle)
!
! Default is 0, if not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_POINTS( XP, YP, NP, IP, IL, NDC, SZ, SC, IC )
!
! INTEGER, INTENT(IN) :: NP
! REAL, INTENT(IN) :: XP(NP), YP(NP)
! INTEGER, INTENT(IN) :: IP, IL
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: SZ, SC
! INTEGER, INTENT(IN), OPTIONAL :: IC
!
! Routine to mark the points at positions defined by
! (XP(I),YP(I)),I=1,NP).
!
! Variables:
!
! XP - X coordinates array of markers
!
! YP - Y coordinates array of markers
!
! NP - Size of arrays XP and YP
!
! IP - Type of marker
!
! = 0, a dot (.) [a little cross (x) of 1/10 size actually]
!
! -1, a dot (.) [a little cross (x) of 1/10 size actually]
! -2, a plus (+)
! -3, an asterisk (*)
! -4, a circle (o)
! -5, a cross (x)
!
! 32-126, a character "CHAR(IP)"
!
! IL - Line connection flag
! If IL equals 0 then the markers are left unconnected.
! Otherwise the markers are connected with line segments (using
! current PLCI color inquired by NG_GQPLCI).
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XP and YP are fractional/normalized device coordinates
! .FALSE., XP and YP are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! SZ - Size of marker measured in NDC
! Default is 0.01, if argument not present
!
! SC - Scaling factor of (default) marker size
! Default is 1.0, if argument not present
! Note: If argument SZ present, this argument will be ignored
!
! IC - Color index of dot/circle
! Default is current PLCI color inquired by NG_GQPLCI,
! if argument not presen
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_POINT( PX, PY, NDC )
!
! REAL, INTENT(IN) :: PX, PY
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw a point at (PX,PY), defined in the user coordinate
! system.
!
! Variables:
!
! X - X coordinate of point
!
! Y - Y coordinate of point
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! Note: What is actually drawn, for various reasons, is a little "x"
! of size 0.001 measured in NDC.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_WSYM( FTYPE, NUM, X, Y, SIZE, ICOLOR, IALT, NDC, DG )
!
! CHARACTER(*), INTENT(IN) :: FTYPE
! INTEGER, INTENT(IN) :: NUM
! REAL, INTENT(IN) :: X, Y, SIZ
! INTEGER, INTENT(IN) :: ICOLOR, IALT
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: DG
!
! Draw a glyph from the meteorological fonts.
!
! Variables:
!
! FTYPE - The meteorological font specification. FTYPE is a type
! character variable. Legal values are:
!
! 'WW' -- Present weather.
! 'C' -- Cloud types.
! 'CL' -- Low clouds.
! 'CM' -- Medium clouds.
! 'CH' -- High clouds.
! 'W' -- Past weather.
! 'N' -- Sky cover.
! 'a' -- Pressure tendency.
!
! NUM - The number of the glyph within the given font. For example,
! the glyph for haze is number five in the WW font.
!
! X - The X coordinate position where the glyph is to be positioned.
! This X position marks the horizontal center of the glyph.
!
! Y - The Y coordinate position where the glyph is to be positioned.
! This Y position marks the vertical center of the glyph.
!
! SIZE - The size of the character measured in fractional coordinates.
!
! ICOLOR - The color index indicating the color that the glyph is to
! be drawn with.
!
! IALT - If IALT=1, then the alternate glyph for the one specified
! is drawn. This applies only to a few glyphs such as
! numbers 7, 93, 94, 95, 97 in the WW font and number 3
! in the W font.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! DG - The angle in degrees counterclockwise from the positive X axis,
! at which the glyph is to be drawn.
!
! Default value of DG is 0.0, if argument not present
!
! Examples:
!
! CALL NG_WSYM('N',6,.5,.5,.25,1,0)
!
! would plot a circle that is 3/4th filled at position (.5,.5)
! and height .25 in the foreground color.
!
! CALL NG_WSYM('a',6,.2,.8,.3,1,0)
!
! would plot the glyph for barometric pressure that is falling
! then steady.
!
! CALL NG_WSYM('WW',95,.5,.5,.2,1,1)
!
! would plot the alternate glyph for slight or moderate
! thunderstorm without hail.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_LOGO( X, Y, HT, ITYPE, ICOL1, ICOL2 )
!
! REAL, INTENT(IN) :: X, Y, HT
! INTEGER, INTENT(IN) :: ITYPE, ICOL1, ICOL2
!
! Routine to draw a NCAR logo.
!
! Variables:
!
! X, Y - Normalized device coordinates specifying the center position
! where you want the logo. Normalized device coordinates are
! between 0. and 1. and extend over the entire viewport.
!
! HT - The desired height of the logo, expressed in normalized
! device coordinates.
!
! ITYPE - The logo type. There are three types:
! 1 - An NCAR logo. This logo will be drawn in a single color.
! 2 - A UCAR logo (just the UCAR star symbol).
! 3 - "NCAR" in Bell Gothic Black font.
! 4 - "UCAR" in Bell Gothic Black font,
! 5 - UCAR star logo, plus "UCAR" in Bell Gothic Black font at
! half the height of the star. In this case, the
! coordinate (X,Y) specifies the center of the star part
! of the logo.
!
! ICOL1 - The color index to be used for the logo color. For the
! NCAR logo on PostScript output, this argument is ignored.
!
! ICOL2 - A secondary color index used only for logo type 5.
! For that type, the UCAR star logo is drawn using color
! index ICOL1 and the text string "UCAR" is drawn using
! color index ICOL2.
!
! Example
!
! CALL NG_NGLOGO( 0.93, 0.05, 0.07, 1, ... )
!
! Plot an NCAR logo at the lower right of NG viewport (EZLOGO).
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_SYMB( XP, YP, SZ, DG, ISYM, NDC )
!
! REAL, INTENT(IN) :: XP, YP, SZ, DG
! INTEGER, INTENT(IN) :: ISYM
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw a graphics symbol at (XP,YP).
!
! Variables:
!
! XP - X centered position of the symbol
!
! YP - Y centered position of the symbol
!
! SZ - Size of symbol, measured in fractional coordinate
!
! DG - Rotation angle in degree
!
! ISYM - Symbol code number
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XP and YP are fractional/normalized device coordinates
! .FALSE., XP and YP are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! Note: Outline symbols are drawn using current "PLCI" color index.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_SYMB( XP, YP, SZ, DG, ISYM, NDC )
!
! REAL, INTENT(IN) :: XP, YP, SZ, DG
! INTEGER, INTENT(IN) :: ISYM
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw a graphics symbol at (XP,YP).
!
! Variables:
!
! XP - X centered position of the symbol
!
! YP - Y centered position of the symbol
!
! SZ - Size of symbol, measured in fractional coordinate
!
! DG - Rotation angle in degree
!
! ISYM - Symbol code number
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XP and YP are fractional/normalized device coordinates
! .FALSE., XP and YP are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! Note: Outline symbols are drawn using current "PLCI" color index.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_box(x, y, w, NDC)
!
! REAL, INTENT(IN) :: x, y(5), w
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw a box (NCL function: boxplot).
!
! Variables:
!
! x - X-axis value of where the box will be drawn.
!
! y - Five Y-axis values of the box.
!
! y(1) = bottom_value,
! y(2) = bottom_value_of_box,
! y(3) = mid-value_of_box,
! y(4) = top_value_of_box,
! y(5) = top_value.
!
! w - Width of the box
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., x, y, and w are fractional/normalized device coordinates
! .FALSE., x, y, and w are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BAR( XPAGE, YPAGE, ANGLE, HEIGHT, WIDTH, SH, IHAT, DLIN, NDC )
!
! REAL, INTENT(IN) :: XPAGE, YPAGE
! REAL, INTENT(IN) :: ANGLE, HEIGHT, WIDTH, SH, DLIN
! INTEGER, INTENT(IN) :: IHAT
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draws bars with or without hatching
!
! Variables:
!
! XPAGE - The X coordinate of the lower left corner of the bar
!
! YPAGE - The Y coordinate of the lower left corner of the bar
!
!
! ANGLE - The angle in degree at which the base of
! the bar to be drawn ( bar is rotated about
! XPAGE,YPAGE ).
!
! HEIGHT - The height (>=0.0) of the main bar, in fractional coordinate.
!
! WIDTH - The width (>=0.0) of the bar, in fractional coordinate.
!
! SH - The height of the intermediate bar, which is hatched
! according to the IHAT code.
! Value is measured in fractional coordinate
!
! IHAT - The hatching code.
!
! = 1, draw bar only (the default)
! = 2, hatch from left to right.
! = 3, hatch from right to left.
! = 4, hatch both ways.
! = 5, solid-fill
!
! Draw bar only, for other values of IHAT
!
! DLIN - The distance between hatching lines, in fractional coordinate.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XPAGE and YPAGE are fractional/normalized device coordinates
! .FALSE., XPAGE and YPAGE are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! Comments :
!
! 1) The hatching produced is parallel to the diagonal of the
! intermediate bar.
!
! 2) The intermediate bar may be as high as the main bar (SH=HEIGHT),
! if desired.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_POLY( XPAGE, YPAGE, SLEN, NR, ANGLE, NDC )
!
! REAL, INTENT(IN) :: XPAGE, YPAGE, SLEN, ANGLE
! INTEGER, INTENT(IN) :: NR
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw an equilateral polygons.
!
! Variables:
!
! XPAGE - The X coordinates of the polygon's starting point.
!
! YPAGE - The Y coordinates of the polygon's starting point.
!
! SLEN - The length of a side of the polygon, in fractional
! coordinate.
!
! NR - The number of sides of the polygon.
!
! ANGLE - The angle of the first side of the polygon, in degrees
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XPAGE and YPAGE are fractional/normalized device coordinates
! .FALSE., XPAGE and YPAGE are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! Comments :
!
! 1) If NR is negative, a star is drawn with -NR points.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_CIRCL( XPAGE, YPAGE, TH0, THF, R0, RF, IC, NDC, DSIZE )
!
! REAL, INTENT(IN) :: XPAGE, YPAGE, TH0, THF, R0, RF
! INTEGER, INTENT(IN) :: IC
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: DSIZE
!
! Routine to draw, starting at a given point, an arc, which may
! be extended to form a circle or spiral.
!
! Variables:
!
! XPAGE - The X coordinates of the arc's starting point.
!
! YPAGE - The Y coordinates of the arc's starting point.
!
! TH0 - The radius angle, in degree from the X axis,
! for the start of the arc.
!
! THF - The radius angle, in degree from the X axis,
! for the end of the arc.
!
! R0 - The arc's starting radius, in fractional coordinate.
!
! RF - The arc's ending radius, in fractional coordinate.
!
! IC - The code used to specify the type of line desired.
! If IC = 0, a solid arc is drawn,
! 1, a dashed arc is drawn.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XPAGE and YPAGE are fractional/normalized device coordinates
! .FALSE., XPAGE and YPAGE are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! DSIZE - The length, in fractional coordinate, of each line
! segments. Smooth curve will be drawn by connecting
! line segments of such length.
! Default value is 0.0025 if argument not present.
!
! Comments :
!
! 1) TH0 and THF may be positive or negative. If TH0 is less than
! THF, the arc is drawn in a counterclockwise direction; and
! if TH0 is greater than THF, the arc is drawn in a closewise
! direction.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_ELIPS( XPAGE, YPAGE, RMAJ, RMIN, ANGLE, TH0, THF, IC, NDC, DSIZE )
!
! REAL, INTENT(IN) :: XPAGE, YPAGE, RMAJ, RMIN
! REAL, INTENT(IN) :: ANGLE, TH0, THF
! INTEGER, INTENT(IN) :: IC
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
! REAL, INTENT(IN), OPTIONAL :: DSIZE
!
! Routine to draw an ellipse or ellipse arc
!
! Variables:
!
! XPAGE - The X and Y coordinates of the starting point of the
! YPAGE ellipse or arc.
!
! RMAJ - The lengths (non-zero), in fractional coordnate, of
! RMIN the semimajor and semiminor axes, respectively.
!
! ANGLE - The angle of major axis, in degree.
!
! TH0 - The angles, in degrees with respect to ANGLE,
! THF of the arc's starting and ending points.
!
! IC - The code used to specify the type of line desired.
! If IC = 0, a solid arc is drawn,
! 1, a dashed arc is drawn.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XPAGE and YPAGE are fractional/normalized device coordinates
! .FALSE., XPAGE and YPAGE are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! DSIZE - The length, in fractional coordinate, of each line
! segments. Smooth curve will be drawn by connecting
! line segments of such length.
! Default value is 0.0025 if argument not present.
!
! Comments :
!
! 1) TH0 and THF may be positive or negative.
!
! 2) If TH0 is less than THF, the arcis drawn in a counterclockwise
! direction; If TH0 is greater than THF, the arc is drawn in a
! clockwise direction.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GRID( XP,YP, XL,YL, DG, NDX,NDY, XDL,YDL, IGD, IBC, NDC )
!
! REAL, INTENT(IN) :: XP, YP, XL, YL, DG, XDL, YDL
! INTEGER, INTENT(IN) :: NDX, NDY, GDPEN, BCPEN
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw a rectangle with grids.
!
! Variables:
!
! XP,YP - the (X,Y) coordinates of the rectangle's lower left
! corner
!
! XL,YL - the rectangle's width and height (fractional coordinates).
!
! DG - the angle, in degree, at which the rectangle's base
! is to be drawn. Rectangle is rotated about (XP,YP)
!
! NDX - No. of sections divided in X and Y directions.
! NDY >0 Normal mode
! =0 or <0 Not draw the tick-mark in X/Y dir.
!
! XDL - Height of tick-mark in X/Y dir (fractional coordinates).
! YDL >0.0 Draw tick-mark outward
! =0.0 Draw full grid-line
! <0.0 Draw tick-mark inward
!
! IGD - Color index to draw the grid-lines (<0 Means not draw)
!
! IBC - Color index to draw the rectangle (<0 Means not draw)
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., XP and YP are fractional/normalized device coordinates
! .FALSE., XP and YP are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_AROHD( XPAGE, YPAGE, XTIP, YTIP, AHLEN, AHWID, ICODE, NDC )
!
! REAL, INTENT(IN) :: XPAGE, YPAGE, XTIP, YTIP
! REAL, INTENT(IN) :: AHLEN, AHWID
! INTEGER, INTENT(IN) :: ICODE
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to draw an arrowhead at the end of a line segment.
!
! Variables:
!
! XPAGE - The X and Y coordinates of the starting point of the line
! YPAGE segment that determines the direction of the arrowhead.
!
! XTIP - The X and Y coordinates of the tip of the arrowhead.
! YTIP
!
! AHLEN - The arrowhead's length, in fractional coordinate.
! the length of arrowhead is set to
! (1.0/4.0) * (length of arrow)
! for non-positive AHLEN
!
! AHWID - The arrowhead's width, in fractional coordinate.
! the width of the arrowhead is set to
! (2/3) * (length if arrowhead)
! for non-positive AHWID.
!
! ICODE - A two-digit decimal code "IJ" where:
! I=0 : no line is desired from XPAGE,YPAGE
! to the arrowhead at XTIP,YTIP;
! =1 : if a line is desired;
! =2 : if a line is desired and a second
! arrowhead pointing in the opposite
! direction, is desired at XPAGE,YPAGE.
! J : from 1 to 7, specifying the type of
! arrowhead desired.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
! Comments:
!
! 1) The line from XPAGE,YPAGE to XTIP,YTIP determine the
! direction of the arrowhead. The tip of the arrowhead
! is at XTIP,YTIP
!
! 2) If a second arrowhead is desired, its tip is at XPAGE,YPAGE.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_SHADE( X1, Y1, N1, X2, Y2, N2, DLIN, ANGLE, NDC )
!
! INTEGER, INTENT(IN) :: N1, N2
! REAL, INTENT(IN) :: X1(N1), Y1(N1), X2(N2), Y2(N2)
! REAL, INTENT(IN) :: DLIN, ANGLE
! LOGICAL, INTENT(IN), OPTIONAL :: NDC
!
! Routine to shade any polygon formed by two lines defined by two
! set of points. SHADE assumes thast an imaginary line connects
! the first points of the two lines and that another imaginary line
! connects the last points of the two lines, Shading is down in the
! area(s) enclosed by the defined lines and the imaginary lines.
!
! Variables :
!
! X1 - The arrays containing the X and Y coordinates,
! Y1 of the data points to be plotted for line 1.
!
! N1 - The number of data points forming line 1.
!
! X2 - The arrays containing the X and Y coordinates,
! Y2 of the data points to be plotted for line 2.
!
! N2 - The number of data points forming line 2.
!
! DLIN - The distance, measured in fractional coordinate,
! between shading lines.
!
! ANGLE - The shading line inclination angle, in degrees.
!
! NDC - Normalized Device Coordinate flag
!
! .TRUE., X and Y are fractional/normalized device coordinates
! .FALSE., X and Y are world/user coordinates
!
! Default value of NDC is .FALSE, if argument not present
!
!---------------------------------------------------------------------
!=====================================================================
! C1. 2-D Coordinates transformations
!=====================================================================
!
! SUBROUTINE NG_D2TINI - initialize matrix
! SUBROUTINE NG_D2TSET - set matrix
! SUBROUTINE NG_D2TGET - get matrix
! SUBROUTINE NG_D2TMAP - coordinate transformation
!
! SUBROUTINE NG_D2TTR - Translation
! SUBROUTINE NG_D2TRO - Rotation
! SUBROUTINE NG_D2TRO2 - Rotate about a point
! SUBROUTINE NG_D2TSC - Scaling
! SUBROUTINE NG_D2TSC2 - Scaling about a point
! SUBROUTINE NG_D2TRF - Reflecation
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TINI()
!
! Routine to initialize the current 2-D transformation matrix.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TSET( cmat33 )
!
! Routine to reset the current 2-D transformation matrix by using
! the specified matrix (cmat33).
!
! Variables:
!
! REAL, INTENT(IN) :: cmat33(3,3)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TGET( cmat33 )
!
! Routine to get the current 2-D transformation matrix (cmat33).
!
! Variables:
!
! REAL, INTENT(OUT) :: cmat33(3,3)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TMAP( x, y, xt, yt )
!
! Routine to get the mapped coordinate (xt,yt), under the current 2-D
! transformation, of the given corrdinate (x,y).
!
! Variables:
!
! REAL, INTENT(IN ) :: x , y
! REAL, INTENT( OUT) :: xt, yt
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TTR( tx, ty )
!
! Routine to compute a 2-D translation transformation matrix and
! multiply it to the current 2-D transformation matrix.
!
! Translate by the magnitudes (tx,ty).
!
! Variables:
!
! REAL, INTENT(IN) :: tx, ty
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TRO( deg )
!
! Routine to compute a 2-D rotation transformation matrix and
! multiply it to the current 2-D transformation matrix.
!
! Rotate degree (deg) about point (0,0) along +Z axis, measured in
! degree, in counterclockwise sense.
!
! Variables:
!
! REAL, INTENT(IN) :: deg
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TRO2( deg, xp, yp )
!
! Routine to compute a 2-D arbitrary rotation transformation matrix
! and multiply it to the current 2-D transformation matrix.
!
! Rotate degree (deg) about point (xp,yp) along +Z axis, measured in
! degree, in counterclockwise sense.
!
! Variables:
!
! REAL, INTENT(IN) :: deg, xp, yp
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TSC( sx, sy )
!
! Routine to compute a 2-D scaling transformation matrix and multiply
! it to the current 2-D transformation matrix.
!
! Scaling about point (0,0), by the magnitudes (sx,sy).
!
! Variables:
!
! REAL, INTENT(IN) :: sx, sy
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TSC2( sx, sy, xp, yp )
!
! Routine to compute a 2-D arbitrary scaling transformation matrix
! and multiply it to the current 2-D transformation matrix.
!
! Scaling about point (xp,yp), by the magnitudes (sx,sy)
!
! Variables:
!
! REAL, INTENT(IN) :: sx, sy, xp, yp
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D2TRF( ax, by, c )
!
! Routine to compute a 2-D arbitrary reflection transformation matrix
! and multiply it to the current 2-D transformation matrix.
!
! Reflect about the line : ax*X + by*Y + c = 0.
!
! Variables:
!
! REAL, INTENT(IN) :: ax, by, c
!
!=====================================================================
! C2. 3-D Coordinates transformations
!=====================================================================
!
! SUBROUTINE NG_D3TINI - initialize matrix
! SUBROUTINE NG_D3TSET - set matrix
! SUBROUTINE NG_D3TGET - get matrix
! SUBROUTINE NG_D3TMAP - coordinate transformation
!
! SUBROUTINE NG_D3TTR - Translation
! SUBROUTINE NG_D3TRO - Rotation
! SUBROUTINE NG_D3TRO2 - Rotate about a point
! SUBROUTINE NG_D3TSC - Scaling
! SUBROUTINE NG_D3TSC2 - Scaling about a point
! SUBROUTINE NG_D3TPD - Perpective distance
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TINI()
!
! Routine to initialize the current 3-D transformation matrix.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TSET( cmat44 )
!
! Routine to reset the current 3-D transformation matrix by using
! the specified matrix (cmat44).
!
! Variables:
!
! REAL, INTENT(IN) :: cmat44(4,4)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TGET( cmat44 )
!
! Routine to get the current 3-D transformation matrix (cmat44).
!
! Variables:
!
! REAL, INTENT(OUT) :: cmat44(4,4)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TMAP( x, y, z, xt, yt )
!
! Routine to get the mapped coordinate (xt,yt), under the current 3-D
! transformation, of the given corrdinate (x,y,z).
!
! Variables:
!
! REAL, INTENT(IN ) :: x , y , z
! REAL, INTENT( OUT) :: xt, yt
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TTR( tx, ty, tz )
!
! Routine to compute a 3-D translation transformation matrix and
! multiply it to the current 3-D transformation matrix.
!
! Translate by the magnitudes (tx,ty,tz).
!
! Variables:
!
! REAL, INTENT(IN) :: tx, ty, tz
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TRO( deg, iaxis )
!
! Routine to compute a 3-D rotation transformation matrix and
! multiply it to the current 3-D transformation matrix.
!
! Rotate degree (deg) about point (0,0,0) along (iaxis) axis,
! measured in degree, in counterclockwise sense.
!
! Variables:
!
! REAL, INTENT(IN) :: deg
! INTEGER, INTENT(IN) :: iaxis
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TRO2( deg, from, to )
!
! Routine to compute a 3-D arbitrary rotation transformation matrix
! and multiply it to the current 3-D transformation matrix.
!
! Rotate degree (deg) about the line defined by two points:
! from point (from(1),from(2),from(3))
! to point ( to(1), to(2), to(3))
! measured in degree, in counterclockwise sense.
!
! Variables:
!
! REAL, INTENT(IN) :: deg, from(3), to(3)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TSC( sx, sy, sz )
!
! Routine to compute a 3-D scaling transformation matrix and
! multiply it to the current 3-D transformation matrix.
!
! Scaling about point (0,0,0), by the magnitudes (sx,sy,sz).
!
! Variables:
!
! REAL, INTENT(IN) :: sx, sy, sz
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TSC2( sx, sy, sz, xp, yp, zp )
!
! Routine to compute a 3-D arbitrary scaling transformation matrix
! and multiply it to the current 3-D transformation matrix.
!
! Scaling about point (xp,yp,zp), by the magnitudes (sx,sy,sz)
!
! Variables:
!
! REAL, INTENT(IN) :: sx, sy, sz, xp, yp, zp
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_D3TPD( d )
!
! Routine to compute a 3-D perspective transformation matrix and
! multiply it to the current 3-D transformation matrix.
!
! Perspective transformation make objects in distance look smaller
! than objects close to the screen. Since the +Z axis points into
! the screen, the smaller the Z values of a line segment, the smaller
! the line segment looks on the screen.
!
! Argument (d) control the degree of 3-D perspective transformation.
! In general it should be larger than the value of (Xmax-Xmin)
!
! Variables:
!
! REAL, INTENT(IN) :: d
!
!=====================================================================
! D1. Bivar (Bi-Variable) Interpolation
!=====================================================================
!
! SUBROUTINE NG_IDRSET()
!
! SUBROUTINE NG_IDSETI( PNAM, IVAL )
! SUBROUTINE NG_IDSETR( PNAM, RVAL )
!
! SUBROUTINE NG_IDGETI( PNAM, IVAL )
! SUBROUTINE NG_IDGETR( PNAM, RVAL )
!
! SUBROUTINE NG_IDSFFT( MD, NDP, XD, YD, ZD, NXI, NYI, NZI, XI, YI, ZI, IWK, WK )
!
! SUBROUTINE NG_IDBVIP( MD, NDP, XD, YD, ZD, NIP, XI, YI, ZI, IWK, WK )
!
! SUBROUTINE NG_IDPLTR( NDAT, XDAT, YDAT, IWRK )
!
!---------------------------------------------------------------------
!
! Internal parameters:
! ~~~~~~~~~~~~~~~~~~~~
!
! ITY - INTEGER
! ITY is the flag that says what type of interpolation to use
! (0 for quintic interpolation, 1 for linear interpolation).
! The default value is 0.
!
! TTY - INTEGER
! TTY is the flag that says what type of triangulation to use
! (0 for the original, 1 for the new).
! The default value is 0.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDSETI( PNAM, IVAL )
!
! Routine to st the integer value of the BIVAR parameter named PNAM
! from IVAL.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: PNAM
! INTEGER, INTENT(IN) :: IVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDSETR( PNAM, RVAL )
!
! Routine to st the real value of the BIVAR parameter named PNAM
! from RVAL.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: PNAM
! REAL, INTENT(IN) :: RVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDGETI( PNAM, IVAL )
!
! Routine to get in IVAL the integer value of the BIVAR parameter
! named PNAM.
!
! Variables:
!
! CHARACTER(*), INTENT(IN ) :: PNAM
! INTEGER, INTENT( OUT) :: IVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDGETR( PNAM, RVAL )
!
! Routine to get in RVAL the real value of the BIVAR parameter
! named PNAM.
!
! Variables:
!
! CHARACTER(*), INTENT(IN ) :: PNAM
! REAL, INTENT( OUT) :: RVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDSFFT( MD, NDP, XD, YD, ZD, NXI, NYI, NZI, XI, YI, ZI, IWK, WK )
!
! Routine to perform smooth surface fitting when the projections of
! the data points in the X-Y plane are irregularly distributed in
! the plane.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: MD
! INTEGER, INTENT(IN ) :: NDP
! REAL, INTENT(IN ) :: XD(NDP), YD(NDP), ZD(NDP)
! INTEGER, INTENT(IN ) :: NXI, NYI, NZI
! REAL, INTENT(IN ) :: XI(NXI), YI(NYI)
! REAL, INTENT( OUT) :: ZI(NZI,NYI)
! INTEGER :: IWK(31*NDP+NXI*NYI)
! REAL :: WK(6*NDP)
!
! MD
! Mode of computation (must be 1, 2, or 3,
! else an error return will occur).
! = 1 if this is the first call to this
! subroutine, or if the value of NDP
! has been changed from the previous
! call, or if the contents of the XD
! or YD arrays have been changed from
! the previous call.
! = 2 if the values of NDP and the XD and
! YD arrays are unchanged from the
! previous call, but new values for
! XI and YI are being used. If MD = 2
! and NDP has been changed since the
! previous call to IDSFFT, an error
! return occurs.
! = 3 if the values of NDP, NXI, NYI, XD,
! YD, XI, and YI are unchanged from the
! previous call, i.e., if the only change
! on input to IDSFFT is in the ZD array.
! If MD = 3 and NDP, NXI, or NYI has been
! changed since the previous call to
! IDSFFT, an error return occurs.
!
! Between the call with MD = 2 or MD = 3 and
! the preceding call, the IWK and WK work
! arrays should not be disturbed.
!
! NDP
! Number of data points (must be 4 or
! greater, else an error return will occur).
!
! XD
! Array of dimension NDP containing the X
! coordinates of the data points.
!
! YD
! Array of dimension NDP containing the Y
! coordinates of the data points.
!
! ZD
! Array of dimension NDP containing the Z
! coordinates of the data points.
!
! NXI
! Number of output grid points in the X
! direction (must be 1 or greater, else
! an error return will occur).
!
! NYI
! Number of output grid points in the Y
! direction (must be 1 or greater, else
! an error return will occur).
!
! NZI
! First dimension of ZI as declared in the
! calling program. NZI must be greater than
! or equal to NXI, else an error return will
! occur.
!
! XI
! Array of dimension NXI containing the
! X coordinates of the output grid points.
!
! YI
! Array of dimension NYI containing the
! Y coordinates of the output grid points.
!
! IWK
! Integer work array of dimension at
! least 31*NDP + NXI*NYI.
!
! WK
! Real work array of dimension at least 6*NDP.
!
! ZI
! Real, two-dimensional array of dimension
! (NZI,NYI), storing the interpolated Z
! values at the output grid points.
!
! Notes:
!
! Inadequate work space IWK and WK may cause
! incorrect results.
!
! The data points must be distinct and their
! projections in the X-Y plane must not be
! collinear, else an error return occurs.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDBVIP( MD, NDP, XD, YD, ZD, NIP, XI, YI, ZI, IWK, WK )
!
! Routine to perform bivariate interpolation when the projections of
! the data points in the X-Y plane are irregularly distributed.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: MD
! INTEGER, INTENT(IN ) :: NDP
! REAL, INTENT(IN ) :: XD(NDP), YD(NDP), ZD(NDP)
! INTEGER, INTENT(IN ) :: NIP
! REAL, INTENT(IN ) :: XI(NIP), YI(NIP)
! REAL, INTENT( OUT) :: ZI(NIP)
! INTEGER :: IWK(31*NDP+NIP)
! REAL :: WK(8*NDP)
!
! MD
! Mode of computation (must be 1, 2, or 3,
! else an error return occurs.)
! = 1 if this is the first call to this
! subroutine, or if the value of NDP
! has been changed from the previous
! call, or if the contents of the XD
! or YD arrays have been changed from
! the previous call.
! = 2 if the values of NDP and the XD and
! YD arrays are unchanged from the
! previous call, but new values for
! XI and YI are being used. If MD = 2
! and NDP has been changed since the
! previous call to IDBVIP, an error
! return occurs.
! = 3 if the values of NDP, NIP, XD, YD
! XI, and YI are unchanged from the
! previous call, i.e., if the only
! change on input to IDBVIP is in the
! ZD array. If MD=3 and NDP or NIP has
! been changed since the previous call
! to IDBVIP, an error return occurs.
!
! Between the call with MD=2 or MD=3 and
! the preceding call, the IWK and WK work
! arrays should not be disturbed.
!
! NDP
! Number of data points (must be 4 or
! greater, else an error return occurs).
!
! XD
! Array of dimension NDP containing the
! X coordinates of the data points.
!
! YD
! Array of dimension NDP containing the
! Y coordinates of the data points.
!
! ZD
! Array of dimension NDP containing the
! Z coordinates of the data points.
!
! NIP
! The number of output points at which
! interpolation is to be performed (must be
! 1 or greater, else an error return occurs).
!
! XI
! Array of dimension NIP containing the X
! coordinates of the output points.
!
! YI
! Array of dimension NIP containing the Y
! coordinates of the output points.
!
! IWK
! Integer work array of dimension at least
! 31*NDP + NIP
!
! WK
! Real work array of dimension at least 8*NDP
!
! ZI
! Array of dimension NIP where interpolated
! Z values are to be stored.
!
! Notes:
!
! Inadequate work space IWK and WK may cause
! incorrect results.
!
! The data points must be distinct and their
! projections in the X-Y plane must not be
! collinear, else an error return occurs.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IDPLTR( NDAT, XDAT, YDAT, IWRK )
!
! Routine to plot the triangulation. The arguments NDAT, XDAT, YDAT,
! YDAT, and IWRK are all as used in a previous call to either IDSFFT or
! IDBVIP:
!
! Variables:
!
! INTEGER, INTENT(IN) :: NDAT
! REAL, INTENT(IN) :: XDAT(NDAT), YDAT(NDAT)
! INTEGER :: IWRK(*)
!
! NDAT is the number of data points.
!
! (XDAT(I),I=1,NDAT) are the X coordinates of the data points.
!
! (YDAT(I),I=1,NDAT) are the Y coordinates of the data points.
!
! IWRK is the integer work array.
!
! Note that the caller is responsible for doing the SET call required
! to map the triangles to the correct position on the plotter frame.
!
! Note also that some triangle edges are drawn twice. No attempt is
! made to prevent this.
!
!=====================================================================
! D2. Bezier curve Interpolation
!=====================================================================
!
! SUBROUTINE NG_BCRSET()
!
! SUBROUTINE NG_BCSETI( PA, IVAL )
! SUBROUTINE NG_BCSETR( PA, RVAL )
!
! SUBROUTINE NG_BCGETI( PA, IVAL )
! SUBROUTINE NG_BCGETR( PA, RVAL )
!
! SUBROUTINE NG_BCCURV( BXI, BYI, NO, XO, YO, NPTS )
!
! SUBROUTINE NG_BCFCRV( BXI, BYI, NO, XO, YO )
!
!---------------------------------------------------------------------
!
! Internal parameters:
! ~~~~~~~~~~~~~~~~~~~~
!
! NPC - INTEGER
! A flag to indicate whether the recursive subdivision
! algorithm will be overridden. If NPPC < 2 (the
! default), then recursive subdivision will be utilized;
! if NPPC>=2 and NPPC<=128, then that many points
! will be returned along the curve at equally spaced
! values for the parameter in the parametric definition
! of the curve.
!
! FTL - REAL
! The tolerance limit for the recursive subdivision
! algorithm. This limit specifies how close the
! interpolated curve must be to the actual Bezier
! curve before subdivision ceases. This ratio is
! specified as a ratio of the maximum screen height
! (the maximum Y extent in user space that can be mapped
! onto the unit interval in NDC space). It is applied
! to the current user space to get a value in user
! coordinates. As implemented the subdivision will
! cease after eight levels under any circumstance.
! The default value is 0.00003.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCRSET()
!
! Routine to reset internal parameters to its default.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCSETI( PA, IVAL )
!
! Routine to set integer-valued parameters for the Bezier curve package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: PA
! INTEGER, INTENT(IN) :: IVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCSETR( PA, RVAL )
!
! Routine to set real-valued parameters for the Bezier curve package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN) :: PA
! REAL, INTENT(IN) :: RVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCGETI( PA, IVAL )
!
! Routine to retrieve integer-valued parameters for the Bezier curve
! package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN ) :: PA
! INTEGER, INTENT( OUT) :: IVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCGETR( PA, RVAL )
!
! Routine to retrieve real-valued parameters for the Bezier curve
! package.
!
! Variables:
!
! CHARACTER(*), INTENT(IN ) :: PA
! REAL, INTENT( OUT) :: RVAL
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCCURV( BXI, BYI, NO, XO, YO, NPTS )
!
! This subroutine calculates points along a Bezier curve whose
! four control points are given in BXI and BYI. In the default
! case a recursive subdivision algorithm is implemented that
! calculates the points along the curve to within a predefined
! tolerance limit.
!
! Variables:
!
! REAL, INTENT(IN ) :: BXI(4), BYI(4)
! INTEGER, INTENT(IN ) :: NO
! REAL, INTENT( OUT) :: XO(NO),YO(NO)
! INTEGER, INTENT( OUT) :: NPTS
!
! BXI -- The X coordinates for four Bezier control points.
! BYI -- The Y coordinates for four Bezier control points.
! NO -- The deminsion of the output arrays XO and YO.
! XO -- The interpolated X coordinates for the points along
! the Bezier curve that is defined by the input control
! points.
! YO -- The interpolated Y coordinates for the points along
! the Bezier curve that is defined by the input control
! points.
! NPTS -- The number of points returned in XO and YO. NPTS
! must be less than NO or an error results.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BCFCRV( BXI, BYI, NO, XO, YO )
!
! This subroutine takes the four Bezier specification points in
! BXI and BYI and returns an array of points ((XO(L),YO(L),L=1,NO)
! along the Bezier curve using the cubic parametric equations for
! the Bezier curve. This subroutine is invoked only when the
! subdivision algorithm is being overridden by user request.
!
! Variables:
!
! REAL, INTENT(IN ) :: BXI(4), BYI(4)
! INTEGER, INTENT(IN ) :: NO
! REAL, INTENT( OUT) :: XO(NO), YO(NO)
!
!=====================================================================
! D3. Smoothers
!=====================================================================
!
! SUBROUTINE NG_MSKRV1( N, X, Y, SLP1, SLPN, XP, YP, TEMP, S, SIGMA, ISLPSW )
! SUBROUTINE NG_MSKRV2( T, XS, YS, N, X, Y, XP, YP, S, SIGMA, ICS, SLP )
!
! SUBROUTINE NG_MSBSF1( M, N, XMIN, XMAX, YMIN, YMAX, Z, IZ, ZP, TEMP, SIGMA)
! SUBROUTINE NG_MSBSF2( DXMIN, DXMAX, MD, DYMIN, DYMAX, ND, DZ, IDZ, M, N, &
! XMIN, XMAX, YMIN, YMAX, Z, IZ, ZP, WORK, SIGMA )
!
! SUBROUTINE NG_MSSRF1( M, N, X, Y, Z, IZ, ZX1, ZXM, ZY1, ZYN, ZXY11, ZXYM1, &
! ZXY1N, ZXYMN, ISLPSW, ZP, TEMP, SIGMA, IERR )
! FUNCTION NG_MSSRF2( XX, YY, M, N, X, Y, Z, IZ, ZP, SIGMA )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MSKRV1( N, X, Y, SLP1, SLPN, XP, YP, TEMP, S,&
! SIGMA, ISLPSW )
!
! THIS SUBROUTINE DETERMINES THE PARAMETERS NECESSARY TO
! COMPUTE A SPLINE UNDER TENSION FORMING A CURVE IN THE
! PLANE AND PASSING THROUGH A SEQUENCE OF PAIRS (X(1),Y(1)),
! ...,(X(N),Y(N)). FOR ACTUAL COMPUTATION OF POINTS ON THE
! CURVE IT IS NECESSARY TO CALL THE SUBROUTINE NG_MSKRV2.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: N
! REAL, INTENT(IN ) :: X(N), Y(N)
! REAL, INTENT(IN ) :: SLP1, SLPN, SIGMA
! INTEGER, INTENT(IN ) :: ISLPSW
! REAL, INTENT( OUT) :: XP(N), YP(N), S(N)
! REAL :: TEMP(N) ! working array
!
! ON INPUT--
!
! N IS THE NUMBER OF POINTS TO BE INTERPOLATED (N.GE.2).
!
! X IS AN ARRAY CONTAINING THE N X-COORDINATES OF THE
! POINTS.
!
! Y IS AN ARRAY CONTAINING THE N Y-COORDINATES OF THE
! POINTS. (ADJACENT X-Y PAIRS MUST BE DISTINCT, I. E.
! EITHER X(I) .NE. X(I+1) OR Y(I) .NE. Y(I+1), FOR
! I = 1,...,N-1.)
!
! SLP1 AND SLPN CONTAIN THE DESIRED VALUES FOR THE ANGLES
! (IN DEGREES) OF THE SLOPE AT (X(1),Y(1)) AND (X(N),Y(N))
! RESPECTIVELY. THE ANGLES ARE MEASURED COUNTER-CLOCK-
! WISE FROM THE X-AXIS AND THE POSITIVE SENSE OF THE CURVE
! IS ASSUMED TO BE THAT MOVING FROM POINT 1 TO POINT N.
! THE USER MAY OMIT VALUES FOR EITHER OR BOTH OF THESE
! PARAMETERS AND SIGNAL THIS WITH ISLPSW.
!
! XP AND YP ARE ARRAYS OF LENGTH AT LEAST N.
!
! TEMP IS AN ARRAY OF LENGTH AT LEAST N WHICH IS USED
! FOR SCRATCH STORAGE.
!
! S IS AN ARRAY OF LENGTH AT LEAST N.
!
! SIGMA CONTAINS THE TENSION FACTOR. THIS VALUE INDICATES
! THE CURVINESS DESIRED. IF ABS(SIGMA) IS NEARLY ZERO
! (E.G. .001) THE RESULTING CURVE IS APPROXIMATELY A CUBIC
! SPLINE. IF ABS(SIGMA) IS LARGE (E. G. 50.) THE RESULTING
! CURVE IS NEARLY A POLYGONAL LINE. IF SIGMA EQUALS ZERO A
! CUBIC SPLINE RESULTS. A STANDARD VALUE FOR SIGMA IS
! APPROXIMATELY 1. IN ABSOLUTE VALUE.
!
! ISLPSW CONTAINS A SWITCH INDICATING WHICH SLOPE DATA
! SHOULD BE USED AND WHICH SHOULD BE ESTIMATED BY THIS
! SUBROUTINE,
! = 0 IF SLP1 AND SLPN ARE TO BE USED,
! = 1 IF SLP1 IS TO BE USED BUT NOT SLPN,
! = 2 IF SLPN IS TO BE USED BUT NOT SLP1,
! = 3 IF BOTH SLP1 AND SLPN ARE TO BE ESTIMATED
! INTERNALLY.
! = 4 IF BOTH SLP1 AND SLPN ARE TO BE ESTIMATED
! INTERNALLY, SUBJECT TO THE CONDITIONS THAT
! N.GE.3, X(N)=X(1), AND Y(N)=Y(1).
!
! ON OUTPUT--
!
! XP AND YP CONTAIN INFORMATION ABOUT THE CURVATURE OF THE
! CURVE AT THE GIVEN NODES.
!
! S CONTAINS THE POLYGONAL ARCLENGTHS OF THE CURVE.
!
! N, X, Y, SLP1, SLPN, ISLPSW, AND SIGMA ARE UNALTERED.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MSKRV2( T, XS, YS, N, X, Y, XP, YP, S, SIGMA,&
! ICS, SLP )
!
! THIS SUBROUTINE PERFORMS THE MAPPING OF POINTS IN THE
! INTERVAL (0.,1.) ONTO A CURVE IN THE PLANE. THE SUBROUTINE
! NG_MSKRV1 SHOULD BE CALLED EARLIER TO DETERMINE CERTAIN
! NECESSARY PARAMETERS. THE RESULTING CURVE HAS A PARAMETRIC
! REPRESENTATION BOTH OF WHOSE COMPONENTS ARE SPLINES UNDER
! TENSION AND FUNCTIONS OF THE POLYGONAL ARCLENGTH
! PARAMETER.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: N, ICS
! REAL, INTENT(IN ) :: X(N), Y(N), XP(N), YP(N), S(N)
! REAL, INTENT(IN ) :: T, SIGMA
! REAL, INTENT( OUT) :: XS, YS
! REAL :: SLP ! INTENT(OUT), if ICS/=0
!
! ON INPUT--
!
! T CONTAINS A REAL VALUE TO BE MAPPED TO A POINT ON THE
! CURVE. THE INTERVAL (0.,1.) IS MAPPED ONTO THE ENTIRE
! CURVE, WITH 0. MAPPING TO (X(1),Y(1)) AND 1. MAPPING
! TO (X(N),Y(N)). VALUES OUTSIDE THIS INTERVAL RESULT IN
! EXTRAPOLATION.
!
! N CONTAINS THE NUMBER OF POINTS WHICH WERE SPECIFIED
! TO DETERMINE THE CURVE.
!
! X AND Y ARE ARRAYS CONTAINING THE X- AND Y-COORDINATES
! OF THE SPECIFIED POINTS.
!
! XP AND YP ARE THE ARRAYS OUTPUT FROM NG_MSKRV1 CONTAINING
! CURVATURE INFORMATION.
!
! S IS AN ARRAY CONTAINING THE POLYGONAL ARCLENGTHS OF
! THE CURVE.
!
! SIGMA CONTAINS THE TENSION FACTOR (ITS SIGN IS IGNORED).
!
! ICS IS A FLAG, NON-ZERO IF THE ANGLE OF THE SLOPE IS TO
! BE COMPUTED AND RETURNED AS WELL.
!
! THE PARAMETERS N, X, Y, XP, YP, S, AND SIGMA SHOULD BE
! INPUT UNALTERED FROM THE OUTPUT OF NG_MSKRV1.
!
! ON OUTPUT--
!
! XS AND YS CONTAIN THE X- AND Y-COORDINATES OF THE IMAGE
! POINT ON THE CURVE.
!
! IF ICS IS NON-ZERO, SLP CONTAINS THE ANGLE (IN DEGREES)
! OF THE SLOPE AT THE POINT.
!
! NONE OF THE INPUT PARAMETERS ARE ALTERED.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MSBSF1( M, N, XMIN, XMAX, YMIN, YMAX, Z, IZ, ZP, TEMP,&
! SIGMA)
!
! THIS SUBROUTINE DETERMINES THE PARAMETERS NECESSARY TO
! COMPUTE AN INTERPOLATORY SURFACE PASSING THROUGH A RECT-
! ANGULAR GRID OF FUNCTIONAL VALUES. THE X AND Y VALUES ARE
! ASSUMED EQUALLY SPACED IN THE GRID. THE SURFACE DETERMINED
! CAN BE REPRESENTED AS THE TENSOR PRODUCT OF SPLINES UNDER
! TENSION. FOR ACTUAL INTERPOLATION AT A GRID OF POINTS
! EQUALLY SPACED IN BOTH X AND Y COORDINATES IT IS NECESSARY
! TO CALL SUBROUTINE NG_MSBSF2.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: M, N, IZ
! REAL, INTENT(IN ) :: Z(IZ,N)
! REAL, INTENT(IN ) :: XMIN, XMAX, YMIN, YMAX, SIGMA
! REAL, INTENT( OUT) :: ZP(M,N,3)
! REAL :: TEMP(N+N+M) ! workimg array
!
! ON INPUT--
!
! M IS THE NUMBER OF GRID LINES IN THE X-DIRECTION, I. E.
! LINES PARALLEL TO THE Y-AXIS (M .GE. 2).
!
! N IS THE NUMBER OF GRID LINES IN THE Y-DIRECTION, I. E.
! LINES PARALLEL TO THE X-AXIS (N .GE. 2).
!
! XMIN AND XMAX ARE THE LOWER AND UPPER LIMITS,
! RESPECTIVELY, OF THE GRID IN THE X-DIRECTION. XMAX
! SHOULD BE GREATER THAN XMIN.
!
! YMIN AND YMAX ARE THE LOWER AND UPPER LIMITS,
! RESPECTIVELY, OF THE GRID IN THE Y-DIRECTION. YMAX
! SHOULD BE GREATER THAN YMIN.
!
! Z IS AN ARRAY OF THE M * N FUNCTIONAL VALUES AT THE GRID
! POINTS, I. E. Z(I,J) CONTAINS THE FUNCTIONAL VALUE AT
! (X(I),Y(J)) FOR I = 1,...,M AND J = 1,...,N, WHERE X(I)
! REPRESENTS THE I-TH EQUISPACED X VALUE, AND Y(J)
! REPRESENTS THE J-TH EQUISPACED Y VALUE.
!
! IZ IS THE ROW DIMENSION OF THE MATRIX Z USED IN THE
! CALLING PROGRAM (IZ .GE. M).
!
! ZP IS AN ARRAY OF AT LEAST 3*M*N LOCATIONS.
!
! TEMP IS AN ARRAY OF AT LEAST N+N+M LOCATIONS WHICH IS
! USED FOR SCRATCH STORAGE.
!
! SIGMA CONTAINS THE TENSION FACTOR. THIS VALUE INDICATES
! THE CURVINESS DESIRED. IF ABS(SIGMA) IS NEARLY ZERO
! (E. G. .001) THE RESULTING SURFACE IS APPROXIMATELY THE
! TENSOR PRODUCT OF CUBIC SPLINES. IF ABS(SIGMA) IS LARGE
! (E. G. 50.) THE RESULTING SURFACE IS APPROXIMATELY
! BI-LINEAR. IF SIGMA EQUALS ZERO TENSOR PRODUCTS OF
! CUBIC SPLINES RESULT. A STANDARD VALUE FOR SIGMA IS
! APPROXIMATELY 1. IN ABSOLUTE VALUE.
!
! ON OUTPUT--
!
! ZP CONTAINS THE VALUES OF THE XX-, YY-, AND XXYY-PARTIAL
! DERIVATIVES OF THE SURFACE AT THE GIVEN NODES.
!
! M, N, XMIN, XMAX, YMIN, YMAX, Z, IZ, AND SIGMA ARE
! UNALTERED.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MSBSF2( DXMIN, DXMAX, MD, DYMIN, DYMAX, ND,&
! DZ, IDZ, M, N, XMIN, XMAX, YMIN, YMAX,&
! Z, IZ, ZP, WORK, SIGMA )
!
! THIS SUBROUTINE MAPS VALUES ONTO A SURFACE AT EVERY POINT
! OF A GRID EQUALLY SPACED IN BOTH X AND Y COORDINATES. THE
! SURFACE INTERPOLATION IS PERFORMED USING A BI-SPLINE UNDER
! TENSION. THE SUBROUTINE NG_MSBSF1 SHOULD BE CALLED EARLIER TO
! DETERMINE CERTAIN NECESSARY PARAMETERS. IN BOTH NG_MSBSF1 AND
! NG_MSBSF2, THE ORIGINAL GRID IS ASSUMED TO BE EQUALLY SPACED
! IN THE X AND Y COORDINATES.
!
! Variables:
!
! REAL, INTENT(IN ) :: DXMIN, DXMAX, DYMIN, DYMAX
! REAL, INTENT(IN ) :: XMIN, XMAX, YMIN, YMAX, SIGMA
! INTEGER, INTENT(IN ) :: M, N, IZ
! REAL, INTENT(IN ) :: Z(IZ,N), ZP(M,N,3)
! INTEGER, INTENT(IN ) :: MD, ND, IDZ
! REAL, INTENT( OUT) :: DZ(IDZ,ND)
! REAL :: WORK(4,MD) ! working array
!
! ON INPUT--
!
! DXMIN AND DXMAX CONTAIN THE LOWER AND UPPER LIMITS,
! RESPECTIVELY, OF THE X-COORDINATES OF THE SECOND GRID.
!
! MD CONTAINS THE NUMBER OF GRID LINES IN THE X DIRECTION
! OF THE SECOND GRID (MD .GE. 1).
!
! DYMIN AND DYMAX CONTAIN THE LOWER AND UPPER LIMITS,
! RESPECTIVELY, OF THE Y-COORDINATES OF THE SECOND GRID.
!
! ND CONTAINS THE NUMBER OF GRID LINES IN THE Y DIRECTION
! OF THE SECOND GRID (ND .GE. 1).
!
! IDZ CONTAINS THE ROW DIMENSION OF THE ARRAY DZ AS
! DECLARED IN THE CALLING PROGRAM.
!
! M AND N CONTAIN THE NUMBER OF GRID LINES IN THE X- AND
! Y-DIRECTIONS, RESPECTIVELY, OF THE RECTANGULAR GRID
! WHICH SPECIFIED THE SURFACE.
!
! XMIN AND XMAX ARE THE LOWER AND UPPER LIMITS,
! RESPECTIVELY, OF THE GRID IN THE X DIRECTION.
!
! YMIN AND YMAX ARE THE LOWER AND UPPER LIMITS,
! RESPECTIVELY, OF THE GRID IN THE Y DIRECTION.
!
! Z IS A MATRIX CONTAINING THE M * N FUNCTIONAL VALUES
! CORRESPONDING TO THE GRID VALUES (I. E. Z(I,J) IS THE
! SURFACE VALUE AT THE POINT (X(I),Y(J)) FOR I = 1,...,M
! AND J = 1,...,N, WHERE X(I) REPRESENTS THE I-TH
! EQUISPACED X VALUE AND Y(J) REPRESENTS THE J-TH
! EQUISPACED Y VALUE).
!
! IZ CONTAINS THE ROW DIMENSION OF THE ARRAY Z AS DECLARED
! IN THE CALLING PROGRAM.
!
! ZP IS AN ARRAY OF 3*M*N LOCATIONS STORED WITH THE
! VARIOUS SURFACE DERIVATIVE INFORMATION DETERMINED BY
! SURF1.
!
! WORK IS AN ARRAY OF 4*MD LOCATIONS TO BE USED INTERNALLY
! FOR WORKSPACE.
!
! SIGMA CONTAINS THE TENSION FACTOR (ITS SIGN IS IGNORED).
!
! THE PARAMETERS M, N, XMIN, XMAX, YMIN, YMAX, Z, IZ, ZP,
! AND SIGMA SHOULD BE INPUT UNALTERED FROM THE OUTPUT OF
! NG_MSBSF1.
!
! ON OUTPUT--
!
! DZ CONTAINS THE MD BY ND ARRAY OF SURFACE VALUES
! INTERPOLATED AT THE POINTS OF THE SECOND GRID.
!
! NONE OF THE INPUT PARAMETERS ARE ALTERED.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MSSRF1( M, N, X, Y, Z, IZ, ZX1, ZXM, ZY1, ZYN,&
! ZXY11, ZXYM1, ZXY1N, ZXYMN, ISLPSW, ZP,&
! TEMP, SIGMA, IERR )
!
! THIS SUBROUTINE DETERMINES THE PARAMETERS NECESSARY TO
! COMPUTE AN INTERPOLATORY SURFACE PASSING THROUGH A RECT-
! ANGULAR GRID OF FUNCTIONAL VALUES. THE SURFACE DETERMINED
! CAN BE REPRESENTED AS THE TENSOR PRODUCT OF SPLINES UNDER
! TENSION. THE X- AND Y-PARTIAL DERIVATIVES AROUND THE
! BOUNDARY AND THE X-Y-PARTIAL DERIVATIVES AT THE FOUR
! CORNERS MAY BE SPECIFIED OR OMITTED. FOR ACTUAL MAPPING
! OF POINTS ONTO THE SURFACE IT IS NECESSARY TO CALL THE
! FUNCTION NG_MSSRF2.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: M, N, IZ, ISLPSW
! REAL, INTENT(IN ) :: X(M), Y(N), Z(IZ,N)
! REAL, INTENT(IN ) :: ZX1(N), ZXM(N), ZY1(M), ZYN(M)
! REAL, INTENT(IN ) :: ZXY11, ZXYM1, ZXY1N, ZXYMN, SIGMA
! REAL, INTENT( OUT) :: ZP(M,N,3)
! INTEGER, INTENT( OUT) :: IERR
! REAL :: TEMP(N+N+M) ! working array
!
! ON INPUT--
!
! M IS THE NUMBER OF GRID LINES IN THE X-DIRECTION, I. E.
! LINES PARALLEL TO THE Y-AXIS (M >= 2).
!
! N IS THE NUMBER OF GRID LINES IN THE Y-DIRECTION, I. E.
! LINES PARALLEL TO THE X-AXIS (N >= 2).
!
! X IS AN ARRAY OF THE M X-COORDINATES OF THE GRID LINES
! IN THE X-DIRECTION. THESE SHOULD BE STRICTLY INCREASING.
!
! Y IS AN ARRAY OF THE N Y-COORDINATES OF THE GRID LINES
! IN THE Y-DIRECTION. THESE SHOULD BE STRICTLY INCREASING.
!
! Z IS AN ARRAY OF THE M * N FUNCTIONAL VALUES AT THE GRID
! POINTS, I. E. Z(I,J) CONTAINS THE FUNCTIONAL VALUE AT
! (X(I),Y(J)) FOR I = 1,...,M AND J = 1,...,N.
!
! IZ IS THE ROW DIMENSION OF THE MATRIX Z USED IN THE
! CALLING PROGRAM (IZ >= M).
!
! ZX1 AND ZXM ARE ARRAYS OF THE M X-PARTIAL DERIVATIVES
! OF THE FUNCTION ALONG THE X(1) AND X(M) GRID LINES,
! RESPECTIVELY. THUS ZX1(J) AND ZXM(J) CONTAIN THE X-PART-
! IAL DERIVATIVES AT THE POINTS (X(1),Y(J)) AND
! (X(M),Y(J)), RESPECTIVELY, FOR J = 1,...,N. EITHER OF
! THESE PARAMETERS WILL BE IGNORED (AND APPROXIMATIONS
! SUPPLIED INTERNALLY) IF ISLPSW SO INDICATES.
!
! ZY1 AND ZYN ARE ARRAYS OF THE N Y-PARTIAL DERIVATIVES
! OF THE FUNCTION ALONG THE Y(1) AND Y(N) GRID LINES,
! RESPECTIVELY. THUS ZY1(I) AND ZYN(I) CONTAIN THE Y-PART-
! IAL DERIVATIVES AT THE POINTS (X(I),Y(1)) AND
! (X(I),Y(N)), RESPECTIVELY, FOR I = 1,...,M. EITHER OF
! THESE PARAMETERS WILL BE IGNORED (AND ESTIMATIONS
! SUPPLIED INTERNALLY) IF ISLPSW SO INDICATES.
!
! ZXY11, ZXYM1, ZXY1N, AND ZXYMN ARE THE X-Y-PARTIAL
! DERIVATIVES OF THE FUNCTION AT THE FOUR CORNERS,
! (X(1),Y(1)), (X(M),Y(1)), (X(1),Y(N)), AND (X(M),Y(N)),
! RESPECTIVELY. ANY OF THE PARAMETERS WILL BE IGNORED (AND
! ESTIMATIONS SUPPLIED INTERNALLY) IF ISLPSW SO INDICATES.
!
! ISLPSW CONTAINS A SWITCH INDICATING WHICH BOUNDARY
! DERIVATIVE INFORMATION IS USER-SUPPLIED AND WHICH
! SHOULD BE ESTIMATED BY THIS SUBROUTINE. TO DETERMINE
! ISLPSW, LET
! I1 = 0 IF ZX1 IS USER-SUPPLIED (AND = 1 OTHERWISE),
! I2 = 0 IF ZXM IS USER-SUPPLIED (AND = 1 OTHERWISE),
! I3 = 0 IF ZY1 IS USER-SUPPLIED (AND = 1 OTHERWISE),
! I4 = 0 IF ZYN IS USER-SUPPLIED (AND = 1 OTHERWISE),
! I5 = 0 IF ZXY11 IS USER-SUPPLIED
! (AND = 1 OTHERWISE),
! I6 = 0 IF ZXYM1 IS USER-SUPPLIED
! (AND = 1 OTHERWISE),
! I7 = 0 IF ZXY1N IS USER-SUPPLIED
! (AND = 1 OTHERWISE),
! I8 = 0 IF ZXYMN IS USER-SUPPLIED
! (AND = 1 OTHERWISE),
! THEN ISLPSW = I1 + 2*I2 + 4*I3 + 8*I4 + 16*I5 + 32*I6
! + 64*I7 + 128*I8
! THUS ISLPSW = 0 INDICATES ALL DERIVATIVE INFORMATION IS
! USER-SUPPLIED AND ISLPSW = 255 INDICATES NO DERIVATIVE
! INFORMATION IS USER-SUPPLIED. ANY VALUE BETWEEN THESE
! LIMITS IS VALID.
!
! ZP IS AN ARRAY OF AT LEAST 3*M*N LOCATIONS.
!
! TEMP IS AN ARRAY OF AT LEAST N+N+M LOCATIONS WHICH IS
! USED FOR SCRATCH STORAGE.
!
! AND
!
! SIGMA CONTAINS THE TENSION FACTOR. THIS VALUE INDICATES
! THE CURVINESS DESIRED. IF ABS(SIGMA) IS NEARLY ZERO
! (E. G. .001) THE RESULTING SURFACE IS APPROXIMATELY THE
! TENSOR PRODUCT OF CUBIC SPLINES. IF ABS(SIGMA) IS LARGE
! (E. G. 50.) THE RESULTING SURFACE IS APPROXIMATELY
! BI-LINEAR. IF SIGMA EQUALS ZERO TENSOR PRODUCTS OF
! CUBIC SPLINES RESULT. A STANDARD VALUE FOR SIGMA IS
! APPROXIMATELY 1. IN ABSOLUTE VALUE.
!
! ON OUTPUT--
!
! ZP CONTAINS THE VALUES OF THE XX-, YY-, AND XXYY-PARTIAL
! DERIVATIVES OF THE SURFACE AT THE GIVEN NODES.
!
! IERR CONTAINS AN ERROR FLAG,
! = 0 FOR NORMAL RETURN,
! = 1 IF N IS LESS THAN 2 OR M IS LESS THAN 2,
! = 2 IF THE X-VALUES OR Y-VALUES ARE NOT STRICTLY
! INCREASING.
!
! AND
!
! M, N, X, Y, Z, IZ, ZX1, ZXM, ZY1, ZYN, ZXY11, ZXYM1,
! ZXY1N, ZXYMN, ISLPSW, AND SIGMA ARE UNALTERED.
!
!---------------------------------------------------------------------
!
! REAL FUNCTION NG_MSSRF2( XX, YY, M, N, X, Y, Z, IZ, ZP, SIGMA )
!
! THIS FUNCTION INTERPOLATES A SURFACE AT A GIVEN COORDINATE
! PAIR USING A BI-SPLINE UNDER TENSION. THE SUBROUTINE NG_MSSRF1
! SHOULD BE CALLED EARLIER TO DETERMINE CERTAIN NECESSARY
! PARAMETERS.
!
! Variables:
!
! INTEGER, INTENT(IN) :: M, N, IZ
! REAL, INTENT(IN) :: X(M), Y(N), Z(IZ,N), ZP(M,N,3)
! REAL, INTENT(IN) :: XX, YY, SIGMA
!
! ON INPUT--
!
! XX AND YY CONTAIN THE X- AND Y-COORDINATES OF THE POINT
! TO BE MAPPED ONTO THE INTERPOLATING SURFACE.
!
! M AND N CONTAIN THE NUMBER OF GRID LINES IN THE X- AND
! Y-DIRECTIONS, RESPECTIVELY, OF THE RECTANGULAR GRID
! WHICH SPECIFIED THE SURFACE.
!
! X AND Y ARE ARRAYS CONTAINING THE X- AND Y-GRID VALUES,
! RESPECTIVELY, EACH IN INCREASING ORDER.
!
! Z IS A MATRIX CONTAINING THE M * N FUNCTIONAL VALUES
! CORRESPONDING TO THE GRID VALUES (I. E. Z(I,J) IS THE
! SURFACE VALUE AT THE POINT (X(I),Y(J)) FOR I = 1,...,M
! AND J = 1,...,N).
!
! IZ CONTAINS THE ROW DIMENSION OF THE ARRAY Z AS DECLARED
! IN THE CALLING PROGRAM.
!
! ZP IS AN ARRAY OF 3*M*N LOCATIONS STORED WITH THE
! VARIOUS SURFACE DERIVATIVE INFORMATION DETERMINED BY
! NG_MSSRF1.
!
! AND
!
! SIGMA CONTAINS THE TENSION FACTOR (ITS SIGN IS IGNORED).
!
! THE PARAMETERS M, N, X, Y, Z, IZ, ZP, AND SIGMA SHOULD BE
! INPUT UNALTERED FROM THE OUTPUT OF NG_MSSRF1.
!
! ON OUTPUT--
!
! NG_MSSRF2 CONTAINS THE INTERPOLATED SURFACE VALUE.
!
! NONE OF THE INPUT PARAMETERS ARE ALTERED.
!
!=====================================================================
! D4. Cubic Spline Interpolation
!=====================================================================
!
! SUBROUTINE NG_LENCSP( C, DC, T, NDIM, NC, ID )
!
! SUBROUTINE NG_OPNCSP( C, DC, T, NDIM, NC, ID )
! SUBROUTINE NG_CLDCSP( C, DC, T, NDIM, NC )
!
! SUBROUTINE NG_CSPDIF( C, DC, T, CC, DCC, TT, NDIM, NC )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_LENCSP( C, DC, T, NDIM, NC, ID )
!
! INTEGER, INTENT(IN ) :: NDIM, NC, ID
! REAL, INTENT(IN ) :: C(NDIM,0:NC)
! REAL, INTENT(INOUT) :: DC(NDIM,0:NC) ! (IN), f.b.c, for ID=1
! REAL, INTENT( OUT) :: T( 0:NC)
!
! Routine to solve for cubic spline first derivatives, the parametric
! values array are calculated based on arc length of spline.
!
! Variables:
!
! C - array of point coordinates, of size (NDIM,0:NC)
!
! DC - array of first derivatives of spline,
! of size (NDIM,0:NC)
!
! T - array of parametric values, of size (0:NC)
!
! NDIM - dimension of curve
!
! NC - point count
!
! ID - flag to indicate the type of spline curve
! = 0 closed
! = 1 open with f.b.c
! = 2 open with n.b.c
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_OPNCSP( C, DC, T, NDIM, NC, ID )
!
! INTEGER, INTENT(IN ) :: NDIM, NC, ID
! REAL, INTENT(IN ) :: C(NDIM,0:NC), T(0:NC)
! REAL, INTENT(INOUT) :: DC(NDIM,0:NC) ! (IN), f.b.c, for ID=1
!
! Routine to solve for open cubic spline first derivatives, the
! parametric values array are given by user.
!
! Variables:
!
! C - array of point coordinates, of size (NDIM,0:NC)
!
! DC - array of first derivatives of spline,
! of size (NDIM,0:NC)
!
! T - array of parametric values, of size (0:NC)
!
! NDIM - dimension of curve
!
! NC - point count
!
! ID - flag to indicate if a forced (ID=1) or
! a natural cubic spline (ID=2) is required
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_CLDCSP( C, DC, T, NDIM, NC )
!
! INTEGER, INTENT(IN ) :: NDIM, NC
! REAL, INTENT(IN ) :: C(NDIM,0:NC), T(0:NC)
! REAL, INTENT( OUT) :: DC(NDIM,0:NC)
!
! Routine to solve for closed cubic spline first derivatives. the
! parametric values array are given by user.
!
! Variables:
!
! C - array of point coordinates, of size (NDIM,0:NC)
!
! DC - array of first derivatives of spline,
! of size (NDIM,0:NC)
!
! T - array of parametric values, of size (0:NC)
!
! NDIM - dimension of curve
!
! NC - point count, the first and last points must be
! identical and is counted twice
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_CSPDIF( C, DC, T, CC, DCC, TT, NDIM, NC )
!
! INTEGER, INTENT(IN ) :: NDIM, NC
! REAL, INTENT(IN ) :: C(NDIM,0:NC), DC(NDIM,0:NC), T(0:NC)
! REAL, INTENT(IN ) :: TT
! REAL, INTENT( OUT) :: CC(NDIM), DCC(NDIM)
!
! Routine to calculate point coordinates and derivatives on a given
! cubic spline.
!
! Variables:
!
! C - array of point coordinates, of size (NDIM,0:NC)
!
! DC - array of derivatives, of size (NDIM,0:NC)
!
! T - array of parametric values, of size (0:NC)
!
! TT - the given parametric value whose corresponding point
! coordinates are to be found
!
! CC - point coordinates to be found, of size (NDIM)
!
! DCC - derivatives of point, of size (NDIM)
!
! NDIM - dimension of curve
!
! NC - point count. for closed curve, the first and last
! points must be identical and is counted twice
!
!=====================================================================
! E. Pack/Unpack Bits
!=====================================================================
!
! SUBROUTINE NG_SBYTES( NPACK, ISAM, IBIT, NBITS, NSKIP, ITER )
!
! SUBROUTINE NG_GBYTES( NPACK, ISAM, IBIT, NBITS, NSKIP, ITER )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_SBYTES( NPACK, ISAM, IBIT, NBITS, NSKIP, ITER )
!
! INTEGER, INTENT(INOUT) :: NPACK(*)
! INTEGER, INTENT(IN ) :: ISAM (*)
! INTEGER, INTENT(IN ) :: IBIT, NBITS, NSKIP, ITER
!
! This subroutine packs bits from the input array ISAM to the
! output array NPACK. After skipping "IBIT" bits in NPACK,
! the "NBITS" rightmost bits from "ITER" successive words
! in "ISAM" are packed into "NPACK" with "NSKIP" bits between each
! moved block.
!
! Variables:
!
! NPACK - Address of the first word of the array to be packed.
!
! ISAM - Array to be packed into NPACK. The right-most NBITS
! bits of each word will be packed. ISAM should be
! dimensioned for at least ITER.
!
! IBIT - A bit-count offset to be used before the first bits are
! packed into NPACK. For example, if IBIT=3 and NBITS=5,
! 3 bits in NPACK will be skipped before the right-most
! 5 bits of ISAM(1) are packed into it.
!
! NBITS - The number of bits in each word of ISAM to be unpacked.
! NBITS must not exceed the word size on the given machine.
!
! NSKIP - The number of bits to skip in NPACK between packing each
! bit chunk from ISAM.
!
! ITER - The number of bit chunks to be packed.
!
! Example:
!
! CALL NG_SBYTES(NPC,ISB,45,6,3,2)
!
! In this call, 45 bits would be skipped at the beginning of NPC;
! the right-most 6 bits of ISB(1) would be packed into NPC; 3 bits
! would be skipped in NPC; the right-most 6 bits of ISB(2) would
! be packed into NPC.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GBYTES( NPACK, ISAM, IBIT, NBITS, NSKIP, ITER )
!
! INTEGER, INTENT(IN ) :: NPACK(*)
! INTEGER, INTENT( OUT) :: ISAM (*)
! INTEGER, INTENT(IN ) :: IBIT, NBITS, NSKIP, ITER
!
! This subroutine unpacks bit chunks from the input array NPACK
! into the output array ISAM. "ITER" bit chunks of length
! "NBITS" with "NSKIP" bits being skipped between each bit
! chunk in the input array are unpacked into ISAM. Each
! bit chunk in the input array it unpacked into a separate
! word in ISAM, right-justified with zero-fill. Initially
! "IBIT" bits will be skipped at the beginning of the
! input array before unpacking.
!
! Variables:
!
! NPACK - Address of the first word of the array to be unpacked.
!
! ISAM - Array to receive the unpacked bit chunks. They will be
! right-justified with zero-fill in this array. ISAM
! should be dimensioned for ITER.
!
! IBIT - A bit-count offset to be used before the first bit chunk is
! unpacked. For example, if IBIT=3 and NBITS=5, then
! 3 bits in NPACK will be skipped and the next 5 bits
! will be unpacked into ISAM(1).
!
! NBITS - The number of bits in each bit chunk to be unpacked.
!
! NSKIP - The number of bits to skip between each bit chunk to be
! unpacked (after the first bit chunk has been unpacked.)
!
! ITER - The number of bit chunks to be unpacked.
!
! Example:
!
! CALL NG_GBYTES(NPB,ISB,3,6,9,2)
!
! In this call, 3 bits would be skipped at the beginning of NPB;
! the next 6 bits would be unpacked into ISB(1) right-justified with
! zero-fill; 9 bits would be skipped in NPB; the next six bits of
! NPB would be unpacked into ISB(2) right-justified with zero-fill.
!
!=====================================================================
! F. Get points on the globe surface
!=====================================================================
!
! SUBROUTINE NG_GCOG( CLAT, CLON, CRAD, ALAT, ALON, NPTS )
!
! SUBROUTINE NG_GSOG( SLAT, SLON, SRAD, ALAT, ALON )
!
! SUBROUTINE NG_RITD( IAXS, ANGL, UCRD, VCRD, WCRD )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GCOG( CLAT, CLON, CRAD, ALAT, ALON, NPTS )
!
! This routine returns, in the arrays ALAT and ALON, the latitudes and
! longitudes of NPTS points on the surface of the globe, all of them at
! the great-circle distance CRAD from the point (CLAT,CLON), defining a
! circle. The last point returned is a copy of the first.
!
! Variables:
!
! REAL, INTENT(IN ) :: CLAT, CLON, CRAD
! INTEGER, INTENT(IN ) :: NPTS
! REAL, INTENT( OUT) :: ALAT(NPTS), ALON(NPTS)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GSOG( SLAT, SLON, SRAD, ALAT, ALON )
!
! This routine returns, in the arrays ALAT and ALON, the latitudes and
! longitudes of 6 points on the surface of the globe, defining a five-
! pointed star. The last point returned is a copy of the first. The
! star is centered at the point with latitude SLAT and longitude SLON
! and has a radius of approximately SRAD. SLAT, SLON, and SRAD are all
! measured in degrees.
!
! Variables:
!
! REAL, INTENT(IN ) :: SLAT, SLON, SRAD
! REAL, INTENT( OUT) :: ALAT(6), ALON(6)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_RITD( IAXS, ANGL, UCRD, VCRD, WCRD )
!
! This routine rotates the point with coordinates (UCRD,VCRD,WCRD) by
! the angle ANGL about the axis specified by IAXS (1 for the U axis,
! 2 for the V axis, 3 for the W axis). A right-handed coordinate
! system is assumed.
!
! Variables:
!
! INTEGER, INTENT(IN ) :: IAXS
! REAL, INTENT(IN ) :: ANGL
! REAL, INTENT(INOUT) :: UCRD, VCRD, WCRD
!
!=====================================================================
! G. Encd, Encode Real Value to Charcater String
!=====================================================================
!
! SUBROUTINE NG_ENCD( VALU, ASH, IOUT, NC, IOFFD )
!
! REAL, INTENT(IN ) :: VALU, ASH
! CHARACTER(*), INTENT( OUT) :: IOUT
! INTEGER, INTENT( OUT) :: NC
! INTEGER, INTENT(IN ) :: IOFFD
!
! Routine to encode a real value to character string.
!
! Variables:
!
! VALU - Floating point number from which a label is
! to be created in IOUT.
!
! ASH - A scale factor used when IOFFD is non-zero.
! ASH should be non-negative.
!
! IOFFD - If IOFFD .EQ. 0
! a label which reflects the magnitude
! of VALU is created. Legal values for
! VALU are 0.0 and any value such that
! .1 .LE. ABS(VALU) .LE. 99999.49999...
! The label created in IOUT will have 3
! to 6 characters depending on the value
! of VALU. See IOUT below.
! IF IOFFD .NE. 0
! a label is created which reflects the
! value in VALU scaled by ASH.
! Legal values for VALU are 0. or
! any number such that
! 1. .LE. ASH*ABS(VALU) .LT. 1000.
! The label created in IOUT will have
! 1 to 3 characters, depending on the
! magnitude of ASH*VALU. See IOUT below.
!
! IOUT - Contains the created label. It should have no
! leading blanks. See NC.
!
! NC - The number of characters in the label created
! in IOUT. NC will be between 1 and 6 inclusive.
!
!=====================================================================
! H. Machine Constants
!=====================================================================
!
! FUNCTION NG_I1MACH( I )
!
! I1MACH reports the value of constants associated with integer
! (default INTEGER) computer arithmetic.
!
! ~~~~~~~~~~~
! DESCRIPTION
! ~~~~~~~~~~~
!
! I1MACH can be used to obtain machine-dependent parameters for the
! local machine environment. It is a function subprogram with one
! (input) argument and can be referenced as follows:
!
! K = I1MACH(I)
!
! where I=1,...,16. The (output) value of K above is determined by
! the (input) value of I. The results for various values of I are
! discussed below.
!
! I/O unit numbers:
! I1MACH( 1) = the standard input unit.
! I1MACH( 2) = the standard output unit.
! I1MACH( 3) = the standard punch unit.
! I1MACH( 4) = the standard error message unit.
!
! Words:
! I1MACH( 5) = the number of bits per integer storage unit.
! I1MACH( 6) = the number of characters per integer storage unit.
!
! Integers:
! assume default integers are represented in the S-digit, base-A form
!
! sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
!
! where 0 .LE. X(I) .LT. A for I=0,...,S-1.
! I1MACH( 7) = A, the base.
! I1MACH( 8) = S, the number of base-A digits.
! I1MACH( 9) = A**S - 1, the largest magnitude.
!
! Floating-Point Numbers:
! Assume floating-point numbers are represented in the T-digit,
! base-B form
! sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
!
! where 0 .LE. X(I) .LT. B for I=1,...,T,
! 0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
! I1MACH(10) = B, the base.
!
! Single-Precision (Default REAL):
! I1MACH(11) = T, the number of base-B digits.
! I1MACH(12) = EMIN, the smallest exponent E.
! I1MACH(13) = EMAX, the largest exponent E.
!
! Double-Precision (REAL with KIND=SELECTED_REAL_KIND(p=15)):
! I1MACH(14) = T, the number of base-B digits.
! I1MACH(15) = EMIN, the smallest exponent E.
! I1MACH(16) = EMAX, the largest exponent E.
!
! ~~~~~~~~~~
! REFERENCES
! ~~~~~~~~~~
!
! P. A. Fox, A. D. Hall and N. L. Schryer,
! Framework for a portable library,
! ACM Transactions on Mathematical Software 4, 2 (June 1978), pp. 177-188.
!
!---------------------------------------------------------------------
!
! FUNCTION NG_R1MACH( I )
!
! R1MACH reports the value of constants associated with real
! single precision (Default REAL) computer arithmetic.
!
! ~~~~~~~~~~~
! DESCRIPTION
! ~~~~~~~~~~~
!
! R1MACH can be used to obtain machine-dependent parameters for the
! local machine environment. It is a function subprogram with one
! (input) argument, and can be referenced as follows:
!
! A = R1MACH(I)
!
! where I=1,...,5. The (output) value of A above is determined by
! the (input) value of I. The results for various values of I are
! discussed below.
!
! R1MACH(1) = B**(EMIN-1), the smallest positive magnitude.
! R1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
! R1MACH(3) = B**(-T), the smallest relative spacing.
! R1MACH(4) = B**(1-T), the largest relative spacing.
! R1MACH(5) = LOG10(B)
!
! Assume single precision numbers are represented in the T-digit,
! base-B form
!
! sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
!
! where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
! EMIN .LE. E .LE. EMAX.
!
! The values of B, T, EMIN and EMAX are provided in I1MACH as
! follows:
! I1MACH(10) = B, the base.
! I1MACH(11) = T, the number of base-B digits.
! I1MACH(12) = EMIN, the smallest exponent E.
! I1MACH(13) = EMAX, the largest exponent E.
!
! ~~~~~~~~~~
! REFERENCES
! ~~~~~~~~~~
!
! P. A. Fox, A. D. Hall and N. L. Schryer,
! Framework for a portable library,
! ACM Transactions on Mathematical Software 4, 2 (June 1978), pp. 177-188.
!
!---------------------------------------------------------------------
!
! FUNCTION NG_D1MACH( I )
!
! D1MACH reports the value of constants associated with real double
! precision, REAL with KIND=SELECT_REAL_KIND(p=15), computer arithmetic.
!
! ~~~~~~~~~~~
! DESCRIPTION
! ~~~~~~~~~~~
!
! D1MACH can be used to obtain machine-dependent parameters for the
! local machine environment. It is a function subprogram with one
! (input) argument, and can be referenced as follows:
!
! A = D1MACH(I)
!
! where I=1,...,5. The (output) value of A above is determined by
! the (input) value of I. The results for various values of I are
! discussed below.
!
! D1MACH(1) = B**(EMIN-1), the smallest positive magnitude.
! D1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
! D1MACH(3) = B**(-T), the smallest relative spacing.
! D1MACH(4) = B**(1-T), the largest relative spacing.
! D1MACH(5) = LOG10(B)
!
! Assume double precision numbers, with KIND=SELECT_REAL_KIND(p=15),
! are represented in the T-digit, base-B form
!
! sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
!
! where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
! EMIN .LE. E .LE. EMAX.
!
! The values of B, T, EMIN and EMAX are provided in I1MACH as
! follows:
! I1MACH(10) = B, the base.
! I1MACH(14) = T, the number of base-B digits.
! I1MACH(15) = EMIN, the smallest exponent E.
! I1MACH(16) = EMAX, the largest exponent E.
!
! ~~~~~~~~~~
! REFERENCES
! ~~~~~~~~~~
!
! P. A. Fox, A. D. Hall and N. L. Schryer,
! Framework for a portable library,
! ACM Transactions on Mathematical Software 4, 2 (June 1978), pp. 177-188.
!
!=====================================================================