(tput) 1>/dev/null 2>&1
if [ $? = 1 ]; then
  CLEAR="clear"; export CLEAR
else
  CLEAR="tput clear"; export CLEAR
fi
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

  Demo Program Build and Run Procedure
  ====================================
 
  This Procedure will compile and run the library
  demonstration programs.  The library object archive
  file 'libgraphics.a' must be created, and the
  library environment variable GRAPHICS must be
  defined, prior to performing this Procedure.
 "
echo "  <CR> to Continue"
read answer
if [ "$SYSID" = "" ]; then
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

       Select System
      ===============
         1. APOLLO
         2. RISC6K
         3. CONVEX
         4. SGIRIX
         5. SUNOS
         6. UNICOS
         7. HP9000
         8. DECOSF
         9. LINUX
 "
read SYSID; export SYSID
fi
LINK="f77 "; export LINK
FORTRAN=FORTRAN;export FORTRAN
LIBX11="libX11.a";export LIBX11
if [ "$SYSID" = "1" ]; then
  LINK="f77 "
fi
if [ "$SYSID" = "2" ]; then
  LINK='xlf '
fi
if [ "$SYSID" = "3" ]; then
  LINK='fc '
fi
if [ "$SYSID" = "4" ]; then
  LINK='f77 '
fi
if [ "$SYSID" = "5" ]; then
  LINK='f77 '
fi
if [ "$SYSID" = "6" ]; then
  LINK='cf77 -Wl"-D DUPENTRY=IGNORE" '
fi
if [ "$SYSID" = "7" ]; then
  LINK='fort77 '
fi
if [ "$SYSID" = "8" ]; then
  LINK='f77 -taso '
  LIBX11='libX11.so'
  echo " "
fi
if [ "$SYSID" = "9" ]; then
  LINK='g77 -Wunused '
fi
$CLEAR
echo "
 
        Creating demo program source files.
 "
echo "  Generating =====> [ ./BLNKAREA.INC ]"
cat <<"STOP_CAT"> ././BLNKAREA.INC
C     ------------------Start BLNKAREA.INC Include File---------------------
C
C                       BLNKAREA Object Hidden Information
C
      INTEGER   KZMXBL, K4MXBL, KZMXBS, K4MXBS
C
      PARAMETER (KZMXBL = 200)
      PARAMETER (K4MXBL = 4)
      PARAMETER (KZMXBS = 1000)
      PARAMETER (K4MXBS = 4)
C
      INTEGER   KZBLCN, KZBSCN
      REAL      ZZBLNK(KZMXBL,K4MXBL), ZZBLKS(KZMXBS,K4MXBS)
C
      COMMON /BLNKAREA/  ZZBLNK, ZZBLKS, KZBLCN, KZBSCN
C
C     PRIVATE CONSTANTS
C       KZMXBL = first  subscript size for ZZBLNK
C       K4MXBL = second subscript size for ZZBLNK
C       KZMXBS = first  subscript size for ZZBLKS
C       K4MXBS = second subscript size for ZZBLKS
C
C     PRIVATE VARIABLES
C       ZZBLNK = user-defined blank area coordinates, cm
C                             (i,)  = i'th blank area, 200 max
C                [>(i,2)]     (i,1) = maximum X
C                             (i,2) = minimum X
C                [>(i,4)]     (i,3) = maximum Y
C                             (i,4) = minimum Y
C       ZZBLKS = marker blank area coordinates, cm
C                             (i,)  = i'th blank area, 1000 max
C                [>(i,2)]     (i,1) = maximum X
C                             (i,2) = minimum X
C                [>(i,4)]     (i,3) = maximum Y
C                             (i,4) = minimum Y
C       KZBLCN = index of highest blank area slot in use
C                4            default
C       KZBSCN = index of highest marker blank area slot in use
C                1:1000       number of markers being blanked
C                0            marker blanking enabled
C                -1           no markers being blanked
C
C     ------------------End BLNKAREA.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./COLOR.INC ]"
cat <<"STOP_CAT"> ././COLOR.INC
C     ------------------Start COLOR.INC Include File---------------------
C
C                       COLOR Object Hidden Information
C
C
C
      INTEGER   KZCOLR
      CHARACTER   CZCOLR*8
C
      COMMON /COLORC/  CZCOLR
      COMMON /COLOR/  KZCOLR
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       CZCOLR = name of current color
C                'BLACK   '   black
C                'BACKGROU'   background (usually black)
C                'WHITE   '   white (default)
C                'FOREGROU'   foreground (usually white)
C                'GREEN   '   green
C                'RED     '   red
C                'BLUE    '   blue
C                'YELLOW  '   yellow
C                'MAGENTA '   magenta
C                'CYAN    '   cyan
C       KZCOLR = number of current color
C                0            black or background
C                1            white or foreground (default)
C                2            red
C                3            green
C                4            blue
C                5            yellow
C                6            magenta
C                7            cyan
C
C     ------------------End COLOR.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./FONT.INC ]"
cat <<"STOP_CAT"> ././FONT.INC
C     ------------------Start FONT.INC Include File---------------------
C
C                       FONT Object Hidden Information
C
      INTEGER   K6MXFN, MAXFNT, KMXDX, KMXWD, MXSTRK
C
      PARAMETER (K6MXFN = 6)
      PARAMETER (MAXFNT = 4)
      PARAMETER (KMXDX  = 95*MAXFNT+1)
      PARAMETER (KMXWD  = 95*MAXFNT)
      PARAMETER (MXSTRK = MAXFNT*9000)
C
      INTEGER   ISLFNT(MAXFNT), IHIGHT(MAXFNT), INDX(KMXDX)
     *        , BWIDTH(KMXWD), BXY(MXSTRK), KZLCA, ICFNSL, MXSLOT
     *        , KZSFAN, KZSFGP
      REAL      ZZSFAN, ZZSFGP
      CHARACTER   CZALFL(K6MXFN)*1, CZALFN(K6MXFN)*5, CZALFS*5
C
      COMMON /FONTC/  CZALFL, CZALFN, CZALFS
      COMMON /FONT/  ISLFNT, IHIGHT, INDX, BWIDTH, BXY, KZLCA, ICFNSL
     *        , MXSLOT, KZSFAN, KZSFGP, ZZSFAN, ZZSFGP
C
C     PRIVATE CONSTANTS
C       K6MXFN = subscript size constant for CZALFL, CZALFN
C       MAXFNT = subscript size constant for ISLFNT, IHIGHT
C       KMXDX  = subscript size constant for INDX
C       KMXWD  = subscript size constant for BWIDTH
C       MXSTRK = subscript size constant for BXY
C
C     PRIVATE VARIABLES
C       CZALFL = alphabet set switch character
C                             (i)=i'th alphabet set switch, 6 max
C       CZALFN = alphabet set name
C                             (i)=i'th alphabet set name, 6 max
C                'STAND'      standard (default)
C                'L/CST'      lower case standard
C                'ITALI'      italic
C                'L/CIT'      lower case italic
C                'GREEK'      Greek
C                'L/CGR'      lower case Greek
C                'SCRIP'      script
C                'L/CSC'      lower case  script
C                'MATHE'      mathematic
C                'DEFAU'      default (standard)
C                'L/CDE'      lower case default
C       CZALFS = current character style
C                'CARTO'      cartographic
C                'SHCLS'      classic
C                'SCMPL'      complex2
C                'COMPL'      complex
C                'DUPLE'      duplex
C                'GOTHI'      gothic
C                'DEFAU'      default
C                'SHRMB'      romanb
C                'SHRML'      romanl
C                'SIMPL'      simplex
C                'SHSTX'      stylex
C                'TRIPL'      triplex
C       ISLFNT = font id's of fonts in font buffers
C                             (i)=id of font in i'th buffer, 4 max
C                1            default
C       IHIGHT = height of capital A, font units
C                             (i)=A ht of font in i'th buffer, 4 max
C                8            default
C       INDX   = char symbol start positions in BXY()
C                             (i)=start pos of i'th char, 381 max
C       BWIDTH = width of chars in font buffs, font units
C                             (i)=width of i'th char, 380 max
C       BXY    = char symbol coordinates, char units
C                -64          start of new line segment
C       KZLCA  = lower case alphabet set flag
C                0            interpret character codes normally
C                1            map alphabetic ASCII character codes
C                              to lower case symbols
C       ICFNSL = buffer number of current font
C                1            default, 4 max
C       MXSLOT = number of fonts in font buffers
C                1            default, 4 max
C       KZSFAN = number of char shading line angles
C       KZSFGP = no. of char shading line gap distances
C       ZZSFAN = angle of character shading lines, deg
C       ZZSFGP = gap dist between char shading lines, in.
C
C     ------------------End FONT.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./FRAME.INC ]"
cat <<"STOP_CAT"> ././FRAME.INC
C     ------------------Start FRAME.INC Include File---------------------
C
C                       FRAME Object Hidden Information
C
C
C
      INTEGER   KZBRDR
      REAL      UUFRME, ZZFRME
C
      COMMON /FRAMEC/  KZBRDR, UUFRME, ZZFRME
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       KZBRDR = frame drawing enable flag
C                111          Y: frame drawing enabled
C                222          N: frame drawing disabled (default)
C       UUFRME = frame thickness, cm
C                .0254        default (0.01 inch)
C       ZZFRME = device-adjusted frame thickness, cm
C
C     ------------------End FRAME.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./GRAPHICS.INC ]"
cat <<"STOP_CAT"> ././GRAPHICS.INC
C     ------------------Start GRAPHICS.INC Include File---------------------
C
C                       GRAPHICS Object Hidden Information
C
C
C
      INTEGER   KZLEVL
      CHARACTER   ZZSUBP*31
C
      COMMON /GRAPHICSC/  ZZSUBP
      COMMON /GRAPHICS/  KZLEVL
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       KZLEVL = plotting level number
C                0            no device initialized
C                1            device initialized
C                2            subplot area (page coords) defined
C                3            axes scale (user coords) defined
C       ZZSUBP = name of currently-executing graphics
C                             subprogram
C
C     ------------------End GRAPHICS.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./LINE2D.INC ]"
cat <<"STOP_CAT"> ././LINE2D.INC
C     ------------------Start LINE2D.INC Include File---------------------
C
C                       LINE2D Object Hidden Information
C
      INTEGER   K13DST, K15DST
C
      PARAMETER (K13DST = 13)
      PARAMETER (K15DST = 15)
C
      INTEGER   KZLNCN, KZLSTY, ILNTYP, KZLBEG, KZMOV, KZLTHK
      REAL      UULTHK, ZZLTHK, DIST(K13DST,K15DST), ZZPRX, ZZPRY
     *        , ZZPRX1, ZZPRY1, ZZPRX2, ZZPRY2, DLEFT
      LOGICAL   LINILT, LPOSND
C
      COMMON /LINE2D/  KZLNCN, KZLSTY, ILNTYP, KZLBEG, KZMOV
     *        , UULTHK, ZZLTHK, KZLTHK, DIST, ZZPRX, ZZPRY, ZZPRX1
     *        , ZZPRY1, ZZPRX2, ZZPRY2, DLEFT, LINILT, LPOSND
C
C     PRIVATE CONSTANTS
C       K13DST = first  subscript size for DIST
C       K15DST = second subscript size for DIST
C
C     PRIVATE VARIABLES
C       KZLNCN = number of defined additional line styles
C                4:15         (not counting solid) incl user-defined
C       KZLSTY = current line style index
C                1            solid (default)
C                2            dot
C                3            dash
C                4            chain-dot
C                5            chain-dash
C       ILNTYP = current line style index
C                1            solid (default)
C                2            dot
C                3            dash
C                4            chain-dot
C                5            chain-dash
C       KZLBEG = index for beginning segment of line
C                111          Y: drawing first segment of line
C                222          N: drawing subsequent segment of line
C       KZMOV  = index for filling thick line
C                111          Y: draw line without thickness filled
C                222          N: draw line with thickness filled
C       UULTHK = line thickness, cm
C                >.04826      0.019 in. minimum user-defined
C                .0254        0.01 in. default
C       ZZLTHK = line thickness, driver-scaled page units
C                             >0.01 inch times driver scale factor
C       KZLTHK = index for user-defined thickness
C                111          Y: user-defined thickness being used
C                222          N: default thickness being used
C       DIST   = lengths of marks and spaces comprising
C                           user-defined line style, cm
C                             (i,)=i'th mark,space of style, 13 max
C                             (,j)=j'th user-defined style, 15 max
C       ZZPRX  = previous X coord of line endpoint, cm
C       ZZPRY  = previous Y coord of line endpoint, cm
C       ZZPRX1 = previous X of thick line right corner,cm
C       ZZPRY1 = previous Y of thick line right corner,cm
C       ZZPRX2 = previous X of thick line left corner, cm
C       ZZPRY2 = previous Y of thick line left corner, cm
C       DLEFT  = undrawn length of non-solid line, cm
C       LINILT = flag for drawing non-solid line styles
C                .T.          draw initial segment of line
C                .F.          draw subsequent segment of line
C       LPOSND = positioning flag for drawing line styles
C                .F.          move to start of line segment
C                .T.          do not move to start of line segment
C
C     ------------------End LINE2D.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./MARGIN.INC ]"
cat <<"STOP_CAT"> ././MARGIN.INC
C     ------------------Start MARGIN.INC Include File---------------------
C
C                       MARGIN Object Hidden Information
C
C
C
      INTEGER   KZCHEK
      REAL      UUGRCE, ZZGRCE
C
      COMMON /MARGINC/  KZCHEK, UUGRCE, ZZGRCE
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       KZCHEK = out-of-bounds check enable switch
C                111          Y: raise exception for points beyond
C                                subplot area
C                222          N: disable out-of-bounds checking
C       UUGRCE = grace margin width, cm
C                1.27         default (0.5 inch)
C       ZZGRCE = device-adjusted grace margin width, cm
C
C     ------------------End MARGIN.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./MARKER.INC ]"
cat <<"STOP_CAT"> ././MARKER.INC
C     ------------------Start MARKER.INC Include File---------------------
C
C                       MARKER Object Hidden Information
C
C
C
      INTEGER   KZNSYM, KZSYM
      REAL      KZSYMU, UUSMSZ, ZZSMSZ, XSYMOR, YSYMOR
C
      COMMON /MARKERC/  KZNSYM, KZSYM, KZSYMU, UUSMSZ, ZZSMSZ, XSYMOR
     *        , YSYMOR
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       KZNSYM = max value of pre-defined marker index
C       KZSYM  = index of current pre-defined marker
C                [0]          default (square), 18 max
C       KZSYMU = marker source indicator
C                0            use pre-defined marker shape (default)
C                              KZSYM is marker index
C                >1           use user-defined marker,
C                              KZSYMU is marker index
C       UUSMSZ = marker height, cm
C                .2032        default (0.8 inches)
C       ZZSMSZ = device-adjusted marker height, cm
C       XSYMOR = X coord of user-defined marker, cm
C       YSYMOR = Y coord of user-defined marker, cm
C
C     ------------------End MARKER.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./ORIGIN.INC ]"
cat <<"STOP_CAT"> ././ORIGIN.INC
C     ------------------Start ORIGIN.INC Include File---------------------
C
C                       ORIGIN Object Hidden Information
C
C
C
      INTEGER   KZOR
      REAL      UUXOR, UUYOR, ZZXOR, ZZYOR
C
      COMMON /ORIGINC/  KZOR, UUXOR, UUYOR, ZZXOR, ZZYOR
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       KZOR   = origin location source indicator
C                111          Y: user has defined origin
C                222          N: use default origin
C       UUXOR  = origin X location from left page edge,cm
C                1.27:1.905   default (0.5 or 0.75 inches)
C       UUYOR  = origin X location from left page edge,cm
C                1.27:1.905   default (0.5 or 0.75 inches)
C       ZZXOR  = device-adjusted X origin location, cm
C       ZZYOR  = device-adjusted Y origin location, cm
C
C     ------------------End ORIGIN.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./PAGE.INC ]"
cat <<"STOP_CAT"> ././PAGE.INC
C     ------------------Start PAGE.INC Include File---------------------
C
C                       PAGE Object Hidden Information
C
C
C
      INTEGER   KZBEGN, KZAUTO, KZPAGE, KZSCAL, IVIS
      REAL      UUPAGX, UUPAGY, ZZPAGX, ZZPAGY, ZZPAGR, XCM0, XCM1, YCM0
     *        , YCM1, XCLIPD, YCLIPD, ZZUNIT
C
      COMMON /PAGEC/  KZBEGN, KZAUTO, KZPAGE, KZSCAL, UUPAGX, UUPAGY
     *        , ZZPAGX, ZZPAGY, ZZPAGR, XCM0, XCM1, YCM0, YCM1, IVIS
     *        , XCLIPD, YCLIPD, ZZUNIT
C
C     PRIVATE CONSTANTS
C       None
C
C     PRIVATE VARIABLES
C       KZBEGN = index for beginning of plot
C                111          Y: plot has begun on this page
C                222          N: starting new plot, clear page
C       KZAUTO = page rotation auto-selection switch
C                111          Y: sw auto-selects portrait,landscape
C                                (default)
C                222          N: user selects portrait or landscape
C       KZPAGE = page size source indicator
C                111          Y: user has defined page size
C                222          N: use default page size
C       KZSCAL = oversize plot behavior switch
C                12           clip out-of-bounds objects
C                13           scale down plot to fit device limits
C                14           scale plot to fit device limits
C                15           abort plot if exceeds device limits
C       UUPAGX = user-defined X page size, cm
C                27.94        default (11 inches)
C       UUPAGY = user-defined Y page size, cm
C                21.59        default (8.5 inches)
C       ZZPAGX = device-adjusted X page size, cm
C       ZZPAGY = device-adjusted Y page size, cm
C       ZZPAGR = page ratio multiplier; (device page size
C                             divided by user-def page size)*.95
C                1.0          default value, non-dimensional
C       XCM0   = min X location of clipping boundary from
C                [<ZZPAGX]    page left edge, cm
C       XCM1   = max X location of clipping boundary from
C                [<ZZPAGX]    page left edge, cm
C       YCM0   = min Y location of clipping boundary from
C                [<ZZPAGY]    page bottom edge, cm
C       YCM1   = max Y location of clipping boundary from
C                [<ZZPAGY]    page bottom edge, cm
C       IVIS   = clipped point visibility indicator
C                0            point visible (in clipping boundary)
C                >1           point not visible (clipped)
C       XCLIPD = max X extent of clipping boundary, cm
C       YCLIPD = max Y extent of clipping boundary, cm
C       ZZUNIT = factor for converting page units to cm
C                2.54         cm/in., page units in inches
C                0.1          cm/mm,  page units in mm
C                1.0          cm/cm,  page units in cm
C
C     ------------------End PAGE.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./SUBPLOT.INC ]"
cat <<"STOP_CAT"> ././SUBPLOT.INC
C     ------------------Start SUBPLOT.INC Include File---------------------
C
C                       SUBPLOT Object Hidden Information
C
      INTEGER   M_123
C
      PARAMETER (M_123 = 4)
C
      REAL      UUXAXS, UUYAXS, ZZXAXS, ZZYAXS, ZZXLFT, ZZXRGT, ZZYBOT
     *        , ZZYTOP, XVSTRT, YVSTRT, XVLEN, YVLEN, YVINI, ZZXAXR
     *        , ZZYAXR, XS, YS, XT, YT, RCOS, RSIN, BLOWXY, AREA3(M_123)
C
      COMMON /SUBPLOT/  UUXAXS, UUYAXS, ZZXAXS, ZZYAXS, ZZXLFT, ZZXRGT
     *        , ZZYBOT, ZZYTOP, XVSTRT, YVSTRT, XVLEN, YVLEN, YVINI
     *        , ZZXAXR, ZZYAXR, XS, YS, XT, YT, RCOS, RSIN, BLOWXY
     *        , AREA3
C
C     PRIVATE CONSTANTS
C       M_123 = subscript size constant for AREA3
C
C     PRIVATE VARIABLES
C       UUXAXS = length of X axis, cm
C       UUYAXS = length of Y axis, cm
C       ZZXAXS = device-adjusted length of X axis, cm
C       ZZYAXS = device-adjusted length of Y axis, cm
C       ZZXLFT = min X coord of subplot area from left
C                             edge of page, cm
C       ZZXRGT = max Y coord of subplot area from left
C                             edge of page, cm
C       ZZYBOT = min Y coord of subplot area from bottom
C                             edge of page, cm
C       ZZYTOP = max Y coord of subplot area from bottom
C                             edge of page, cm
C       XVSTRT = min X coord of subplot area from left
C                             edge of page, cm
C       YVSTRT = min Y coord of subplot area from bottom
C                             edge of page, cm
C       XVLEN  = width of subplot area, cm
C       YVLEN  = height of subplot area, cm
C       YVINI  = height of subplot area, cm
C       ZZXAXR = distance from origin to right
C                             edge of clipping boundary as fraction
C                             of X axis length, non-dim
C       ZZYAXR = distance from origin to top
C                             edge of clipping boundary as fraction
C                             of Y axis length, non-dim
C       XS     = subplot X blowup scale factor, non-dim
C                1.0          default
C       YS     = subplot Y blowup scale factor, non-dim
C                1.0          default
C       XT     = subplot X translation factor, cm
C                0.0          default
C       YT     = subplot Y translation factor, cm
C                0.0          default
C       RCOS   = cosine of subplot rotation angle
C                1.0          default (0.0 degrees)
C       RSIN   = sine of subplot rotation angle
C                0.0          default (0.0 degrees)
C       BLOWXY = subplot uniform blowup factor, non-dim
C                1.0          default
C       AREA3  = subplot attribute storage array for 3D
C                             to 2D projection
C                             (i)=i'th parameter, 4 max
C
C     ------------------End SUBPLOT.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./TEXT2D.INC ]"
cat <<"STOP_CAT"> ././TEXT2D.INC
C     ------------------Start TEXT2D.INC Include File---------------------
C
C                       TEXT2D Object Hidden Information
C
      INTEGER   KMXWX, MAXEEE, KMXUX
C
      PARAMETER (KMXWX = 100)
      PARAMETER (MAXEEE = 600)
      PARAMETER (KMXUX = 20)
C
      INTEGER   KZTMLN, NWWW, NEEE, NUUU
      REAL      UUHITE, ZZHITE, CSIZE, ZZANGL, CCOS, CSIN, XOFF, YOFF
     *        , WX(KMXWX), WY(KMXWX), EX(MAXEEE), EY(MAXEEE), UX(KMXUX)
     *        , UY(KMXUX), FACXY
      CHARACTER   KZSTRM*4
C
      COMMON /TEXT2DC/  KZSTRM
      COMMON /TEXT2D/  KZTMLN, UUHITE, ZZHITE, CSIZE, ZZANGL, CCOS, CSIN
     *        , XOFF, YOFF, NWWW, NEEE, NUUU, WX, WY, EX, EY, UX, UY
     *        , FACXY
C
C     PRIVATE CONSTANTS
C       KMXWX = subscript size constant for WX, WY
C       MAXEEE = subscript size constant for EX, EY
C       KMXUX = subscript size constant for UX, UY
C
C     PRIVATE VARIABLES
C       KZSTRM = self-counting string terminator
C                '$'          default
C       KZTMLN = self-counting string terminator length
C                [1]          default, 4 max
C       UUHITE = 2D character height, cm
C                .3556        default (0.14 inches)
C       ZZHITE = device-adjusted character height, cm
C       CSIZE  = character height factor, cm/char unit
C                0.3          default
C       ZZANGL = 2D text rotation angle, degrees
C                0.0          default
C       CCOS   = cosine of 2D text rotation angle
C                1.0          default (0.0 degrees)
C       CSIN   = sine of 2D text rotation angle
C                0.0          default (0.0 degrees)
C       XOFF   = X coord of character reference point, cm
C       YOFF   = Y coord of character reference point, cm
C       NWWW   = number of coords in WX,WY arrays
C                0            WX,WY arrays empty
C                -1:-100      fit points in WX,WY using spline
C                1:100        number of coords in WX,WY
C       NEEE   = number of coords in EX,EY arrays
C                0            EX,EY arrays empty
C                1:600        number of coords in EX,EY
C       NUUU   = number of coords in UX,UY arrays
C                -1           no line segment yet placed in UX,UY
C                0            line seg about to be placed in UX,UY
C                1:20         number of coords in UX,UY
C       WX     = X coords of char line segment, cm
C                             (i)=i'th coord of line seg, 100 max
C       WY     = Y coords of char line segment, cm
C                             (i)=i'th coord of line seg, 100 max
C       EX     = X coords of char line segment, cm
C                             (i)=i'th coord of line seg, 600 max
C       EY     = Y coords of char line segment, cm
C                             (i)=i'th coord of line seg, 600 max
C       UX     = X coords of char line segment, cm
C                             (i)=i'th coord of line seg, 20 max
C       UY     = Y coords of char line segment, cm
C                             (i)=i'th coord of line seg, 20 max
C       FACXY  = height factor for 3d->2D char projection
C                1.0          default
C
C     ------------------End TEXT2D.INC Include File---------------------
STOP_CAT
echo "  Generating =====> [ ./_graphics.tk ]"
cat <<"STOP_CAT"> ././_graphics.tk
#!/tmp/tk/usr/X386/bin/wish -f
#
#       Programmer's Reusable Library, Version 0.7      (TM)
#
#            Copyright (C) 1995 Object Access (SM)
#
#     Permission is granted to any individual or institution
#     to use, copy, modify, and distribute this single program
#     unit, provided that this complete copyright and
#     permission notice is maintained, intact, in all copies.
#
#     Object Access Incorporated provides this software
#     "as is" without express or implied warranty.
#
#     PURPOSE: Demonstrate features of the PRL-GRAPHICS library
#
#     NOTES:
#
#     ******************************************************************
#
#                       Define window title
#
set auto_path "$tk_library/demos $auto_path"
wm title . "PRL-GRAPHICS Demonstration"
#
#     ******************************************************************
#
#                       Create the main window, consisting of a menu
#                       bar and a message explaining the basic operation
#                       of the program
#
frame .menu -relief raised -borderwidth 1
#
message .msg -font -Adobe-times-medium-r-normal--*-180* -relief raised \
-width 600 -borderwidth 1 -text \
"This window demonstrates the Programmer's Reuseable Library \
PRL-GRAPHICS, Version 0.7 \
using a graphical user interface provided by the Tk toolkit.
 
To invoke a demonstration, press the left mouse button over one of the \
menu buttons, drag the mouse to the desired menu file, then release the \
mouse button.
 
The Demo menu tells more about using this window.
The More menu has more information about PRL-GRAPHICS.
 
To exit, select the \"Quit\" option in the Demo menu.
 
----------------------------------------------------
 
Copyright (C) 1995 Object Access (SM)
 
Permission is granted to any individual or institution \
to use, copy, modify, and distribute this single program \
unit, provided that this complete copyright and \
permission notice is maintained, intact, in all copies.
 
Object Access Incorporated provides this software \
\"as is\" without express or implied warranty."
#
pack .menu -side top -fill x
pack .msg -side bottom -expand yes -fill both
#
#     ******************************************************************
#
#                       DEFINE MENUS FOR TOP MENU ROW
#
#     ******************************************************************
#
#                       "Demo" menu
#
menubutton .menu.demo -text "Demo  " -menu .menu.demo.m
#
#     ------------------------------------------------------------------
#
                        menu .menu.demo.m
#
#                       "Tear-off menus" button
.menu.demo.m add command -label "Tear-off menus" -command mkTear
#
#                       "Quit" button
.menu.demo.m add command -label "Quit" -command "destroy ."
#
#     ******************************************************************
#
#                       "PRL" menu
#
menubutton .menu.prl -text "PRL  " -menu .menu.prl.m
#
#     ------------------------------------------------------------------
#
                        menu .menu.prl.m
#
#                       "prl1" button
.menu.prl.m add command -label "prl1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e prl1.x }
#
#     ******************************************************************
#
#                       "DEVICE" menu
#
menubutton .menu.device -text "DEVICE  " -menu .menu.device.m
#
#     ------------------------------------------------------------------
#
                        menu .menu.device.m
#
#                       "device1" button
.menu.device.m add command -label "device1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e device1.x }
#
#     ******************************************************************
#
#                       "GRAPHICS" menu
#
menubutton .menu.graphics -text "GRAPHICS  " -menu .menu.graphics.m
#
#     ------------------------------------------------------------------
#
                        menu .menu.graphics.m
#
#                       "graphics1" button
.menu.graphics.m add command -label "graphics1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e graphics1.x }
#
#                       "graphics2" button
.menu.graphics.m add command -label "graphics2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e graphics2.x }
#
#     ******************************************************************
#
#                       "Plot_Setup" menu
#
menubutton .menu.setup -text "Plot_Setup " -menu .menu.setup.m
#
#     ******************************************************************
#
                        menu .menu.setup.m
#
#                       "PAGE" menu
#
.menu.setup.m add cascade -label "PAGE" -menu .menu.setup.page
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.page
#
#                       "page1" button
.menu.setup.page add command -label "page1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e page1.x }
#
#                       "page2" button
.menu.setup.page add command -label "page2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e page2.x }
#
#                       "page3" button
.menu.setup.page add command -label "page3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e page3.x }
#
#                       "page4" button
.menu.setup.page add command -label "page4" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e page4.x }
#
#                       "page5" button
.menu.setup.page add command -label "page5" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e page5.x }
#
#                       "page6" button
.menu.setup.page add command -label "page6" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e page6.x }
#
#     ******************************************************************
#
#                       "ORIGIN" menu
#
.menu.setup.m add cascade -label "ORIGIN" -menu .menu.setup.origin
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.origin
#
#                       "origin1" button
.menu.setup.origin add command -label "origin1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e origin1.x }
#
#                       "origin2" button
.menu.setup.origin add command -label "origin2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e origin2.x }
#
#     ******************************************************************
#
#                       "SUBPLOT" menu
#
.menu.setup.m add cascade -label "SUBPLOT" -menu .menu.setup.subplot
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.subplot
#
#                       "subplot1" button
.menu.setup.subplot add command -label "subplot1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e subplot1.x }
#
#                       "subplot2" button
.menu.setup.subplot add command -label "subplot2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e subplot2.x }
#
#                       "subplot3" button
.menu.setup.subplot add command -label "subplot3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e subplot3.x }
#
#                       "subplot4" button
.menu.setup.subplot add command -label "subplot4" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e subplot4.x }
#
#                       "subplot5" button
.menu.setup.subplot add command -label "subplot5" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e subplot5.x }
#
#                       "subplot6" button
.menu.setup.subplot add command -label "subplot6" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e subplot6.x }
#
#     ******************************************************************
#
#                       "FRAME" menu
#
.menu.setup.m add cascade -label "FRAME" -menu .menu.setup.frame
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.frame
#
#                       "frame1" button
.menu.setup.frame add command -label "frame1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e frame1.x }
#
#                       "frame2" button
.menu.setup.frame add command -label "frame2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e frame2.x }
#
#     ******************************************************************
#
#                       "MARGIN" menu
#
.menu.setup.m add cascade -label "MARGIN" -menu .menu.setup.margin
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.margin
#
#                       "margin1" button
.menu.setup.margin add command -label "margin1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e margin1.x }
#
#                       "margin2" button
.menu.setup.margin add command -label "margin2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e margin2.x }
#
#     ******************************************************************
#
#                       "BLNKAREA" menu
#
.menu.setup.m add cascade -label "BLNKAREA" -menu .menu.setup.blnkarea
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.blnkarea
#
#                       "blnkarea1" button
.menu.setup.blnkarea add command -label "blnkarea1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e blnkarea1.x }
#
#                       "blnkarea2" button
.menu.setup.blnkarea add command -label "blnkarea2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e blnkarea2.x }
#
#                       "blnkarea3" button
.menu.setup.blnkarea add command -label "blnkarea3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e blnkarea3.x }
#
#     ******************************************************************
#
#                       "COLOR" menu
#
.menu.setup.m add cascade -label "COLOR" -menu .menu.setup.color
#
#     ------------------------------------------------------------------
#
                        menu .menu.setup.color
#
#                       "color1" button
.menu.setup.color add command -label "color1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e color1.x }
#
#                       "color2" button
.menu.setup.color add command -label "color2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e color2.x }
#
#                       "color3" button
.menu.setup.color add command -label "color3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e color3.x }
#
#     ******************************************************************
#
#                       "Line_Drawing" menu
#
menubutton .menu.line -text "Line_Drawing " -menu .menu.line.m
#
#     ******************************************************************
#
                        menu .menu.line.m
#
#                       "LOGPEN2" menu
#
.menu.line.m add cascade -label "LOGPEN2" -menu .menu.line.logpen2
#
#     ------------------------------------------------------------------
#
                        menu .menu.line.logpen2
#
#                       "logpen21" button
.menu.line.logpen2 add command -label "logpen21" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e logpen21.x }
#
#                       "logpen22" button
.menu.line.logpen2 add command -label "logpen22" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e logpen22.x }
#
#     ******************************************************************
#
#                       "LINE2D" menu
#
.menu.line.m add cascade -label "LINE2D" -menu .menu.line.line2d
#
#     ------------------------------------------------------------------
#
                        menu .menu.line.line2d
#
#                       "line2d1" button
.menu.line.line2d add command -label "line2d1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e line2d1.x }
#
#                       "line2d2" button
.menu.line.line2d add command -label "line2d2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e line2d2.x }
#
#                       "line2d3" button
.menu.line.line2d add command -label "line2d3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e line2d3.x }
#
#                       "line2d4" button
.menu.line.line2d add command -label "line2d4" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e line2d4.x }
#
#                       "line2d5" button
.menu.line.line2d add command -label "line2d5" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e line2d5.x }
#
#                       "line2d6" button
.menu.line.line2d add command -label "line2d6" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e line2d6.x }
#
#     ******************************************************************
#
#                       "MARKER" menu
#
.menu.line.m add cascade -label "MARKER" -menu .menu.line.marker
#
#     ------------------------------------------------------------------
#
                        menu .menu.line.marker
#
#                       "marker1" button
.menu.line.marker add command -label "marker1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e marker1.x }
#
#                       "marker2" button
.menu.line.marker add command -label "marker2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e marker2.x }
#
#                       "marker3" button
.menu.line.marker add command -label "marker3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e marker3.x }
#
#                       "marker4" button
.menu.line.marker add command -label "marker4" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e marker4.x }
#
#                       "marker5" button
.menu.line.marker add command -label "marker5" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e marker5.x }
#
#     ******************************************************************
#
#                       "Char_Drawing" menu
#
menubutton .menu.char -text "Char_Drawing " -menu .menu.char.m
#
#     ******************************************************************
#
                        menu .menu.char.m
#
#                       "FONT" menu
#
.menu.char.m add cascade -label "FONT" -menu .menu.char.font
#
#     ------------------------------------------------------------------
#
                        menu .menu.char.font
#
#                       "font1" button
.menu.char.font add command -label "font1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e font1.x }
#
#                       "font2" button
.menu.char.font add command -label "font2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e font2.x }
#
#     ******************************************************************
#
#                       "HEADING" menu
#
.menu.char.m add cascade -label "HEADING" -menu .menu.char.heading
#
#     ------------------------------------------------------------------
#
                        menu .menu.char.heading
#
#                       "heading1" button
.menu.char.heading add command -label "heading1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e heading1.x }
#
#     ******************************************************************
#
#                       "INT" menu
#
.menu.char.m add cascade -label "INT" -menu .menu.char.int
#
#     ------------------------------------------------------------------
#
                        menu .menu.char.int
#
#                       "int1" button
.menu.char.int add command -label "int1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e int1.x }
#
#                       "int2" button
.menu.char.int add command -label "int2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e int2.x }
#
#     ******************************************************************
#
#                       "REAL" menu
#
.menu.char.m add cascade -label "REAL" -menu .menu.char.real
#
#     ------------------------------------------------------------------
#
                        menu .menu.char.real
#
#                       "real1" button
.menu.char.real add command -label "real1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e real1.x }
#
#                       "real2" button
.menu.char.real add command -label "real2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e real2.x }
#
#     ******************************************************************
#
#                       "TEXT2D" menu
#
.menu.char.m add cascade -label "TEXT2D" -menu .menu.char.text2d
#
#     ------------------------------------------------------------------
#
                        menu .menu.char.text2d
#
#                       "text2d1" button
.menu.char.text2d add command -label "text2d1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e text2d1.x }
#
#                       "text2d2" button
.menu.char.text2d add command -label "text2d2" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e text2d2.x }
#
#                       "text2d3" button
.menu.char.text2d add command -label "text2d3" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e text2d3.x }
#
#                       "text2d4" button
.menu.char.text2d add command -label "text2d4" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e text2d4.x }
#
#                       "text2d5" button
.menu.char.text2d add command -label "text2d5" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e text2d5.x }
#
#                       "text2d6" button
.menu.char.text2d add command -label "text2d6" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e text2d6.x }
#
#     ******************************************************************
#
#                       "PROCESS" menu
#
menubutton .menu.process -text "PROCESS  " -menu .menu.process.m
#
#     ------------------------------------------------------------------
#
                        menu .menu.process.m
#
#                       "process1" button
.menu.process.m add command -label "process1" -command { \
exec xterm -rw -cr black -ms black -fg black -bg CadetBlue1 \
-sb -e process1.x }
#
#     ******************************************************************
#
#                       "More" menu
#
menubutton .menu.more -text "More" -menu .menu.more.m
#
#     ------------------------------------------------------------------
#
                        menu .menu.more.m
#
#                       "MENU Definitions" button
.menu.more.m add cascade -label "MENU Definitions" -menu .menu.more.defs
#
#     ------------------------------------------------------------------
#
                        menu .menu.more.defs
#
#                       "BLNKAREA" button
.menu.more.defs add command -label "BLNKAREA" -command \
{ mkDialog .modal {-text \
{The BLNKAREA menu invokes demonstrations of the PRL-GRAPHICS \
BLNKAREA object subprograms.  The BLNKAREA object is \
a rectangular area that clips graphical objects when it is enabled. \
} -aspect 450 -justify left} {OK {}}
}
#                       "COLOR" button
.menu.more.defs add command -label "COLOR" -command \
{ mkDialog .modal {-text \
{The COLOR menu invokes demonstrations of the PRL-GRAPHICS \
COLOR object subprograms.  The COLOR object is \
a mapping between a color number and a drawing color of a graphics device. \
} -aspect 450 -justify left} {OK {}}
}
#                       "DEVICE" button
.menu.more.defs add command -label "DEVICE" -command \
{ mkDialog .modal {-text \
{The DEVICE menu invokes demonstrations of the PRL-GRAPHICS \
DEVICE object subprograms.  The DEVICE object is \
the parent object for all other PRL-DEVICE objects. \
} -aspect 450 -justify left} {OK {}}
}
#                       "FONT" button
.menu.more.defs add command -label "FONT" -command \
{ mkDialog .modal {-text \
{The FONT menu invokes demonstrations of the PRL-GRAPHICS \
FONT object subprograms.  The FONT object is \
an alphabet set (collection of symbol shapes) drawn in a certain text style. \
} -aspect 450 -justify left} {OK {}}
}
#                       "FRAME" button
.menu.more.defs add command -label "FRAME" -command \
{ mkDialog .modal {-text \
{The FRAME menu invokes demonstrations of the PRL-GRAPHICS \
FRAME object subprograms.  The FRAME object is \
a rectangle drawn at the edge of the subplot area. \
} -aspect 450 -justify left} {OK {}}
}
#                       "GRAPHICS" button
.menu.more.defs add command -label "GRAPHICS" -command \
{ mkDialog .modal {-text \
{The GRAPHICS menu invokes demonstrations of the PRL-GRAPHICS \
GRAPHICS object subprograms.  The GRAPHICS object is \
the parent object for all other PRL-GRAPHICS objects. \
} -aspect 450 -justify left} {OK {}}
}
#                       "HEADING" button
.menu.more.defs add command -label "HEADING" -command \
{ mkDialog .modal {-text \
{The HEADING menu invokes demonstrations of the PRL-GRAPHICS \
HEADING object subprograms.  The HEADING object is \
a block of one to four text strings centered over the subplot area. \
} -aspect 450 -justify left} {OK {}}
}
#                       "INT" button
.menu.more.defs add command -label "INT" -command \
{ mkDialog .modal {-text \
{The INT menu invokes demonstrations of the PRL-GRAPHICS \
INT object subprograms.  The INT object is \
an exact representation of an integral integer value. \
} -aspect 450 -justify left} {OK {}}
}
#                       "LINE2D" button
.menu.more.defs add command -label "LINE2D" -command \
{ mkDialog .modal {-text \
{The LINE2D menu invokes demonstrations of the PRL-GRAPHICS \
LINE2D object subprograms.  The LINE2D object is \
a straight line segment drawn between two 2D points in a specified line style. \
} -aspect 450 -justify left} {OK {}}
}
#                       "LOGPEN2" button
.menu.more.defs add command -label "LOGPEN2" -command \
{ mkDialog .modal {-text \
{The LOGPEN2 menu invokes demonstrations of the PRL-GRAPHICS \
LOGPEN2 object subprograms.  The LOGPEN2 object is \
the 2D drawing cursor or logical pen. \
} -aspect 450 -justify left} {OK {}}
}
#                       "MARGIN" button
.menu.more.defs add command -label "MARGIN" -command \
{ mkDialog .modal {-text \
{The MARGIN menu invokes demonstrations of the PRL-GRAPHICS \
MARGIN object subprograms.  The MARGIN object is \
a rectangular boundary surrounding the subplot area. \
} -aspect 450 -justify left} {OK {}}
}
#                       "MARKER" button
.menu.more.defs add command -label "MARKER" -command \
{ mkDialog .modal {-text \
{The MARKER menu invokes demonstrations of the PRL-GRAPHICS \
MARKER object subprograms.  The MARKER object is \
a geometric shape drawn at the coordinates of a point. \
} -aspect 450 -justify left} {OK {}}
}
#                       "ORIGIN" button
.menu.more.defs add command -label "ORIGIN" -command \
{ mkDialog .modal {-text \
{The ORIGIN menu invokes demonstrations of the PRL-GRAPHICS \
ORIGIN object subprograms.  The ORIGIN object is \
the lower left-hand corner of a subplot. \
} -aspect 450 -justify left} {OK {}}
}
#                       "PAGE" button
.menu.more.defs add command -label "PAGE" -command \
{ mkDialog .modal {-text \
{The PAGE menu invokes demonstrations of the PRL-GRAPHICS \
PAGE object subprograms.  The PAGE object is \
a drawing surface of fixed size. \
} -aspect 450 -justify left} {OK {}}
}
#                       "PRL" button
.menu.more.defs add command -label "PRL" -command \
{ mkDialog .modal {-text \
{The PRL menu invokes demonstrations of the PRL-GRAPHICS \
PRL object subprograms.  The PRL object is \
the grandparent object of all Programmer's Reusable Library objects. \
} -aspect 450 -justify left} {OK {}}
}
#                       "PROCESS" button
.menu.more.defs add command -label "PROCESS" -command \
{ mkDialog .modal {-text \
{The PROCESS menu invokes demonstrations of the PRL-GRAPHICS \
PROCESS object subprograms.  The PROCESS object is \
a single thread of control that executes within an address space. \
} -aspect 450 -justify left} {OK {}}
}
#                       "REAL" button
.menu.more.defs add command -label "REAL" -command \
{ mkDialog .modal {-text \
{The REAL menu invokes demonstrations of the PRL-GRAPHICS \
REAL object subprograms.  The REAL object is \
a processor approximation to the value of a real number. \
} -aspect 450 -justify left} {OK {}}
}
#                       "SUBPLOT" button
.menu.more.defs add command -label "SUBPLOT" -command \
{ mkDialog .modal {-text \
{The SUBPLOT menu invokes demonstrations of the PRL-GRAPHICS \
SUBPLOT object subprograms.  The SUBPLOT object is \
a collection of graphical objects associated with a given reference system. \
} -aspect 450 -justify left} {OK {}}
}
#                       "TEXT2D" button
.menu.more.defs add command -label "TEXT2D" -command \
{ mkDialog .modal {-text \
{The TEXT2D menu invokes demonstrations of the PRL-GRAPHICS \
TEXT2D object subprograms.  The TEXT2D object is \
a linear arrangement of 2D symbols drawn on the graphics output device. \
} -aspect 450 -justify left} {OK {}}
}
#     ******************************************************************
#
#                       Pack menus
#
pack .menu.demo \
     .menu.prl \
     .menu.device \
     .menu.graphics \
     .menu.setup \
     .menu.line \
     .menu.char \
     .menu.process \
     .menu.more -side left
#
#     ******************************************************************
#
#                       Set up for keyboard-based menu traversal
#
bind . <Any-FocusIn> {
    if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
	focus .menu
    }
}
tk_menuBar .menu .menu.demo \
           .menu.prl \
           .menu.device \
           .menu.graphics \
           .menu.setup \
           .menu.line \
           .menu.char \
           .menu.process \
           .menu.more
#
#     ******************************************************************
#
#                       Position a dialog box on the screen
#
proc dpos w {
    wm geometry $w +300+300
}
#
STOP_CAT
echo "  Generating =====> [ ./blnkarea1.f ]"
cat <<"STOP_CAT"> ././blnkarea1.f
C     PROGRAM BLNKAREA1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program BLNKAREA_DEF
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       BLNKAREA object access program
      EXTERNAL BLNKAREA_DEF
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LINE2D_THICK
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV103 =  2)
      PARAMETER (NVV104 =  2)
      PARAMETER (NVV105 =  2)
      PARAMETER (NVV106 =  2)
      PARAMETER (NVV107 =  5)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'BLNKAREA.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
      REAL    XORG, TMP103, YORG, TMP104, WIDE, TMP105, HIGH, TMP106
     *      , FRM, TMP107
      REAL    XPAGE, YPAGE
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
      REAL    VV105(NVV105)
      REAL    VV106(NVV106)
      REAL    VV107(NVV107)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /4/
C
      DATA VV103 /1.0, 2.0/
C
      DATA VV104 /4.0, 5.0/
C
      DATA VV105 /2., 3.99/
C
      DATA VV106 /2., 3.99/
C
      DATA VV107 /0.1, 1.1, -.1, -1.1, 0.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'blnkarea_def.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              BLNKAREA Object Demo Program #1'/
     * ' This program tests the BLNKAREA object access program'/
     * ' BLNKAREA_DEF.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test BLNKAREA_DEF object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        KZBLCN = VV101(IVV101)
C
      DO 584 IVV107 = 1,NVV107
        FRM = VV107(IVV107)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL LINE2D_THICK (0.1)
C
      DO 588 IVV103 = 1,NVV103
        XORG = VV103(IVV103)
C
      DO 587 IVV104 = 1,NVV104
        YORG = VV104(IVV104)
C
      DO 586 IVV105 = 1,NVV105
        WIDE = VV105(IVV105)
C
      DO 585 IVV106 = 1,NVV106
        HIGH = VV106(IVV106)
C
C                       Define and activate fifth and higher blank areas
C                       relative to origin
      CALL BLNKAREA_DEF (XORG,YORG,WIDE,HIGH,FRM)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP103,TMP104,TMP105,TMP106,
     *       TMP107
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZBLCN .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZBLCN,XORG,YORG,WIDE,HIGH,FRM
  502 FORMAT (I21,E15.7,E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
  585 CONTINUE
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (3.,0.,0)
      CALL LINE2D_DRAW (4.,10.0,0)
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Repeat for next variable value
  584 CONTINUE
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              BLNKAREA Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./blnkarea2.f ]"
cat <<"STOP_CAT"> ././blnkarea2.f
C     PROGRAM BLNKAREA2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program BLNKAREA_DEF1,
C              BLNKAREA_DEF2, BLNKAREA_DEF3, and BLNKAREA_DEF4
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       BLNKAREA object access program
      EXTERNAL BLNKAREA_DEF1, BLNKAREA_DEF2, BLNKAREA_DEF3,
     *         BLNKAREA_DEF4
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LINE2D_THICK
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV102 =  1)
      PARAMETER (NVV103 =  1)
      PARAMETER (NVV104 =  1)
      PARAMETER (NVV105 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER IFRAME, TMP105
C
C                       Real variables and arrays
      REAL    XPOS1, TMP101, XPOS2, TMP102, YPOS1, TMP103, YPOS2, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV102(NVV102)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
      INTEGER VV105(NVV105)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /1.0/
C
      DATA VV102 /7.0/
C
      DATA VV103 /2.0/
C
      DATA VV104 /4.0/
C
      DATA VV105 /0, 4/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'blnkarea_def1.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              BLNKAREA Object Demo Program #2'/
     * ' This program tests the BLNKAREA object access programs'/
     * ' BLNKAREA_DEF1 through BLNKAREA_DEF4.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test BLNKAREA_DEF1 object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        XPOS1 = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        XPOS2 = VV102(IVV102)
C
      DO 587 IVV103 = 1,NVV103
        YPOS1 = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        YPOS2 = VV104(IVV104)
C
      DO 585 IVV105 = 1,NVV105
        IFRAME = VV105(IVV105)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL LINE2D_THICK (0.1)
C
C                       Define and activate first blank area
      CALL BLNKAREA_DEF1 (XPOS1-1.,XPOS2-1.,YPOS1-1.,YPOS2-1.,IFRAME)
C
C                       Define and activate second blank area
      CALL BLNKAREA_DEF2 (XPOS1,XPOS2,YPOS1,YPOS2,IFRAME)
C
C                       Define and activate third blank area
      CALL BLNKAREA_DEF3 (XPOS1+1.,XPOS2+1.,YPOS1+1.,YPOS2+1.,IFRAME)
C
C                       Define and activate fourth blank area
      CALL BLNKAREA_DEF4 (XPOS1+2.,XPOS2+2.,YPOS1+2.,YPOS2+2.,IFRAME)
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (3.,0.,0)
      CALL LINE2D_DRAW (4.,10.0,0)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) XPOS1,XPOS2,YPOS1,YPOS2,IFRAME
  502 FORMAT (E15.7,E15.7,E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  585 CONTINUE
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              BLNKAREA Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./blnkarea3.f ]"
cat <<"STOP_CAT"> ././blnkarea3.f
C     PROGRAM BLNKAREA3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program BLNKAREA_DEFR
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       BLNKAREA object access program
      EXTERNAL BLNKAREA_DEFR
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LINE2D_THICK
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV103 =  2)
      PARAMETER (NVV104 =  2)
      PARAMETER (NVV105 =  2)
      PARAMETER (NVV106 =  2)
      PARAMETER (NVV107 =  1)
      PARAMETER (NVV108 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'BLNKAREA.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101, LREL, TMP108
C
C                       Real variables and arrays
      REAL    XORG, TMP103, YORG, TMP104, WIDE, TMP105, HIGH, TMP106
     *      , FRM, TMP107
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
      REAL    VV105(NVV105)
      REAL    VV106(NVV106)
      REAL    VV107(NVV107)
      INTEGER VV108(NVV108)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /4/
C
      DATA VV103 /1.0, 2.0/
C
      DATA VV104 /4.0, 5.0/
C
      DATA VV105 /2., 3.99/
C
      DATA VV106 /2., 3.99/
C
      DATA VV107 /0.1/
C
      DATA VV108 /0, 1, 2, 3/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'blnkarea_defr.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              BLNKAREA Object Demo Program #3'/
     * ' This program tests the BLNKAREA object access program'/
     * ' BLNKAREA_DEFR.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test BLNKAREA_DEFR object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        KZBLCN = VV101(IVV101)
C
      DO 584 IVV107 = 1,NVV107
        FRM = VV107(IVV107)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL LINE2D_THICK (0.1)
C
      DO 588 IVV103 = 1,NVV103
        XORG = VV103(IVV103)
C
      DO 587 IVV104 = 1,NVV104
        YORG = VV104(IVV104)
C
      DO 586 IVV105 = 1,NVV105
        WIDE = VV105(IVV105)
C
      DO 585 IVV106 = 1,NVV106
        HIGH = VV106(IVV106)
C
      DO 583 IVV108 = 1,NVV108
        LREL = VV108(IVV108)
C
C                       Define and activate blank areas 5+ relative to
C                       current location or origin
      CALL BLNKAREA_DEFR (XORG,YORG,WIDE,HIGH,FRM,LREL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP103,TMP104,TMP105,TMP106,
     *       TMP107,TMP108
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZBLCN .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZBLCN,XORG,YORG,WIDE,HIGH,FRM,LREL
  502 FORMAT (I21,E15.7,E15.7,E15.7,E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  583 CONTINUE
  585 CONTINUE
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (3.,0.,0)
      CALL LINE2D_DRAW (4.,10.0,0)
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Repeat for next variable value
  584 CONTINUE
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              BLNKAREA Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./blnkarea_def.dat ]"
cat <<"STOP_CAT"> ././blnkarea_def.uuu
begin 660 ./blnkarea_def.dat
M("`@("`@("`@("`@("`@("`@("`U("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P
M,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P
M,#!%*S`P"B`@("`@("`@("`@("`@("`@("`@-B`@("XQ,#`P,#`P12LP,2`@
M("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@
M("XQ,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@(#<@("`N,3`P,#`P
M,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P
M,$4K,#$@("`N,3`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@("`X("`@
M+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@
M+C,Y.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@
M("`@.2`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR,#`P,#`P
M12LP,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,`H@("`@("`@("`@
M("`@("`@("`@,3`@("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N
M,C`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`*("`@
M("`@("`@("`@("`@("`@(#$Q("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%
M*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%
M*S`P"B`@("`@("`@("`@("`@("`@("`Q,B`@("XQ,#`P,#`P12LP,2`@("XU
M,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ
M,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@,3,@("`N,C`P,#`P,$4K
M,#$@("`N-#`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K
M,#$@("`N,3`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@(#$T("`@+C(P
M,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y
M.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`Q
M-2`@("XR,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XS.3DP,#`P12LP
M,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,`H@("`@("`@("`@("`@
M("`@("`@,38@("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY
M,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`*("`@("`@
M("`@("`@("`@("`@(#$W("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P
M"B`@("`@("`@("`@("`@("`@("`Q."`@("XR,#`P,#`P12LP,2`@("XU,#`P
M,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,#`P
M,#`P12LP,`H@("`@("`@("`@("`@("`@("`@,3D@("`N,C`P,#`P,$4K,#$@
M("`N-3`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@
M("`N,3`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@(#(P("`@+C(P,#`P
M,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P
M,#!%*S`Q("`@+C$P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`@-2`@
M("XQ,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@
M("XR,#`P,#`P12LP,2`@("XQ,3`P,#`P12LP,0H@("`@("`@("`@("`@("`@
M("`@(#8@("`N,3`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,C`P,#`P
M,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3$P,#`P,$4K,#$*("`@("`@("`@
M("`@("`@("`@("`W("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@
M+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$Q,#`P,#!%*S`Q"B`@
M("`@("`@("`@("`@("`@("`@."`@("XQ,#`P,#`P12LP,2`@("XT,#`P,#`P
M12LP,2`@("XS.3DP,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,3`P,#`P
M12LP,0H@("`@("`@("`@("`@("`@("`@(#D@("`N,3`P,#`P,$4K,#$@("`N
M-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N
M,3$P,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@(#$P("`@+C$P,#`P,#!%
M*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%
M*S`Q("`@+C$Q,#`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`Q,2`@("XQ
M,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XR
M,#`P,#`P12LP,2`@("XQ,3`P,#`P12LP,0H@("`@("`@("`@("`@("`@("`@
M,3(@("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,SDY,#`P,$4K
M,#$@("`N,SDY,#`P,$4K,#$@("`N,3$P,#`P,$4K,#$*("`@("`@("`@("`@
M("`@("`@(#$S("`@+C(P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P
M,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$Q,#`P,#!%*S`Q"B`@("`@
M("`@("`@("`@("`@("`Q-"`@("XR,#`P,#`P12LP,2`@("XT,#`P,#`P12LP
M,2`@("XR,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,3`P,#`P12LP
M,0H@("`@("`@("`@("`@("`@("`@,34@("`N,C`P,#`P,$4K,#$@("`N-#`P
M,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3$P
M,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@(#$V("`@+C(P,#`P,#!%*S`Q
M("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q
M("`@+C$Q,#`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`Q-R`@("XR,#`P
M,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XR,#`P
M,#`P12LP,2`@("XQ,3`P,#`P12LP,0H@("`@("`@("`@("`@("`@("`@,3@@
M("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@
M("`N,SDY,#`P,$4K,#$@("`N,3$P,#`P,$4K,#$*("`@("`@("`@("`@("`@
M("`@(#$Y("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P
M,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$Q,#`P,#!%*S`Q"B`@("`@("`@
M("`@("`@("`@("`R,"`@("XR,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@
M("XS.3DP,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,3`P,#`P12LP,0H@
M("`@("`@("`@("`@("`@("`@(#4@("`N,3`P,#`P,$4K,#$@("`N-#`P,#`P
M,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("TN,3`P,#`P
M,$4K,#`*("`@("`@("`@("`@("`@("`@("`V("`@+C$P,#`P,#!%*S`Q("`@
M+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`M
M+C$P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`@-R`@("XQ,#`P,#`P
M12LP,2`@("XT,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P
M12LP,2`@+2XQ,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@(#@@("`N
M,3`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N
M,SDY,#`P,$4K,#$@("TN,3`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@
M("`Y("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C(P,#`P,#!%
M*S`Q("`@+C(P,#`P,#!%*S`Q("`M+C$P,#`P,#!%*S`P"B`@("`@("`@("`@
M("`@("`@("`Q,"`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR
M,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@+2XQ,#`P,#`P12LP,`H@("`@
M("`@("`@("`@("`@("`@,3$@("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K
M,#$@("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("TN,3`P,#`P,$4K
M,#`*("`@("`@("`@("`@("`@("`@(#$R("`@+C$P,#`P,#!%*S`Q("`@+C4P
M,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`M+C$P
M,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`Q,R`@("XR,#`P,#`P12LP
M,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP
M,2`@+2XQ,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@,30@("`N,C`P
M,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY
M,#`P,$4K,#$@("TN,3`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@(#$U
M("`@+C(P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`M+C$P,#`P,#!%*S`P"B`@("`@("`@("`@("`@
M("`@("`Q-B`@("XR,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XS.3DP
M,#`P12LP,2`@("XS.3DP,#`P12LP,2`@+2XQ,#`P,#`P12LP,`H@("`@("`@
M("`@("`@("`@("`@,3<@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@
M("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("TN,3`P,#`P,$4K,#`*
M("`@("`@("`@("`@("`@("`@(#$X("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P
M,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`M+C$P,#`P
M,#!%*S`P"B`@("`@("`@("`@("`@("`@("`Q.2`@("XR,#`P,#`P12LP,2`@
M("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P12LP,2`@
M+2XQ,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@,C`@("`N,C`P,#`P
M,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,SDY,#`P
M,$4K,#$@("TN,3`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@("`U("`@
M+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@
M+C(P,#`P,#!%*S`Q("`M+C$Q,#`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@
M("`@-B`@("XQ,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P
M12LP,2`@("XS.3DP,#`P12LP,2`@+2XQ,3`P,#`P12LP,0H@("`@("`@("`@
M("`@("`@("`@(#<@("`N,3`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N
M,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("TN,3$P,#`P,$4K,#$*("`@
M("`@("`@("`@("`@("`@("`X("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%
M*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`M+C$Q,#`P,#!%
M*S`Q"B`@("`@("`@("`@("`@("`@("`@.2`@("XQ,#`P,#`P12LP,2`@("XU
M,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@+2XQ
M,3`P,#`P12LP,0H@("`@("`@("`@("`@("`@("`@,3`@("`N,3`P,#`P,$4K
M,#$@("`N-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY,#`P,$4K
M,#$@("TN,3$P,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@(#$Q("`@+C$P
M,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C(P
M,#`P,#!%*S`Q("`M+C$Q,#`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`Q
M,B`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP
M,2`@("XS.3DP,#`P12LP,2`@+2XQ,3`P,#`P12LP,0H@("`@("`@("`@("`@
M("`@("`@,3,@("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,C`P
M,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("TN,3$P,#`P,$4K,#$*("`@("`@
M("`@("`@("`@("`@(#$T("`@+C(P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`M+C$Q,#`P,#!%*S`Q
M"B`@("`@("`@("`@("`@("`@("`Q-2`@("XR,#`P,#`P12LP,2`@("XT,#`P
M,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P12LP,2`@+2XQ,3`P
M,#`P12LP,0H@("`@("`@("`@("`@("`@("`@,38@("`N,C`P,#`P,$4K,#$@
M("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@
M("TN,3$P,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@(#$W("`@+C(P,#`P
M,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P
M,#!%*S`Q("`M+C$Q,#`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`Q."`@
M("XR,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@
M("XS.3DP,#`P12LP,2`@+2XQ,3`P,#`P12LP,0H@("`@("`@("`@("`@("`@
M("`@,3D@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,SDY,#`P
M,$4K,#$@("`N,C`P,#`P,$4K,#$@("TN,3$P,#`P,$4K,#$*("`@("`@("`@
M("`@("`@("`@(#(P("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@
M+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`M+C$Q,#`P,#!%*S`Q"B`@
M("`@("`@("`@("`@("`@("`@-2`@("XQ,#`P,#`P12LP,2`@("XT,#`P,#`P
M12LP,2`@("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XP,#`P,#`P
M12LP,`H@("`@("`@("`@("`@("`@("`@(#8@("`N,3`P,#`P,$4K,#$@("`N
M-#`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N
M,#`P,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@("`W("`@+C$P,#`P,#!%
M*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%
M*S`Q("`@+C`P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`@."`@("XQ
M,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XS
M.3DP,#`P12LP,2`@("XP,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@
M(#D@("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K
M,#$@("`N,C`P,#`P,$4K,#$@("`N,#`P,#`P,$4K,#`*("`@("`@("`@("`@
M("`@("`@(#$P("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C(P
M,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C`P,#`P,#!%*S`P"B`@("`@
M("`@("`@("`@("`@("`Q,2`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP
M,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XP,#`P,#`P12LP
M,`H@("`@("`@("`@("`@("`@("`@,3(@("`N,3`P,#`P,$4K,#$@("`N-3`P
M,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,#`P
M,#`P,$4K,#`*("`@("`@("`@("`@("`@("`@(#$S("`@+C(P,#`P,#!%*S`Q
M("`@+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q
M("`@+C`P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`Q-"`@("XR,#`P
M,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP
M,#`P12LP,2`@("XP,#`P,#`P12LP,`H@("`@("`@("`@("`@("`@("`@,34@
M("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@
M("`N,C`P,#`P,$4K,#$@("`N,#`P,#`P,$4K,#`*("`@("`@("`@("`@("`@
M("`@(#$V("`@+C(P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P
M,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C`P,#`P,#!%*S`P"B`@("`@("`@
M("`@("`@("`@("`Q-R`@("XR,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@
M("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XP,#`P,#`P12LP,`H@
M("`@("`@("`@("`@("`@("`@,3@@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P
M,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,#`P,#`P
M,$4K,#`*("`@("`@("`@("`@("`@("`@(#$Y("`@+C(P,#`P,#!%*S`Q("`@
M+C4P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@
M+C`P,#`P,#!%*S`P"B`@("`@("`@("`@("`@("`@("`R,"`@("XR,#`P,#`P
M12LP,2`@("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XS.3DP,#`P
412LP,2`@("XP,#`P,#`P12LP,`H@
`
end
STOP_CAT
echo "  Generating =====> [ ./blnkarea_def1.dat ]"
cat <<"STOP_CAT"> ././blnkarea_def1.uuu
begin 660 ./blnkarea_def1.dat
M("`@+C$P,#`P,#!%*S`Q("`@+C<P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q
M("`@+C0P,#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@("`P"B`@("XQ,#`P
M,#`P12LP,2`@("XW,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XT,#`P
=,#`P12LP,2`@("`@("`@("`@("`@("`@("`@-`HP
`
end
STOP_CAT
echo "  Generating =====> [ ./blnkarea_defr.dat ]"
cat <<"STOP_CAT"> ././blnkarea_defr.uuu
begin 660 ./blnkarea_defr.dat
M("`@("`@("`@("`@("`@("`@("`U("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P
M,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P
M,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@
M("`@-B`@("XQ,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P
M12LP,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@
M("`@("`@("`@,0H@("`@("`@("`@("`@("`@("`@(#<@("`N,3`P,#`P,$4K
M,#$@("`N-#`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K
M,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#(*("`@("`@
M("`@("`@("`@("`@("`X("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P
M("`@("`@("`@("`@("`@("`@("`S"B`@("`@("`@("`@("`@("`@("`@.2`@
M("XQ,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@
M("XS.3DP,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@
M("`@,`H@("`@("`@("`@("`@("`@("`@,3`@("`N,3`P,#`P,$4K,#$@("`N
M-#`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N
M,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#$*("`@("`@("`@("`@
M("`@("`@(#$Q("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P
M,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@
M("`@("`@("`@("`@("`R"B`@("`@("`@("`@("`@("`@("`Q,B`@("XQ,#`P
M,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP
M,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,PH@
M("`@("`@("`@("`@("`@("`@,3,@("`N,3`P,#`P,$4K,#$@("`N-#`P,#`P
M,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P
M,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@
M(#$T("`@+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%
M*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@
M("`@("`@("`Q"B`@("`@("`@("`@("`@("`@("`Q-2`@("XQ,#`P,#`P12LP
M,2`@("XT,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P12LP
M,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,@H@("`@("`@
M("`@("`@("`@("`@,38@("`N,3`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@
M("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@
M("`@("`@("`@("`@("`@("`@(#,*("`@("`@("`@("`@("`@("`@(#$W("`@
M+C$P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@
M+C,Y.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@
M("`P"B`@("`@("`@("`@("`@("`@("`Q."`@("XQ,#`P,#`P12LP,2`@("XT
M,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ
M,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,0H@("`@("`@("`@("`@
M("`@("`@,3D@("`N,3`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY
M,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@
M("`@("`@("`@("`@(#(*("`@("`@("`@("`@("`@("`@(#(P("`@+C$P,#`P
M,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P
M,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`S"B`@
M("`@("`@("`@("`@("`@("`R,2`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P
M12LP,2`@("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P
M12LP,"`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@
M,C(@("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K
M,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@
M("`@("`@(#$*("`@("`@("`@("`@("`@("`@(#(S("`@+C$P,#`P,#!%*S`Q
M("`@+C4P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q
M("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`R"B`@("`@("`@
M("`@("`@("`@("`R-"`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@
M("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@
M("`@("`@("`@("`@("`@("`@,PH@("`@("`@("`@("`@("`@("`@,C4@("`N
M,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N
M,SDY,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@
M(#`*("`@("`@("`@("`@("`@("`@(#(V("`@+C$P,#`P,#!%*S`Q("`@+C4P
M,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C$P
M,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`Q"B`@("`@("`@("`@("`@
M("`@("`R-R`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR,#`P
M,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@
M("`@("`@("`@("`@,@H@("`@("`@("`@("`@("`@("`@,C@@("`N,3`P,#`P
M,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY,#`P
M,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#,*("`@
M("`@("`@("`@("`@("`@(#(Y("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%
M*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%
M*S`P("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`S
M,"`@("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP
M,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@
M("`@("`@,0H@("`@("`@("`@("`@("`@("`@,S$@("`N,3`P,#`P,$4K,#$@
M("`N-3`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@
M("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#(*("`@("`@("`@
M("`@("`@("`@(#,R("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@
M+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@
M("`@("`@("`@("`@("`@("`S"B`@("`@("`@("`@("`@("`@("`S,R`@("XQ
M,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XS
M.3DP,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@
M,`H@("`@("`@("`@("`@("`@("`@,S0@("`N,3`P,#`P,$4K,#$@("`N-3`P
M,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P
M,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#$*("`@("`@("`@("`@("`@
M("`@(#,U("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P
M,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@
M("`@("`@("`@("`R"B`@("`@("`@("`@("`@("`@("`S-B`@("XQ,#`P,#`P
M12LP,2`@("XU,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XS.3DP,#`P
M12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,PH@("`@
M("`@("`@("`@("`@("`@,S<@("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K
M,#$@("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K
M,#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#,X
M("`@+C(P,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@
M("`@("`Q"B`@("`@("`@("`@("`@("`@("`S.2`@("XR,#`P,#`P12LP,2`@
M("XT,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@
M("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,@H@("`@("`@("`@
M("`@("`@("`@-#`@("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N
M,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@
M("`@("`@("`@("`@("`@(#,*("`@("`@("`@("`@("`@("`@(#0Q("`@+C(P
M,#`P,#!%*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y
M.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P
M"B`@("`@("`@("`@("`@("`@("`T,B`@("XR,#`P,#`P12LP,2`@("XT,#`P
M,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,#`P
M,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,0H@("`@("`@("`@("`@("`@
M("`@-#,@("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,C`P,#`P
M,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@
M("`@("`@("`@(#(*("`@("`@("`@("`@("`@("`@(#0T("`@+C(P,#`P,#!%
M*S`Q("`@+C0P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%
M*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`S"B`@("`@
M("`@("`@("`@("`@("`T-2`@("XR,#`P,#`P12LP,2`@("XT,#`P,#`P12LP
M,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP
M,"`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@-#8@
M("`N,C`P,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@
M("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@
M("`@(#$*("`@("`@("`@("`@("`@("`@(#0W("`@+C(P,#`P,#!%*S`Q("`@
M+C0P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@
M+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`R"B`@("`@("`@("`@
M("`@("`@("`T."`@("XR,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XS
M.3DP,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@
M("`@("`@("`@("`@("`@,PH@("`@("`@("`@("`@("`@("`@-#D@("`N,C`P
M,#`P,$4K,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,SDY
M,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*
M("`@("`@("`@("`@("`@("`@(#4P("`@+C(P,#`P,#!%*S`Q("`@+C0P,#`P
M,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C$P,#`P
M,#!%*S`P("`@("`@("`@("`@("`@("`@("`Q"B`@("`@("`@("`@("`@("`@
M("`U,2`@("XR,#`P,#`P12LP,2`@("XT,#`P,#`P12LP,2`@("XS.3DP,#`P
M12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@
M("`@("`@("`@,@H@("`@("`@("`@("`@("`@("`@-3(@("`N,C`P,#`P,$4K
M,#$@("`N-#`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,SDY,#`P,$4K
M,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#,*("`@("`@
M("`@("`@("`@("`@(#4S("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P
M("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`U-"`@
M("XR,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@
M("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@
M("`@,0H@("`@("`@("`@("`@("`@("`@-34@("`N,C`P,#`P,$4K,#$@("`N
M-3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N
M,3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#(*("`@("`@("`@("`@
M("`@("`@(#4V("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C(P
M,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@
M("`@("`@("`@("`@("`S"B`@("`@("`@("`@("`@("`@("`U-R`@("XR,#`P
M,#`P12LP,2`@("XU,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP
M,#`P12LP,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@
M("`@("`@("`@("`@("`@("`@-3@@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P
M,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P,#`P
M,$4K,#`@("`@("`@("`@("`@("`@("`@(#$*("`@("`@("`@("`@("`@("`@
M(#4Y("`@+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C(P,#`P,#!%
M*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@
M("`@("`@("`R"B`@("`@("`@("`@("`@("`@("`V,"`@("XR,#`P,#`P12LP
M,2`@("XU,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XS.3DP,#`P12LP
M,2`@("XQ,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,PH@("`@("`@
M("`@("`@("`@("`@-C$@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@
M("`N,SDY,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@
M("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#8R("`@
M+C(P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@
M+C(P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@
M("`Q"B`@("`@("`@("`@("`@("`@("`V,R`@("XR,#`P,#`P12LP,2`@("XU
M,#`P,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XQ
M,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,@H@("`@("`@("`@("`@
M("`@("`@-C0@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,SDY
M,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@
M("`@("`@("`@("`@(#,*("`@("`@("`@("`@("`@("`@(#8U("`@+C(P,#`P
M,#!%*S`Q("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P
M,#!%*S`Q("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@
M("`@("`@("`@("`@("`@("`V-B`@("XR,#`P,#`P12LP,2`@("XU,#`P,#`P
M12LP,2`@("XS.3DP,#`P12LP,2`@("XS.3DP,#`P12LP,2`@("XQ,#`P,#`P
M12LP,"`@("`@("`@("`@("`@("`@("`@,0H@("`@("`@("`@("`@("`@("`@
M-C<@("`N,C`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#$@("`N,SDY,#`P,$4K
M,#$@("`N,SDY,#`P,$4K,#$@("`N,3`P,#`P,$4K,#`@("`@("`@("`@("`@
M("`@("`@(#(*("`@("`@("`@("`@("`@("`@(#8X("`@+C(P,#`P,#!%*S`Q
M("`@+C4P,#`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q("`@+C,Y.3`P,#!%*S`Q
E("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`S"C`P
`
end
STOP_CAT
echo "  Generating =====> [ ./color1.f ]"
cat <<"STOP_CAT"> ././color1.f
C     PROGRAM COLOR1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program COLOR_DEFHSI and
C              COLOR_SETNUM
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       COLOR object access program
      EXTERNAL COLOR_DEFHSI, COLOR_SETNUM
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LINE2D_THICK
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  9)
      PARAMETER (NVV103 =  2)
      PARAMETER (NVV104 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER ICOLOR, TMP101, IERR, TMP105
C
C                       Real variables and arrays
      REAL    HUE, TMP102, SAT, TMP103, AINT, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV102(NVV102)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0/
C
      DATA VV103 /.5, 1.0/
C
      DATA VV104 /.5, 1.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'color_defhsi.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              COLOR Object Demo Program #1'/
     * ' This program tests the COLOR object access program'/
     * ' COLOR_DEFHSI.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      XINC = XPAGE/(NVV102*NVV103*NVV104)
      CALL LINE2D_THICK (XINC*0.9)
C
C     ------------------------------------------------------------------
C
C                       Test COLOR_DEFHSI object access program
C
      XC = XINC*.5
C                       Loop for each input variable of access program
      ICOLOR = 7
      DO 587 IVV103 = 1,NVV103
        SAT = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        AINT = VV104(IVV104)
        ICOLOR = ICOLOR+1
C
      DO 588 IVV102 = 1,NVV102
        HUE = VV102(IVV102)
C
C                       Define a new drawing color using the HSI color
C                       model
      CALL COLOR_DEFHSI (ICOLOR,HUE,SAT,AINT,IERR)
      CALL COLOR_SETNUM (ICOLOR,IERR)
C
C                       Draw straight line relative to origin
      XC = XC+XINC
      CALL LOGPEN2_SETP (XC,0.,0)
      CALL LINE2D_DRAW (XC,YPAGE,0)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (IERR .NE. TMP105) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ICOLOR,HUE,SAT,AINT,IERR
  502 FORMAT (I21,E15.7,E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
  586 CONTINUE
  587 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              COLOR Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./color2.f ]"
cat <<"STOP_CAT"> ././color2.f
C     PROGRAM COLOR2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program COLOR_DEFRGB and
C              COLOR_SETNUM
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       COLOR object access program
      EXTERNAL COLOR_DEFRGB, COLOR_SETNUM
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LINE2D_THICK
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  2)
      PARAMETER (NVV103 =  2)
      PARAMETER (NVV104 =  7)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER ICOLOR, TMP101, IERR, TMP105
C
C                       Real variables and arrays
      REAL    RED, TMP102, GRN, TMP103, BLU, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV102(NVV102)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /50., 100.0/
C
      DATA VV103 /50., 100.0/
C
      DATA VV104 /0.0, 15., 30., 45., 60., 75., 100.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'color_defrgb.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              COLOR Object Demo Program #2'/
     * ' This program tests the COLOR object access program'/
     * ' COLOR_DEFRGB.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      XINC = XPAGE/(NVV102*NVV103*NVV104)
      CALL LINE2D_THICK (XINC*0.9)
C
C     ------------------------------------------------------------------
C
C                       Test COLOR_DEFRGB object access program
C
      XC = XINC*.5
C                       Loop for each input variable of access program
      ICOLOR = 7
      DO 588 IVV102 = 1,NVV102
        RED = VV102(IVV102)
C
      DO 587 IVV103 = 1,NVV103
        GRN = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        BLU = VV104(IVV104)
        ICOLOR = ICOLOR+1
C
C                       Define a new drawing color using the RGB color
C                       model
      CALL COLOR_DEFRGB (ICOLOR,RED,GRN,BLU,IERR)
      CALL COLOR_SETNUM (ICOLOR,IERR)
C
C                       Draw straight line relative to origin
      XC = XC+XINC
      CALL LOGPEN2_SETP (XC,0.,0)
      CALL LINE2D_DRAW (XC,YPAGE,0)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (IERR .NE. TMP105 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ICOLOR,RED,GRN,BLU,IERR
  502 FORMAT (I21,E15.7,E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              COLOR Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./color3.f ]"
cat <<"STOP_CAT"> ././color3.f
C     PROGRAM COLOR3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program COLOR_SETNAM
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       COLOR object access program
      EXTERNAL COLOR_SETNAM
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LINE2D_THICK
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV104 = 10)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'COLOR.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER TMP102*8, COLORN*4, TMP104*4
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*4 VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
      DATA VV104 /'BACK', 'BLAC', 'FORE', 'WHIT', 'RED', 'GREE', 'BLUE'
     *            , 'YELL', 'MAGE', 'CYAN'/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'color_setnam.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              COLOR Object Demo Program #3'/
     * ' This program tests the COLOR object access program'/
     * ' COLOR_SETNAM.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL LINE2D_THICK (0.8)
C
C     ------------------------------------------------------------------
C
C                       Test COLOR_SETNAM object access program
C
      DO 588 IVV104 = 1,NVV104
        COLORN = VV104(IVV104)
C
C                       Select current drawing color using color name
      CALL COLOR_SETNAM (COLORN)
C
C                       Draw straight line relative to origin
      XC = FLOAT(IVV104)
      CALL LOGPEN2_SETP (XC,0.,0)
      CALL LINE2D_DRAW (XC,10.0,0)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZCOLR .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (CZCOLR .NE. TMP102 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZCOLR,CZCOLR,COLORN
  502 FORMAT (I21,A,A)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              COLOR Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./color_defhsi.dat ]"
cat <<"STOP_CAT"> ././color_defhsi.uuu
begin 660 ./color_defhsi.dat
M("`@("`@("`@("`@("`@("`@("`X("`@+C`P,#`P,#!%*S`P("`@+C4P,#`P
M,#!%*S`P("`@+C4P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@
M("`@("`@("`@("`@("`@("`@."`@("XU,#`P,#`P12LP,"`@("XU,#`P,#`P
M12LP,"`@("XU,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@("`@
M("`@("`@("`@("`@("`@(#@@("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K
M,#`@("`N-3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@
M("`@("`@("`@("`@("`X("`@+C$U,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`P
M("`@+C4P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@
M("`@("`@("`@("`@."`@("XR,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,"`@
M("XU,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@
M("`@("`@("`@(#@@("`N,C4P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#`@("`N
M-3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@
M("`@("`@("`X("`@+C,P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`P("`@+C4P
M,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@
M("`@("`@."`@("XS-3`P,#`P12LP,2`@("XU,#`P,#`P12LP,"`@("XU,#`P
M,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@
M("`@(#@@("`N-#`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#`@("`N-3`P,#`P
M,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@
M("`Y("`@+C`P,#`P,#!%*S`P("`@+C4P,#`P,#!%*S`P("`@+C$P,#`P,#!%
M*S`Q("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`@
M.2`@("XU,#`P,#`P12LP,"`@("XU,#`P,#`P12LP,"`@("XQ,#`P,#`P12LP
M,2`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@(#D@
M("`N,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#`@("`N,3`P,#`P,$4K,#$@
M("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@("`Y("`@
M+C$U,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`P("`@+C$P,#`P,#!%*S`Q("`@
M("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`@.2`@("XR
M,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,"`@("XQ,#`P,#`P12LP,2`@("`@
M("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@(#D@("`N,C4P
M,#`P,$4K,#$@("`N-3`P,#`P,$4K,#`@("`N,3`P,#`P,$4K,#$@("`@("`@
M("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@("`Y("`@+C,P,#`P
M,#!%*S`Q("`@+C4P,#`P,#!%*S`P("`@+C$P,#`P,#!%*S`Q("`@("`@("`@
M("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`@.2`@("XS-3`P,#`P
M12LP,2`@("XU,#`P,#`P12LP,"`@("XQ,#`P,#`P12LP,2`@("`@("`@("`@
M("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@(#D@("`N-#`P,#`P,$4K
M,#$@("`N-3`P,#`P,$4K,#`@("`N,3`P,#`P,$4K,#$@("`@("`@("`@("`@
M("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#$P("`@+C`P,#`P,#!%*S`P
M("`@+C$P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`P("`@("`@("`@("`@("`@
M("`@("`P"B`@("`@("`@("`@("`@("`@("`Q,"`@("XU,#`P,#`P12LP,"`@
M("XQ,#`P,#`P12LP,2`@("XU,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@
M("`@,`H@("`@("`@("`@("`@("`@("`@,3`@("`N,3`P,#`P,$4K,#$@("`N
M,3`P,#`P,$4K,#$@("`N-3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@
M(#`*("`@("`@("`@("`@("`@("`@(#$P("`@+C$U,#`P,#!%*S`Q("`@+C$P
M,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P
M"B`@("`@("`@("`@("`@("`@("`Q,"`@("XR,#`P,#`P12LP,2`@("XQ,#`P
M,#`P12LP,2`@("XU,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@
M("`@("`@("`@("`@("`@("`@,3`@("`N,C4P,#`P,$4K,#$@("`N,3`P,#`P
M,$4K,#$@("`N-3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*("`@
M("`@("`@("`@("`@("`@(#$P("`@+C,P,#`P,#!%*S`Q("`@+C$P,#`P,#!%
M*S`Q("`@+C4P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@("`@
M("`@("`@("`@("`@("`Q,"`@("XS-3`P,#`P12LP,2`@("XQ,#`P,#`P12LP
M,2`@("XU,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@
M("`@("`@("`@("`@,3`@("`N-#`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@
M("`N-3`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@
M("`@("`@("`@(#$Q("`@+C`P,#`P,#!%*S`P("`@+C$P,#`P,#!%*S`Q("`@
M+C$P,#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@
M("`@("`@("`Q,2`@("XU,#`P,#`P12LP,"`@("XQ,#`P,#`P12LP,2`@("XQ
M,#`P,#`P12LP,2`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@
M("`@("`@,3$@("`N,3`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@("`N,3`P
M,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@
M("`@(#$Q("`@+C$U,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`Q("`@+C$P,#`P
M,#!%*S`Q("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@
M("`Q,2`@("XR,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,2`@("XQ,#`P,#`P
M12LP,2`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@
M,3$@("`N,C4P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@("`N,3`P,#`P,$4K
M,#$@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#$Q
M("`@+C,P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`Q("`@+C$P,#`P,#!%*S`Q
M("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`Q,2`@
M("XS-3`P,#`P12LP,2`@("XQ,#`P,#`P12LP,2`@("XQ,#`P,#`P12LP,2`@
M("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@,3$@("`N
M-#`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@("`@
2("`@("`@("`@("`@("`@(#`*
`
end
STOP_CAT
echo "  Generating =====> [ ./color_defrgb.dat ]"
cat <<"STOP_CAT"> ././color_defrgb.uuu
begin 660 ./color_defrgb.dat
M("`@("`@("`@("`@("`@("`@("`X("`@+C4P,#`P,#!%*S`R("`@+C4P,#`P
M,#!%*S`R("`@+C`P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P"B`@
M("`@("`@("`@("`@("`@("`@.2`@("XU,#`P,#`P12LP,B`@("XU,#`P,#`P
M12LP,B`@("XQ-3`P,#`P12LP,B`@("`@("`@("`@("`@("`@("`@,`H@("`@
M("`@("`@("`@("`@("`@,3`@("`N-3`P,#`P,$4K,#(@("`N-3`P,#`P,$4K
M,#(@("`N,S`P,#`P,$4K,#(@("`@("`@("`@("`@("`@("`@(#`*("`@("`@
M("`@("`@("`@("`@(#$Q("`@+C4P,#`P,#!%*S`R("`@+C4P,#`P,#!%*S`R
M("`@+C0U,#`P,#!%*S`R("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@
M("`@("`@("`@("`Q,B`@("XU,#`P,#`P12LP,B`@("XU,#`P,#`P12LP,B`@
M("XV,#`P,#`P12LP,B`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@
M("`@("`@("`@,3,@("`N-3`P,#`P,$4K,#(@("`N-3`P,#`P,$4K,#(@("`N
M-S4P,#`P,$4K,#(@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@
M("`@("`@(#$T("`@+C4P,#`P,#!%*S`R("`@+C4P,#`P,#!%*S`R("`@+C$P
M,#`P,#!%*S`S("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@
M("`@("`Q-2`@("XU,#`P,#`P12LP,B`@("XQ,#`P,#`P12LP,R`@("XP,#`P
M,#`P12LP,"`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@
M("`@,38@("`N-3`P,#`P,$4K,#(@("`N,3`P,#`P,$4K,#,@("`N,34P,#`P
M,$4K,#(@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@
M(#$W("`@+C4P,#`P,#!%*S`R("`@+C$P,#`P,#!%*S`S("`@+C,P,#`P,#!%
M*S`R("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`Q
M."`@("XU,#`P,#`P12LP,B`@("XQ,#`P,#`P12LP,R`@("XT-3`P,#`P12LP
M,B`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@,3D@
M("`N-3`P,#`P,$4K,#(@("`N,3`P,#`P,$4K,#,@("`N-C`P,#`P,$4K,#(@
M("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#(P("`@
M+C4P,#`P,#!%*S`R("`@+C$P,#`P,#!%*S`S("`@+C<U,#`P,#!%*S`R("`@
M("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`R,2`@("XU
M,#`P,#`P12LP,B`@("XQ,#`P,#`P12LP,R`@("XQ,#`P,#`P12LP,R`@("`@
M("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@,C(@("`N,3`P
M,#`P,$4K,#,@("`N-3`P,#`P,$4K,#(@("`N,#`P,#`P,$4K,#`@("`@("`@
M("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#(S("`@+C$P,#`P
M,#!%*S`S("`@+C4P,#`P,#!%*S`R("`@+C$U,#`P,#!%*S`R("`@("`@("`@
M("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@("`R-"`@("XQ,#`P,#`P
M12LP,R`@("XU,#`P,#`P12LP,B`@("XS,#`P,#`P12LP,B`@("`@("`@("`@
M("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`@,C4@("`N,3`P,#`P,$4K
M,#,@("`N-3`P,#`P,$4K,#(@("`N-#4P,#`P,$4K,#(@("`@("`@("`@("`@
M("`@("`@(#`*("`@("`@("`@("`@("`@("`@(#(V("`@+C$P,#`P,#!%*S`S
M("`@+C4P,#`P,#!%*S`R("`@+C8P,#`P,#!%*S`R("`@("`@("`@("`@("`@
M("`@("`P"B`@("`@("`@("`@("`@("`@("`R-R`@("XQ,#`P,#`P12LP,R`@
M("XU,#`P,#`P12LP,B`@("XW-3`P,#`P12LP,B`@("`@("`@("`@("`@("`@
M("`@,`H@("`@("`@("`@("`@("`@("`@,C@@("`N,3`P,#`P,$4K,#,@("`N
M-3`P,#`P,$4K,#(@("`N,3`P,#`P,$4K,#,@("`@("`@("`@("`@("`@("`@
M(#`*("`@("`@("`@("`@("`@("`@(#(Y("`@+C$P,#`P,#!%*S`S("`@+C$P
M,#`P,#!%*S`S("`@+C`P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`P
M"B`@("`@("`@("`@("`@("`@("`S,"`@("XQ,#`P,#`P12LP,R`@("XQ,#`P
M,#`P12LP,R`@("XQ-3`P,#`P12LP,B`@("`@("`@("`@("`@("`@("`@,`H@
M("`@("`@("`@("`@("`@("`@,S$@("`N,3`P,#`P,$4K,#,@("`N,3`P,#`P
M,$4K,#,@("`N,S`P,#`P,$4K,#(@("`@("`@("`@("`@("`@("`@(#`*("`@
M("`@("`@("`@("`@("`@(#,R("`@+C$P,#`P,#!%*S`S("`@+C$P,#`P,#!%
M*S`S("`@+C0U,#`P,#!%*S`R("`@("`@("`@("`@("`@("`@("`P"B`@("`@
M("`@("`@("`@("`@("`S,R`@("XQ,#`P,#`P12LP,R`@("XQ,#`P,#`P12LP
M,R`@("XV,#`P,#`P12LP,B`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@
M("`@("`@("`@("`@,S0@("`N,3`P,#`P,$4K,#,@("`N,3`P,#`P,$4K,#,@
M("`N-S4P,#`P,$4K,#(@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@
M("`@("`@("`@(#,U("`@+C$P,#`P,#!%*S`S("`@+C$P,#`P,#!%*S`S("`@
B+C$P,#`P,#!%*S`S("`@("`@("`@("`@("`@("`@("`P"C`P
`
end
STOP_CAT
echo "  Generating =====> [ ./color_setnam.dat ]"
cat <<"STOP_CAT"> ././color_setnam.uuu
begin 660 ./color_setnam.dat
M("`@("`@("`@("`@("`@("`@("`P0DQ!0TL@("!"04-+"B`@("`@("`@("`@
M("`@("`@("`@,$),04-+("`@0DQ!0PH@("`@("`@("`@("`@("`@("`@(#%7
M2$E412`@($9/4D4*("`@("`@("`@("`@("`@("`@("`Q5TA)5$4@("!72$E4
M"B`@("`@("`@("`@("`@("`@("`@,E)%1"`@("`@4D5$(`H@("`@("`@("`@
M("`@("`@("`@(#-'4D5%3B`@($=2144*("`@("`@("`@("`@("`@("`@("`T
M0DQ512`@("!"3%5%"B`@("`@("`@("`@("`@("`@("`@-5E%3$Q/5R`@645,
M3`H@("`@("`@("`@("`@("`@("`@(#9-04=%3E1!($U!1T4*("`@("`@("`@
9("`@("`@("`@("`W0UE!3B`@("!#64%."D=%
`
end
STOP_CAT
echo "  Generating =====> [ ./device1.f ]"
cat <<"STOP_CAT"> ././device1.f
C     PROGRAM DEVICE3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access programs DEVICE_SELECT and
C              DEVICE_RELEASE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       DEVICE object access program
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_INIT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 = 26)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER KTYPQ, TMP101
C
C                       Real variables and arrays
      REAL    XPAGE, TMP102, YPAGE, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 / 2, 3, 4, 5, 6, 7, 8, 10, 11, 12, 13, 14, 15,
     *            -2,-3,-4,-5,-6,-7,-8,-10,-11,-12,-13,-14,-15/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL DEVICE_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'device_select.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              DEVICE Object Demo Program #3'/
     * ' This program tests the DEVICE object access programs'/
     * ' DEVICE_SELECT and DEVICE_RELEASE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This program will generate several files with names such as'/
     * ' POSTSC_LIS.  These are empty graphics output files that are'/
     * ' produced when testing the initialization of the various'/
     * ' graphics output devices.  These files may be deleted after'/
     * ' demo program has finished.'//
     * '                      Press <CR> to continue')
      READ (IN,811) PAUS
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-only
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Test DEVICE_SELECT object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        KTYPQ = VV101(IVV101)
C
C                       Non-interactively select a graphics output
C                       device
      CALL DEVICE_SELECT (KTYPQ,XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XPAGE ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YPAGE ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KTYPQ,XPAGE,YPAGE
  502 FORMAT (I21,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
      CALL DEVICE_RELEASE ()
  589 CONTINUE
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * ' Note:'/
     * ' In the above output, occasional strings of "garbage"'/
     * ' characters are normal,  They are the result of printing'/
     * ' Tektronix control code sequences to a non-Tektronix'/
     * ' terminal while exercising the Tektronix drivers.'//
     * '              DEVICE Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./device_select.dat ]"
cat <<"STOP_CAT"> ././device_select.uuu
begin 660 ./device_select.dat
M("`@("`@("`@("`@("`@("`@("`R("`@+C$T,C@P,#!%*S`R("`@+C$P.#<P
M,#!%*S`R"B`@("`@("`@("`@("`@("`@("`@,R`@("XQ,3`P,#`P12LP,B`@
M("XX-3`P,#`P12LP,0H@("`@("`@("`@("`@("`@("`@(#0@("`N,3$P,#`P
M,$4K,#(@("`N.#4P,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@("`U("`@
M+C$T,#`P,#!%*S`R("`@+C$P-3`P,#!%*S`R"B`@("`@("`@("`@("`@("`@
M("`@-B`@("XQ,3`P,#`P12LP,B`@("XX-3`P,#`P12LP,0H@("`@("`@("`@
M("`@("`@("`@(#<@("`N,30R.#`P,$4K,#(@("`N,3`X-S`P,$4K,#(*("`@
M("`@("`@("`@("`@("`@("`X("`@+C$T,C@P,#!%*S`R("`@+C$P.#<P,#!%
M*S`R"B`@("`@("`@("`@("`@("`@("`Q,"`@("XQ,S8Y,#`P12LP,B`@("XQ
M,#DU,#`P12LP,@H@("`@("`@("`@("`@("`@("`@,3$@("`N,3`P,#`P,$4K
M,#(@("`N-S4Y,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@(#$R("`@+C$P
M,C4P,#!%*S`R("`@+C<W-3`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`Q
M,R`@("XQ,S8Y,#`P12LP,B`@("XQ,#DU,#`P12LP,@H@("`@("`@("`@("`@
M("`@("`@,30@("`N,3`R-3`P,$4K,#(@("`N-S<U,#`P,$4K,#$*("`@("`@
M("`@("`@("`@("`@(#$U("`@+C$Q,#`P,#!%*S`R("`@+C@U,#`P,#!%*S`Q
M"B`@("`@("`@("`@("`@("`@("`M,B`@("XQ-#(X,#`P12LP,B`@("XQ,#@W
M,#`P12LP,@H@("`@("`@("`@("`@("`@("`@+3,@("`N,3$P,#`P,$4K,#(@
M("`N.#4P,#`P,$4K,#$*("`@("`@("`@("`@("`@("`@("TT("`@+C$Q,#`P
M,#!%*S`R("`@+C@U,#`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`M-2`@
M("XQ-#`P,#`P12LP,B`@("XQ,#4P,#`P12LP,@H@("`@("`@("`@("`@("`@
M("`@+38@("`N,3$P,#`P,$4K,#(@("`N.#4P,#`P,$4K,#$*("`@("`@("`@
M("`@("`@("`@("TW("`@+C$T,C@P,#!%*S`R("`@+C$P.#<P,#!%*S`R"B`@
M("`@("`@("`@("`@("`@("`M."`@("XQ-#(X,#`P12LP,B`@("XQ,#@W,#`P
M12LP,@H@("`@("`@("`@("`@("`@("`M,3`@("`N,3,V.3`P,$4K,#(@("`N
M,3`Y-3`P,$4K,#(*("`@("`@("`@("`@("`@("`@+3$Q("`@+C$P,#`P,#!%
M*S`R("`@+C<U.3`P,#!%*S`Q"B`@("`@("`@("`@("`@("`@("TQ,B`@("XQ
M,#(U,#`P12LP,B`@("XW-S4P,#`P12LP,0H@("`@("`@("`@("`@("`@("`M
M,3,@("`N,3,V.3`P,$4K,#(@("`N,3`Y-3`P,$4K,#(*("`@("`@("`@("`@
M("`@("`@+3$T("`@+C$P,C4P,#!%*S`R("`@+C<W-3`P,#!%*S`Q"B`@("`@
M("`@("`@("`@("`@("TQ-2`@("XQ,3`P,#`P12LP,B`@("XX-3`P,#`P12LP
",0H@
`
end
STOP_CAT
echo "  Generating =====> [ ./font1.f ]"
cat <<"STOP_CAT"> ././font1.f
C     PROGRAM FONT1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test all supported software fonts
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      EXTERNAL  CHAR_CVINT
C
C                       Max number of alphabet sets
      PARAMETER (MXSET=11)
C                       Max number of fonts
      PARAMETER (MXFNT=22)
C                       Variable for storing backslash code
      INTEGER BACKSL
C                       Alphabet set change character
      CHARACTER*1  NUL
C                       Character string for font number
      CHARACTER*2  CFN
C                       Array for storing alphabet set names
      CHARACTER*5  ASETS(MXSET)
C                       Array for storing alphabet set labels
      CHARACTER*18 ASETL(MXSET)
C                       Array for storing style labels
      CHARACTER*8  STYLEL(12)
C                       Variables for storing alphabet characters
      CHARACTER*28 AZUC,AZLC
C                       Variable for storing numeral characters
      CHARACTER*10 NUMER
C                       Variable for storing special characters
      CHARACTER*29 SPECL
C                       Variable for storing title
      CHARACTER*29 TITLE, LABEL
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Array for storing alphabet set and char style
C                       indcies for fonts
      DIMENSION IFNAS(MXFNT),IFNCS(MXFNT)
C
C                       Alphabet set names
      DATA ASETS /'STAND','L/CST',
     .            'ITALI','L/CIT',
     .            'SCRIP','L/CSC',
     .            'GREEK','L/CGR','MATHE',
     .            'DEFAU','L/CDE'/
C                       Alphabet set labels
      DATA ASETL /'Standard          ',
     2            'Lower Case Stand. ',
     3            'Italic            ',
     4            'Lower Case Italic ',
     5            'Script            ',
     6            'Lower Case Script ',
     7            'Greek             ',
     8            'Lower Case Greek  ',
     9            'Mathematic        ',
     A            'Default           ',
     B            'Lower Case Default'/
C                       Character style labels
      DATA STYLEL /'Clasic  ',
     2             'Simplx  ',
     3             'Duplex  ',
     4             'Triplx  ',
     5             'Cartog  ',
     6             'Complx  ',
     7             'Cmplx2  ',
     8             'Stylex  ',
     9             'Romanb  ',
     A             'Romanl  ',
     B             'Gothic  ',
     C             'Default '/
C                       Font alphabet set and char style indicies
C           Font:  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
C                 16 17 18 19 20 21 22
      DATA IFNCS /12, 4, 0, 4, 2, 6,11, 0,11,11, 2, 6, 2, 6, 3,
     *             1, 6, 2, 8,10, 1, 9/
      DATA IFNAS / 1, 1, 0, 3, 5, 5, 3, 0, 1, 5, 1, 1, 7, 3, 1,
     *             9, 7, 3, 1, 1, 1, 1/
C                       Upper and lower case alphabet characters
      DATA AZUC  /'(ABCDEFGHIJKLMNOPQRSTUVWXYZ)'/
      DATA AZLC  /'<abcdefghijklmnopqrstuvwxyz>'/
C                       Numeral characters
      DATA NUMER /'0123456789'/
C                       Special characters
      DATA SPECL /'!@#$%^&*+-_=[];'':",.?/`~|{ } '/
C                       Backslash character code (to compensate
C                       for bug in Sun compiler that interprets
C                       backslash like 'c' rather than Fortran)
      DATA BACKSL /92/
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C                       Use sw character drawing
      CALL GRAPHICS_RESET ('HRDTXT')
C
C     ******************************************************************
C
C                       Initialize figure number counter
      IFIG = 0
C                       Activate area fill for fonts
      CALL FONT_SETPAT (0.0,1,YPAGE/750.,1)
C                       Loop for each available font
      DO 100 IFN=1,MXFNT
C                       Set alphabet set for font
      IALSET = IFNAS(IFN)
C                       Skip unused font numbers
      IF (IALSET .EQ. 0) GOTO 100
C                       Set character style for font
      ISTYLE = IFNCS(IFN)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE, YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PLOT AXES AND SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.1*XPAGE, 0.1*YPAGE)
C                       Compute length of X and Y axis in inches
      XPG = 0.8*XPAGE
      YPG = 0.7*YPAGE
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C                       Extend grace margin to encompass title
      CALL MARGIN_SET (.2*YPAGE)
C
C     ******************************************************************
C
C                       DRAW PLOT TITLE IN cartog STANDARD
C
C                       Set current text height in inches
      HT = YPAGE*.05
      CALL TEXT2D_SETHT (HT*1.2)
C                       Set primary alphabet set to 'standard'
      CALL FONT_ALPHA ('STAND')
C                       Set style to 'cartog'
      CALL FONT_CARTOG
C                       Create plot title from
C                       style and alphabet set labels
      TITLE = STYLEL(ISTYLE)//ASETL(IALSET)
C                       Find length of title without trailing blanks
      LENTTL = NUMCHR (TITLE)
C                       Determine length of title in inches
      XL = TEXT2D_GETLEN (TITLE,LENTTL)
C                       Compute X coord of start of title in inches
      XX = 0.50*(XPG-XL)
C                       Draw title above subplot area 1.2x current
C                       height and underlined
      YTL = YPAGE*0.8
      CALL TEXT2D_PDRAW (TITLE,LENTTL,XX,YTL)
C
C     ------------------------------------------------------------------
C
C                       UNDERLINE THE TITLE
C
C                       Move to start of string (reference point
C                       under left edge of string)
      YLINE = YTL*0.98
      CALL LOGPEN2_SETP (XX,YLINE,0)
C                       Draw to end of string
      CALL LINE2D_DRAW (XX+XL,YLINE,0)
C
C     ******************************************************************
C
C                       SET SPECIFIED TYPEFACE
C
C                       Use null as alphabet set change char so
C                       all printable chars will plot (can't use
C                       blank as that is the flag for no mixed
C                       alphabet sets)
      NUL = CHAR(0)
C                       Define primary alphabet set
      CALL FONT_ALPHA1 (ASETS(IALSET),NUL)
C
C                       Set character style
      GOTO (51,52,53,54,55,56,57,58,59,60,61,62),ISTYLE
C                       Set style to 'clasic'
   51 CALL FONT_CLASIC
      GOTO 65
C                       Set style to 'simplx'
   52 CALL FONT_SIMPLX
      GOTO 65
C                       Set style to 'duplex'
   53 CALL FONT_DUPLEX
      GOTO 65
C                       Set style to 'triplx'
   54 CALL FONT_TRIPLX
      GOTO 65
C                       Set style to 'cartog'
   55 CALL FONT_CARTOG
      GOTO 65
C                       Set style to 'complx'
   56 CALL FONT_COMPLX
      GOTO 65
C                       Set style to 'cmplx2'
   57 CALL FONT_CMPLX2
      GOTO 65
C                       Set style to 'stylex'
   58 CALL FONT_STYLEX
      GOTO 65
C                       Set style to 'romanb'
   59 CALL FONT_ROMANB
      GOTO 65
C                       Set style to 'romanl'
   60 CALL FONT_ROMANL
      GOTO 65
C                       Set style to 'gothic'
   61 CALL FONT_GOTHIC
      GOTO 65
C                       Set style to default
   62 CALL GRAPHICS_RESET ('FONT_CARTOG')
   65 CONTINUE
C
C                       Determine length of 1st alphabet string
C                       in inches
      XX = TEXT2D_GETLEN (NUL//AZUC(1:14),15)
C                       Set X coordinate for start of strings
      X = (XPG-XX)*0.50
C                       Set Y coordinate spacing between strings
      DY = YPG/8.
C                       Set Y coordinate for start of strings
      Y = DY*7.
C                       Set character height in inches
      CALL TEXT2D_SETHT (HT)
C
C     ------------------------------------------------------------------
C
C                       ILLUSTRATE UPPER CASE ALPHABET
C
C                       Draw characters A-M
      CALL TEXT2D_PDRAW (NUL//AZUC(1:14),15,X,Y)
C                       Draw characters N-Z
      CALL TEXT2D_PDRAW (NUL//AZUC(15:28),15,X,Y-DY)
C
C     ------------------------------------------------------------------
C
C                       ILLUSTRATE LOWER CASE ALPHABET
C
C                       Draw characters a-m
      CALL TEXT2D_PDRAW (NUL//AZLC(1:14),15,X,Y-2.0*DY)
C                       Draw characters n-z
      CALL TEXT2D_PDRAW (NUL//AZLC(15:28),15,X,Y-3.0*DY)
C
C     ------------------------------------------------------------------
C
C                       ILLUSTRATE NUMERALS AND SPECIAL CHARACTERS
C
C                       Draw characters 0-9
      CALL TEXT2D_PDRAW (NUMER,10,X,Y-4.0*DY)
C                       Draw first 15 special characters
      CALL TEXT2D_PDRAW (SPECL(1:15),15,X,Y-5.0*DY)
C                       Draw last 15 special characters
      SPECL(29:29) = CHAR(BACKSL)
      CALL TEXT2D_PDRAW (SPECL(16:29),14,X,Y-6.0*DY)
C
C     ------------------------------------------------------------------
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Set current text height in inches
      CALL TEXT2D_SETHT (YPAGE*.25/11.)
C                       Set primary alphabet set to 'standard'
      CALL FONT_ALPHA ('STAND')
C                       Set style to 'cartog'
      CALL FONT_CARTOG
C                       Convert font number to character string
      CALL CHAR_CVINT (CFN,IFN,2)
C                       Splice together strings for plot label
      LABEL = 'FONT1 Demo: Character Font '//CFN
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN (LABEL,30)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW (LABEL,30,XX,-0.5)
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C                       Loop for next plot
  100 CONTINUE
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./font2.f ]"
cat <<"STOP_CAT"> ././font2.f
C     PROGRAM FONT2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program FONT_SETPAT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      EXTERNAL  CHAR_CVINT
C
C                       FONT object access program
      EXTERNAL FONT_SETPAT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Max number of alphabet sets
      PARAMETER (MXSET=11)
C                       Max number of fonts
      PARAMETER (MXFNT=22)
C
C                       Number of input variable test values
      PARAMETER (NVV105 =  2)
      PARAMETER (NVV106 =  1)
      PARAMETER (NVV107 =  2)
      PARAMETER (NVV108 =  1)
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'FONT.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101, TMP102, NANGLE, TMP106, NGAP, TMP108
C
C                       Real variables and arrays
      REAL    TMP103, TMP104, ANGARR, TMP105, GAPARR, TMP107
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Variable for storing backslash code
      INTEGER BACKSL
C                       Alphabet set change character
      CHARACTER*1  NUL
C                       Character string for font number
      CHARACTER*2  CFN
C                       Array for storing alphabet set names
      CHARACTER*5  ASETS(MXSET)
C                       Array for storing alphabet set labels
      CHARACTER*18 ASETL(MXSET)
C                       Array for storing style labels
      CHARACTER*8  STYLEL(12)
C                       Variables for storing alphabet characters
      CHARACTER*28 AZUC,AZLC
C                       Variable for storing numeral characters
      CHARACTER*10 NUMER
C                       Variable for storing special characters
      CHARACTER*29 SPECL
C                       Variable for storing title
      CHARACTER*29 TITLE, LABEL
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Array for storing alphabet set and char style
C                       indcies for fonts
      DIMENSION IFNAS(MXFNT),IFNCS(MXFNT)
C
C                       Input variable test value arrays
      REAL    VV105(NVV105)
      INTEGER VV106(NVV106)
      REAL    VV107(NVV107)
      INTEGER VV108(NVV108)
C
C                       Alphabet set names
      DATA ASETS /'STAND','L/CST',
     .            'ITALI','L/CIT',
     .            'SCRIP','L/CSC',
     .            'GREEK','L/CGR','MATHE',
     .            'DEFAU','L/CDE'/
C                       Alphabet set labels
      DATA ASETL /'Standard          ',
     2            'Lower Case Stand. ',
     3            'Italic            ',
     4            'Lower Case Italic ',
     5            'Script            ',
     6            'Lower Case Script ',
     7            'Greek             ',
     8            'Lower Case Greek  ',
     9            'Mathematic        ',
     A            'Default           ',
     B            'Lower Case Default'/
C                       Character style labels
      DATA STYLEL /'Clasic  ',
     2             'Simplx  ',
     3             'Duplex  ',
     4             'Triplx  ',
     5             'Cartog  ',
     6             'Complx  ',
     7             'Cmplx2  ',
     8             'Stylex  ',
     9             'Romanb  ',
     A             'Romanl  ',
     B             'Gothic  ',
     C             'Default '/
C                       Font alphabet set and char style indicies
C           Font:  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
C                 16 17 18 19 20 21 22
      DATA IFNCS /12, 4, 0, 4, 2, 6,11, 0,11,11, 2, 6, 2, 6, 3,
     *             1, 6, 2, 8,10, 1, 9/
      DATA IFNAS / 1, 1, 0, 3, 5, 5, 3, 0, 1, 5, 1, 1, 7, 3, 1,
     *             9, 7, 3, 1, 1, 1, 1/
C                       Upper and lower case alphabet characters
      DATA AZUC  /'(ABCDEFGHIJKLMNOPQRSTUVWXYZ)'/
      DATA AZLC  /'<abcdefghijklmnopqrstuvwxyz>'/
C                       Numeral characters
      DATA NUMER /'0123456789'/
C                       Special characters
      DATA SPECL /'!@#$%^&*+-_=[];'':",.?/`~|{ } '/
C                       Backslash character code (to compensate
C                       for bug in Sun compiler that interprets
C                       backslash like 'c' rather than Fortran)
      DATA BACKSL /92/
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV105 /45.0, -90.0/
C
      DATA VV106 /1/
C
      DATA VV107 /.025, 0.075/
C
      DATA VV108 /1/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'font_setpat.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              FONT Object Demo Program #2'/
     * ' This program tests the FONT object access program'/
     * ' FONT_SETPAT.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C                       Use sw character drawing
      CALL GRAPHICS_RESET ('HRDTXT')
C
C     ******************************************************************
C
C                       Test FONT_SETPAT object access program
C
C                       Initialize figure number counter
      IFIG = 18
      IFN = 18
C                       Loop for each input variable of access program
      DO 589 IVV105 = 1,NVV105
        ANGARR = VV105(IVV105)
C
      DO 588 IVV106 = 1,NVV106
        NANGLE = VV106(IVV106)
C
      DO 587 IVV107 = 1,NVV107
        GAPARR = VV107(IVV107)
C
      DO 586 IVV108 = 1,NVV108
        NGAP = VV108(IVV108)
C
      IFIG = IFIG+1
      IFN = IFN+1
C                       Define text string fill pattern
      CALL FONT_SETPAT (ANGARR,NANGLE,GAPARR,NGAP)
C
C                       Set alphabet set for font
      IALSET = IFNAS(IFN)
C                       Skip unused font numbers
      IF (IALSET .EQ. 0) GOTO 586
C                       Set character style for font
      ISTYLE = IFNCS(IFN)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE, YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PLOT AXES AND SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.1*XPAGE, 0.1*YPAGE)
C                       Compute length of X and Y axis in inches
      XPG = 0.8*XPAGE
      YPG = 0.7*YPAGE
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C                       Extend grace margin to encompass title
      CALL MARGIN_SET (.2*YPAGE)
C
C     ******************************************************************
C
C                       DRAW PLOT TITLE IN cartog STANDARD
C
C                       Set current text height in inches
      HT = YPAGE*.05
      CALL TEXT2D_SETHT (HT*1.2)
C                       Set primary alphabet set to 'standard'
      CALL FONT_ALPHA ('STAND')
C                       Set style to 'cartog'
      CALL FONT_CARTOG
C                       Create plot title from
C                       style and alphabet set labels
      TITLE = STYLEL(ISTYLE)//ASETL(IALSET)
C                       Find length of title without trailing blanks
      LENTTL = NUMCHR (TITLE)
C                       Determine length of title in inches
      XL = TEXT2D_GETLEN (TITLE,LENTTL)
C                       Compute X coord of start of title in inches
      XX = 0.50*(XPG-XL)
C                       Draw title above subplot area 1.2x current
C                       height and underlined
      YTL = YPAGE*0.8
      CALL TEXT2D_PDRAW (TITLE,LENTTL,XX,YTL)
C
C     ------------------------------------------------------------------
C
C                       UNDERLINE THE TITLE
C
C                       Move to start of string (reference point
C                       under left edge of string)
      YLINE = YTL*0.98
      CALL LOGPEN2_SETP (XX,YLINE,0)
C                       Draw to end of string
      CALL LINE2D_DRAW (XX+XL,YLINE,0)
C
C     ******************************************************************
C
C                       SET SPECIFIED TYPEFACE
C
C                       Use null as alphabet set change char so
C                       all printable chars will plot (can't use
C                       blank as that is the flag for no mixed
C                       alphabet sets)
      NUL = CHAR(0)
C                       Define primary alphabet set
      CALL FONT_ALPHA1 (ASETS(IALSET),NUL)
C
C                       Set character style
      GOTO (51,52,53,54,55,56,57,58,59,60,61,62),ISTYLE
C                       Set style to 'clasic'
   51 CALL FONT_CLASIC
      GOTO 65
C                       Set style to 'simplx'
   52 CALL FONT_SIMPLX
      GOTO 65
C                       Set style to 'duplex'
   53 CALL FONT_DUPLEX
      GOTO 65
C                       Set style to 'triplx'
   54 CALL FONT_TRIPLX
      GOTO 65
C                       Set style to 'cartog'
   55 CALL FONT_CARTOG
      GOTO 65
C                       Set style to 'complx'
   56 CALL FONT_COMPLX
      GOTO 65
C                       Set style to 'cmplx2'
   57 CALL FONT_CMPLX2
      GOTO 65
C                       Set style to 'stylex'
   58 CALL FONT_STYLEX
      GOTO 65
C                       Set style to 'romanb'
   59 CALL FONT_ROMANB
      GOTO 65
C                       Set style to 'romanl'
   60 CALL FONT_ROMANL
      GOTO 65
C                       Set style to 'gothic'
   61 CALL FONT_GOTHIC
      GOTO 65
C                       Set style to default
   62 CALL GRAPHICS_RESET ('FONT_CARTOG')
   65 CONTINUE
C
C                       Determine length of 1st alphabet string
C                       in inches
      XX = TEXT2D_GETLEN (NUL//AZUC(1:14),15)
C                       Set X coordinate for start of strings
      X = (XPG-XX)*0.50
C                       Set Y coordinate spacing between strings
      DY = YPG/8.
C                       Set Y coordinate for start of strings
      Y = DY*7.
C                       Set character height in inches
      CALL TEXT2D_SETHT (HT)
C
C     ------------------------------------------------------------------
C
C                       ILLUSTRATE UPPER CASE ALPHABET
C
C                       Draw characters A-M
      CALL TEXT2D_PDRAW (NUL//AZUC(1:14),15,X,Y)
C                       Draw characters N-Z
      CALL TEXT2D_PDRAW (NUL//AZUC(15:28),15,X,Y-DY)
C
C     ------------------------------------------------------------------
C
C                       ILLUSTRATE LOWER CASE ALPHABET
C
C                       Draw characters a-m
      CALL TEXT2D_PDRAW (NUL//AZLC(1:14),15,X,Y-2.0*DY)
C                       Draw characters n-z
      CALL TEXT2D_PDRAW (NUL//AZLC(15:28),15,X,Y-3.0*DY)
C
C     ------------------------------------------------------------------
C
C                       ILLUSTRATE NUMERALS AND SPECIAL CHARACTERS
C
C                       Draw characters 0-9
      CALL TEXT2D_PDRAW (NUMER,10,X,Y-4.0*DY)
C                       Draw first 15 special characters
      CALL TEXT2D_PDRAW (SPECL(1:15),15,X,Y-5.0*DY)
C                       Draw last 15 special characters
      SPECL(29:29) = CHAR(BACKSL)
      CALL TEXT2D_PDRAW (SPECL(16:29),14,X,Y-6.0*DY)
C
C     ------------------------------------------------------------------
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Set current text height in inches
      CALL TEXT2D_SETHT (YPAGE*.25/11.)
C                       Set primary alphabet set to 'standard'
      CALL FONT_ALPHA ('STAND')
C                       Set style to 'cartog'
      CALL FONT_CARTOG
C                       Convert font number to character string
      CALL CHAR_CVINT (CFN,IFN,2)
C                       Splice together strings for plot label
      LABEL = 'FONT2 Demo: Character Font '//CFN
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN (LABEL,30)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW (LABEL,30,XX,-0.5)
C
C     ******************************************************************
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=510) TMP101,TMP102,TMP103,TMP104,TMP105,
     *       TMP106,TMP107,TMP108
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZSFAN .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (KZSFGP .NE. TMP102 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZSFAN ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZSFGP ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 523
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=512) KZSFAN,KZSFGP,ZZSFAN,ZZSFGP,ANGARR,NANGLE,
     *       GAPARR,NGAP
  502 FORMAT (I21,I21,E15.7,E15.7,E15.7,I21,E15.7,I21)
      GOTO 523
C                       Write I/O error messages
  510 WRITE (IER,511) FILNAM
  511 FORMAT (' Error reading file ',A)
      GOTO 523
C
  512 WRITE (IER,513) FILNAM
  513 FORMAT (' Error writing file ',A)
C
  523 CONTINUE
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
      CALL DEVICE_END (0)
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              FONT Demo Program #17 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./font_setpat.dat ]"
cat <<"STOP_CAT"> ././font_setpat.uuu
begin 660 ./font_setpat.dat
M("`@("`@("`@("`@("`@("`@("`Q("`@("`@("`@("`@("`@("`@("`Q("`@
M+C0U,#`P,#!%*S`R("`@+C(U,#`P,#!%+3`Q("`@+C0U,#`P,#!%*S`R("`@
M("`@("`@("`@("`@("`@("`Q("`@+C(U,#`P,#!%+3`Q("`@("`@("`@("`@
M("`@("`@("`Q"B`@("`@("`@("`@("`@("`@("`@,2`@("`@("`@("`@("`@
M("`@("`@,2`@("XT-3`P,#`P12LP,B`@("XW-3`P,#`P12TP,2`@("XT-3`P
M,#`P12LP,B`@("`@("`@("`@("`@("`@("`@,2`@("XW-3`P,#`P12TP,2`@
M("`@("`@("`@("`@("`@("`@,0H@("`@("`@("`@("`@("`@("`@(#$@("`@
M("`@("`@("`@("`@("`@(#$@("TN.3`P,#`P,$4K,#(@("`N,C4P,#`P,$4M
M,#$@("TN.3`P,#`P,$4K,#(@("`@("`@("`@("`@("`@("`@(#$@("`N,C4P
M,#`P,$4M,#$@("`@("`@("`@("`@("`@("`@(#$*("`@("`@("`@("`@("`@
M("`@("`Q("`@("`@("`@("`@("`@("`@("`Q("`M+CDP,#`P,#!%*S`R("`@
M+C<U,#`P,#!%+3`Q("`M+CDP,#`P,#!%*S`R("`@("`@("`@("`@("`@("`@
H("`Q("`@+C<U,#`P,#!%+3`Q("`@("`@("`@("`@("`@("`@("`Q"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./frame1.f ]"
cat <<"STOP_CAT"> ././frame1.f
C     PROGRAM FRAME1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program FRAME_DRAW and
C              FRAME_THICK
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       FRAME object access program
      EXTERNAL FRAME_DRAW, FRAME_THICK
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'FRAME.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, THKNES, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV103(NVV103)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /0.0, .000001, 5.99, 0.01/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'frame_thick.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              FRAME Object Demo Program #1'/
     * ' This program tests the FRAME object access program'/
     * ' FRAME_THICK.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test FRAME_THICK object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        THKNES = VV103(IVV103)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C                       Set subplot area frame thickness
      CALL FRAME_THICK (THKNES)
C
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL FRAME_DRAW ()
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(ZZFRME ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUFRME ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ZZFRME,UUFRME,THKNES
  502 FORMAT (E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              FRAME Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./frame2.f ]"
cat <<"STOP_CAT"> ././frame2.f
C     PROGRAM FRAME2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program FRAME_OFF
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       FRAME object access program
      EXTERNAL FRAME_OFF
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'FRAME.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
C     None
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'frame_off.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              FRAME Object Demo Program #2'/
     * ' This program tests the FRAME object access program'/
     * ' FRAME_OFF.'/
     * ' FRAME_OFF has no input variables. The output is compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C     ------------------------------------------------------------------
C
C                       Test FRAME_OFF object access program
C
C                       Disable drawing of frame around clipping
C                       boundary during subplot definition
      CALL FRAME_OFF ()
C
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZBRDR .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZBRDR
  502 FORMAT (I21)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              FRAME Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./frame_off.dat ]"
cat <<"STOP_CAT"> ././frame_off.uuu
begin 660 ./frame_off.dat
6("`@("`@("`@("`@("`@("`@,C(R"O^_
`
end
STOP_CAT
echo "  Generating =====> [ ./frame_thick.dat ]"
cat <<"STOP_CAT"> ././frame_thick.uuu
begin 660 ./frame_thick.dat
M("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%*S`P
M"B`@("XQ-C0X-#`R12TP-2`@("XR-30P,#`P12TP-2`@("XQ,#`P,#`P12TP
M-0H@("`N.3@W,SDR-T4K,#$@("`N,34R,30V,$4K,#(@("`N-3DY,#`P,$4K
M,#$*("`@+C$V-#@T,#)%+3`Q("`@+C(U-#`P,#!%+3`Q("`@+C$P,#`P,#!%
$+3`Q"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./graphics1.f ]"
cat <<"STOP_CAT"> ././graphics1.f
C     PROGRAM GRAPHICS1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program GRAPHICS_INIT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C     ------------------------------------------------------------------
C
      CHARACTER*80 STRING
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Write demo program introduction message
C
C                       Write intro message
C                       (use * for logical unit since TERM_SETSIO will
C                       not be called in this demo)
      WRITE (*,401)
  401 FORMAT (
     * '                   GRAPHICS Object Demo Program #1'//
     * ' GRAPHICS_INIT must be used to initialize the PRL-GRAPHICS'/
     * ' library prior to invoking any other PRL-GRAPHICS subprograms.'/
     * ' Failure to initialize the library will cause erroneous'/
     * ' program operation.'/
     * ' '/
     * ' GRAPHICS_INIT was called before printing this message.'/)
C
C     ******************************************************************
C
C                       Terminate program execution
C                       Wait until user presses a key before exiting
C
      WRITE (*,810)
  810 FORMAT (/
     * '              GRAPHICS Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (*,811) STRING
  811 FORMAT (A)
C                       Exit demo
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./graphics2.f ]"
cat <<"STOP_CAT"> ././graphics2.f
C     PROGRAM GRAPHICS2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program GRAPHICS_RESET
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       GRAPHICS object access program
      EXTERNAL GRAPHICS_RESET
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'GRAPHICS.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER TMP101*31, PARAM*6, TMP102*6
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*6 VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /'ALL', 'BLNKAL'/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'graphics_reset.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              GRAPHICS Object Demo Program #2'/
     * ' This program tests the GRAPHICS object access program'/
     * ' GRAPHICS_RESET.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test GRAPHICS_RESET object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        PARAM = VV102(IVV102)
C
C                       Reset graphics objects to default state
      CALL GRAPHICS_RESET (PARAM)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (ZZSUBP .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ZZSUBP,PARAM
  502 FORMAT (A,A)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              GRAPHICS Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./graphics_reset.dat ]"
cat <<"STOP_CAT"> ././graphics_reset.uuu
begin 660 ./graphics_reset.dat
M0T],3U)?4T543E5-("`@("`@("`@("`@("`@("`@($%,3"`@(`I'4D%02$E#
?4U]215-%5"`@("`@("`@("`@("`@("`@0DQ.2T%,"D%,
`
end
STOP_CAT
echo "  Generating =====> [ ./heading1.f ]"
cat <<"STOP_CAT"> ././heading1.f
C     PROGRAM HEADING1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program HEADING_DRAW
C
C     NOTES:  None
C
C     ******************************************************************
C
      EXTERNAL  CHAR_LENBT
      INTEGER   CHAR_LENBT
C
      CHARACTER*64 KODE
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       INITIALIZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C                       Enable software character fonts
      CALL GRAPHICS_RESET ('HRDTXT')
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.10*XPAGE
      YRL = 0.20*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 2.0*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN ('HEADING1 Demo: Mixed Fonts in Heading$',100)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW
     *     ('HEADING1 Demo: Mixed Fonts in Heading$',100,XX,-0.5)
C
C     ------------------------------------------------------------------
C
C                       DRAW HEADING OVER SUBPLOT AREA
C
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE*1.2)
C                       Define alphabet sets 1 through 6
      CALL FONT_ALPHA1 ('DEFAU','<')
      CALL FONT_ALPHA2 ('ITALI','%')
      CALL FONT_ALPHA3 ('GREEK','#')
      CALL FONT_ALPHA4 ('SCRIP','&')
      CALL FONT_ALPHA5 ('MATHE','+')
      CALL FONT_ALPHA6 ('STAND','>')
C
C                       Plot 4-layer heading in mixed fonts
      KODE='&Script-%Italic <Title$'
      CALL HEADING_DRAW (KODE,100,0.9,4)
      KODE='%Italic-#Greek <Title$'
      CALL HEADING_DRAW (KODE,100,0.9,4)
      KODE='#Greek-&Script <Title$'
      CALL HEADING_DRAW (KODE,100,0.9,4)
      KODE='>Standard-<Default-#Greek-%Italic-&Script <Title$'
      CALL HEADING_DRAW (KODE,100,0.9,4)
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW
C
C                       DRAW 1ST MIXED FONT MESSAGE
C
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
      KODE = '<Math +CJDGIC >in &Script-#Greek-%Italic >Message'
C                       Determine length of text string in inches
      NC = CHAR_LENBT (KODE)
      XX = (XPG-TEXT2D_GETLEN (KODE,NC))*0.5
C                       Plot text string in world coords
      CALL TEXT2D_PDRAW (KODE,NC,XX,YPG*0.6)
C
C     ------------------------------------------------------------------
C
C                       DRAW 2ND MIXED FONT MESSAGE
C
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE*1.66)
      KODE = '>I%s#n&''t %T#h&i%s <F&U%N#!&!'
C                       Determine length of text string in inches
      NC = CHAR_LENBT (KODE)
      XX = (XPG-TEXT2D_GETLEN (KODE,NC))/2.0
C                       Plot text string in page coords
      CALL TEXT2D_PDRAWR (KODE,NC,XX,-YPG*0.2,2)
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
C                       Exit
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./int1.f ]"
cat <<"STOP_CAT"> ././int1.f
C     PROGRAM INT1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program INT_PDRAWR
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       INT object access program
      EXTERNAL INT_PDRAWR
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL TEXT2D_SETHT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV102 =  1)
      PARAMETER (NVV103 =  1)
      PARAMETER (NVV104 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER IVAL, TMP101, LREL, TMP104
C
C                       Real variables and arrays
      REAL    XPOSP2, TMP102, YPOSP2, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
      REAL    VV102(NVV102)
      REAL    VV103(NVV103)
      INTEGER VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-32768/
C
      DATA VV102 /1.0/
C
      DATA VV103 /2.0/
C
      DATA VV104 /0, 1, 2, 3/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'intnum_pdrawr.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              INT Object Demo Program #1'/
     * ' This program tests the INT object access program'/
     * ' INT_PDRAWR.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL TEXT2D_SETHT (0.25)
C
C     ------------------------------------------------------------------
C
C                       Test INT_PDRAWR object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        IVAL = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        XPOSP2 = VV102(IVV102)
C
      DO 587 IVV103 = 1,NVV103
        YPOSP2 = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        LREL = VV104(IVV104)
C
C                       Draw integer number relative to current location
C                       or origin in page units
      CALL INT_PDRAWR (IVAL,XPOSP2,YPOSP2,LREL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) IVAL,XPOSP2,YPOSP2,LREL
  502 FORMAT (I21,E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              INT Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./int2.f ]"
cat <<"STOP_CAT"> ././int2.f
C     PROGRAM INT2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program INT_PDRAW
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       INT object access program
      EXTERNAL INT_PDRAW
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL TEXT2D_SETHT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  3)
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER IVAL, TMP101
C
C                       Real variables and arrays
      REAL    XPOSP2, TMP102, YPOSP2, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-32768, 0., 32767/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'intnum_pdraw.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              INT Object Demo Program #2'/
     * ' This program tests the INT object access program'/
     * ' INT_PDRAW.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL TEXT2D_SETHT (0.25)
C
C     ------------------------------------------------------------------
C
C                       Test INT_PDRAW object access program
C
        XPOSP2 = 5.
        YPOSP2 = 1.
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        IVAL = VV101(IVV101)
C
        YPOSP2 = YPOSP2+1.
C
C                       Draw integer number relative to origin in page
C                       units
      CALL INT_PDRAW (IVAL,XPOSP2,YPOSP2)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) IVAL,XPOSP2,YPOSP2
  502 FORMAT (I21,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              INT Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./intnum_pdraw.dat ]"
cat <<"STOP_CAT"> ././intnum_pdraw.uuu
begin 660 ./intnum_pdraw.dat
M("`@("`@("`@("`@("`@+3,R-S8X("`@+C4P,#`P,#!%*S`Q("`@+C(P,#`P
M,#!%*S`Q"B`@("`@("`@("`@("`@("`@("`@,"`@("XU,#`P,#`P12LP,2`@
M("XS,#`P,#`P12LP,0H@("`@("`@("`@("`@("`@,S(W-C<@("`N-3`P,#`P
5,$4K,#$@("`N-#`P,#`P,$4K,#$*
`
end
STOP_CAT
echo "  Generating =====> [ ./intnum_pdrawr.dat ]"
cat <<"STOP_CAT"> ././intnum_pdrawr.uuu
begin 660 ./intnum_pdrawr.dat
M("`@("`@("`@("`@("`@+3,R-S8X("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P
M,#!%*S`Q("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("TS
M,C<V."`@("XQ,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("`@("`@("`@
M("`@("`@("`@,0H@("`@("`@("`@("`@("`M,S(W-C@@("`N,3`P,#`P,$4K
M,#$@("`N,C`P,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#(*("`@("`@
M("`@("`@("`@+3,R-S8X("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q
6("`@("`@("`@("`@("`@("`@("`S"C`P
`
end
STOP_CAT
echo "  Generating =====> [ ./line2d1.f ]"
cat <<"STOP_CAT"> ././line2d1.f
C     PROGRAM LINE2D1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LINE2D_CHNDOT,
C              LINE2D_CHNDSH, LINE2D_DASH, LINE2D_DOT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       LINE2D object access program
      EXTERNAL LINE2D_CHNDOT, LINE2D_CHNDSH, LINE2D_DASH, LINE2D_DOT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'LINE2D.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
C     None
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'line2d_chndot.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              LINE2D Object Demo Program #1'/
     * ' This program tests the LINE2D object access program'/
     * ' LINE2D_CHNDOT, LINE2D_CHNDSH, LINE2D_DASH, LINE2D_DOT'/
     * ' There are no input variables. The results for are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Test LINE2D_CHNDOT object access program
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      NPBSYM = 0
C
C                       Set line style to chain-dot
      CALL LINE2D_CHNDOT ()
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (0.0,4.0,NPBSYM)
      CALL LINE2D_DRAW (20.0,4.0,NPBSYM)
C
C                       Set line style to chain-dash
      CALL LINE2D_CHNDSH ()
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (0.0,5.0,NPBSYM)
      CALL LINE2D_DRAW (20.0,5.0,NPBSYM)
C
C                       Set line style to dash
      CALL LINE2D_DASH ()
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (0.0,6.0,NPBSYM)
      CALL LINE2D_DRAW (20.0,6.0,NPBSYM)
C
C                       Set line style to dot
      CALL LINE2D_DOT ()
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (0.0,7.0,NPBSYM)
      CALL LINE2D_DRAW (20.0,7.0,NPBSYM)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZLSTY .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZLSTY
  502 FORMAT (I21)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              LINE2D Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./line2d2.f ]"
cat <<"STOP_CAT"> ././line2d2.f
C     PROGRAM LINE2D2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LINE2D_DRAW
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       LINE2D object access program
      EXTERNAL LINE2D_DRAW
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL MARKER_SIZE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV110 =  2)
      PARAMETER (NVV111 =  2)
      PARAMETER (NVV112 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'LINE2D.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101, TMP102, TMP103, NPBSYM, TMP112
C
C                       Real variables and arrays
      REAL    TMP104, TMP105, TMP106, TMP107, TMP108, TMP109, XPOSP2
     *      , TMP110, YPOSP2, TMP111
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
      REAL    VV110(NVV110)
      REAL    VV111(NVV111)
      INTEGER VV112(NVV112)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /222/
C
      DATA VV110 /-3.33, 9.99/
C
      DATA VV111 /-3.33, 9.99/
C
      DATA VV112 /-32768, 32767, 0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'line2d_draw.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              LINE2D Object Demo Program #2'/
     * ' This program tests the LINE2D object access program'/
     * ' LINE2D_DRAW.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL MARKER_SIZE  (5.0)
C
C     ------------------------------------------------------------------
C
C                       Test LINE2D_DRAW object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        KZLTHK = VV101(IVV101)
C
      DO 588 IVV110 = 1,NVV110
        XPOSP2 = VV110(IVV110)
C
      DO 587 IVV111 = 1,NVV111
        YPOSP2 = VV111(IVV111)
C
      DO 586 IVV112 = 1,NVV112
        NPBSYM = VV112(IVV112)
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (XPAGE*0.5,YPAGE*0.5,NPBSYM)
      CALL LINE2D_DRAW (XPOSP2,YPOSP2,NPBSYM)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=510) TMP101,TMP102,TMP103,TMP104,TMP105,
     *       TMP106,TMP107,TMP108,TMP109,TMP110,TMP111,TMP112
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZLBEG .NE. TMP102 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (KZMOV .NE. TMP103 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRX ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRY ,TMP105 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRX1 ,TMP106 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRY1 ,TMP107 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRX2 ,TMP108 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRY2 ,TMP109 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 523
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=512) KZLTHK,KZLBEG,KZMOV,ZZPRX,ZZPRY,ZZPRX1,
     *       ZZPRY1,ZZPRX2,ZZPRY2,XPOSP2,YPOSP2,NPBSYM
  502 FORMAT (I21,I21,I21,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,
     *       E15.7,I21)
      GOTO 523
C                       Print file I/O error messages
  510 WRITE (IER,511) FILNAM
  511 FORMAT (' Error reading file ',A)
      GOTO 523
C
  512 WRITE (IER,513) FILNAM
  513 FORMAT (' Error writing file ',A)
C
  523 CONTINUE
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              LINE2D Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./line2d3.f ]"
cat <<"STOP_CAT"> ././line2d3.f
C     PROGRAM LINE2D3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LINE2D_DRAWR
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       LINE2D object access program
      EXTERNAL LINE2D_DRAWR
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL MARKER_SIZE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV110 =  2)
      PARAMETER (NVV111 =  2)
      PARAMETER (NVV112 =  3)
      PARAMETER (NVV113 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'LINE2D.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101, TMP102, TMP103, NPBSYM, TMP112, LREL, TMP113
C
C                       Real variables and arrays
      REAL    TMP104, TMP105, TMP106, TMP107, TMP108, TMP109, XPOSP2
     *      , TMP110, YPOSP2, TMP111
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      INTEGER VV101(NVV101)
      REAL    VV110(NVV110)
      REAL    VV111(NVV111)
      INTEGER VV112(NVV112)
      INTEGER VV113(NVV113)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /222/
C
      DATA VV110 /-3333.33, 9999.99/
C
      DATA VV111 /-3333.33, 9999.99/
C
      DATA VV112 /-32768, 32767, 0/
C
      DATA VV113 /0, 1, 2, 3/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'line2d_drawr.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              LINE2D Object Demo Program #3'/
     * ' This program tests the LINE2D object access program'/
     * ' LINE2D_DRAWR.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL MARKER_SIZE  (5.0)
C
C     ------------------------------------------------------------------
C
C                       Test LINE2D_DRAWR object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        KZLTHK = VV101(IVV101)
C
      DO 588 IVV110 = 1,NVV110
        XPOSP2 = VV110(IVV110)
C
      DO 587 IVV111 = 1,NVV111
        YPOSP2 = VV111(IVV111)
C
      DO 586 IVV112 = 1,NVV112
        NPBSYM = VV112(IVV112)
C
      DO 585 IVV113 = 1,NVV113
        LREL = VV113(IVV113)
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (XPAGE*0.5,YPAGE*0.5,NPBSYM)
      CALL LINE2D_DRAW (XPOSP2,YPOSP2,NPBSYM)
C
C                       Draw straight line relative to current location
C                       or origin
      CALL LINE2D_DRAWR (XPOSP2,YPOSP2,NPBSYM,LREL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=510) TMP101,TMP102,TMP103,TMP104,TMP105,
     *       TMP106,TMP107,TMP108,TMP109,TMP110,TMP111,TMP112,TMP113
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZLBEG .NE. TMP102 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (KZMOV .NE. TMP103 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRX ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRY ,TMP105 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRX1 ,TMP106 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRY1 ,TMP107 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRX2 ,TMP108 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZPRY2 ,TMP109 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 523
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=512) KZLTHK,KZLBEG,KZMOV,ZZPRX,ZZPRY,ZZPRX1,
     *       ZZPRY1,ZZPRX2,ZZPRY2,XPOSP2,YPOSP2,NPBSYM,LREL
  502 FORMAT (I21,I21,I21,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,
     *       E15.7,I21,I21)
      GOTO 523
C                       Print file I/O error messages
  510 WRITE (IER,511) FILNAM
  511 FORMAT (' Error reading file ',A)
      GOTO 523
C
  512 WRITE (IER,513) FILNAM
  513 FORMAT (' Error writing file ',A)
C
  523 CONTINUE
C
C                       Repeat for next variable value
  585 CONTINUE
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              LINE2D Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./line2d4.f ]"
cat <<"STOP_CAT"> ././line2d4.f
C     PROGRAM LINE2D4
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LINE2D_THICK
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       LINE2D object access program
      EXTERNAL LINE2D_THICK
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV104 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'LINE2D.INC'
C
C                       Integer variables and arrays
      INTEGER TMP103
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, THICK, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV104 /0.019, 0.75/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'line2d_thick.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              LINE2D Object Demo Program #4'/
     * ' This program tests the LINE2D object access program'/
     * ' LINE2D_THICK.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test LINE2D_THICK object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV104 = 1,NVV104
        THICK = VV104(IVV104)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Set line thickness
      CALL LINE2D_THICK (THICK)
C
C                       Draw straight line relative to origin
      CALL LOGPEN2_SETP (0.,5.,NPBSYM)
      CALL LINE2D_DRAW (15.,5.,NPBSYM)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(UULTHK ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZLTHK ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (KZLTHK .NE. TMP103 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) UULTHK,ZZLTHK,KZLTHK,THICK
  502 FORMAT (E15.7,E15.7,I21,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              LINE2D Demo Program #4 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./line2d5.f ]"
cat <<"STOP_CAT"> ././line2d5.f
C     PROGRAM LINE2D5
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LINE2D_CUSTOM
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      EXTERNAL CHAR_LENBT
      INTEGER  CHAR_LENBT
C
      CHARACTER*24 KODE
      DIMENSION RAY(12)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
      DATA KODE /'Sample PRL-GRAPHICS Plot'/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Clear terminal screen
      CALL TERM_CLEAR (0)
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.10*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 2.0*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DEFINE PLOT HEADING AND LABELS
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN ('LINE2D5 Demo: Custom Line Style in Box',38)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW
     *     ('LINE2D5 Demo: Custom Line Style in Box',38,XX,-0.50)
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW
C
C     ------------------------------------------------------------------
C
C                       PLOT THE SAMPLE TEXT STRING
C
      CALL TEXT2D_SETHT (SIZE*1.5)
C                       Determine the number of characters in the
C                       text string input by the user
      NC = CHAR_LENBT (KODE)
C                       Determine length of text string in inches
      XL = TEXT2D_GETLEN(KODE,NC)
C                       Compute X location at which to start plotting
C                       text string
      XX = (XPG-XL)*0.5
C                       Compute Y location at which to start plotting
C                       text string
      YY = YPG*0.5
C                       Plot the text string
      CALL TEXT2D_PDRAW (KODE,NC,XX,YY)
C                       Enable area blanking around text string
C                       with no border around blank area
      CALL BLNKAREA_DEF1 (XX,XX+XL,YY,YY+SIZE*1.5,0)
C
C     ------------------------------------------------------------------
C
C                       DRAW HORIZONTAL LINES USING NEW (CUSTOM)
C                       LINE STYLE: "---......"
C
C                       Store non-dimen length of line style mark
      RAY(1) = 1.0
C                       Store non-dimen length of line style space
      RAY(2) = 2.0
C                       Compute length of line style pattern in inches
      TLENG  = YPG/10.0
C                       Define the new (custom) line style
C                       and make it the current line style
      CALL LINE2D_CUSTOM (TLENG,2,RAY)
C                       Draw horiz lines in subplot area at one inch
C                       increments using current (custom) line style
      X0 = 0.0
      X1 = XPG
      DY = YPG/13.
      DO 300 I=1,12
        Y0 = FLOAT(I)*DY
        CALL LOGPEN2_SETP (X0,Y0,0)
        Y1 = Y0
        CALL LINE2D_DRAW (X1,Y1,0)
  300 CONTINUE
C                       Reset default line style
      CALL GRAPHICS_RESET ('LINE2D_CUSTOM')
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
C                       End subplot
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
C                       Exit
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./line2d6.f ]"
cat <<"STOP_CAT"> ././line2d6.f
C     PROGRAM LINE2D6
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test LINE object access programs
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       Array for storing custom line style data
      REAL RAY(12)
C                       Arrays for storing line coordinates
      REAL Y1(10),Y2(10),Y3(10),Y4(10),Y5(10),Y6(10),X1(10)
      REAL Z1(10),Z2(10),Z3(10),Z4(10),Z5(10),Z6(10),Z7(10)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALIZE OUTPUT DEVICE
C
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.25*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 2.5*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Disable border plotting by SUBPLOT_DEFINE
      CALL FRAME_OFF
C                       Define subplot area in terms of length
C                       of X and Y axis in inches
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ------------------------------------------------------------------
C
C                       CALCULATE COORDINATES FOR LINES
C
C                       Line X point spacing
      DX = XPG/8.
C                       Each succeeding line is "DY" inch higher in Y
      DY = YPG/17.
C                       Four points per line
      DO 100 I=1,4
C                       Fourth point has
        IF (I.EQ.4) THEN
C                         Point 4 X coord (on right side of plot)
          X1(I)=7.0*DX
C                         Has zero slope (flat line segment)
          Z7(I)=Z7(3)
        ELSE
C                       Points 1,2,3
          X1(I)=REAL(I)*DX
C                         and 22.5 degree (1:2) slope
C                       Z7 is "thick user defined" - lowest line
          Z7(I)=X1(I)/2.0
        ENDIF
C                       Z6 is "thick chndsh"
        Z6(I)=Z7(I)+DY
C                       Z5 is "thick chndot"
        Z5(I)=Z6(I)+DY
C                       Z4 is "thick dash"
        Z4(I)=Z5(I)+DY
C                       Z3 is "thick dot"
        Z3(I)=Z4(I)+DY
C                       Z2 is "thick solid"
        Z2(I)=Z3(I)+DY
C                       Z1 is "solid"
        Z1(I)=Z2(I)+DY
C                       Y6 is "user defined"
        Y6(I)=Z1(I)+DY
C                       Y5 is "chndsh"
        Y5(I)=Y6(I)+DY
C                       Y4 is "chndot"
        Y4(I)=Y5(I)+DY
C                       Y3 is "dash"
        Y3(I)=Y4(I)+DY
C                       Y2 is "dot"
        Y2(I)=Y3(I)+DY
C                       Y1 is "solid"
        Y1(I)=Y2(I)+DY
 100  CONTINUE
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN ('LINE2D6 Demo: Line Styles$',100)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW ('LINE2D6 Demo: Line Styles$',100,XX,-0.5)
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around plot
      CALL FRAME_DRAW
C                       Compute text height based on page height
      SIZE = 0.12*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C
C                       13 LINES SHOWING DIFFERENT LINE STYLES
C
C     ------------------------------------------------------------------
C
C                        PLOT LINE 1 - "SOLID"
C
C                       Set current drawing color to 'green'
      CALL COLOR_SETNAM ('GREEN')
C                       Plot line 1 ("solid") in green
      DO 601 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y1(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y1(I),0)
        ENDIF
  601 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 2 - "dot"
C
C                       Set current drawing color to 'magenta'
      CALL COLOR_SETNAM ('MAGENTA')
C                       Set line style to 'dot'
      CALL LINE2D_DOT
C                       Plot line 2 ("dot") in magenta
      DO 602 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y2(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y2(I),0)
        ENDIF
  602 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 3 - "dash"
C
C                       Set current drawing color to 'yellow'
      CALL COLOR_SETNAM ('YELLOW')
C                       Set line style to 'dash'
      CALL LINE2D_DASH
C                       Plot line 3 ("dash") in yellow
      DO 603 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y3(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y3(I),0)
        ENDIF
  603 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 4 - "chndot"
C
C                       Set line style to 'chndot'
      CALL LINE2D_CHNDOT
C                       Set current drawing color to 'blue'
      CALL COLOR_SETNAM ('BLUE')
C                       Plot line 4 ("chndot") in blue
      DO 604 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y4(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y4(I),0)
        ENDIF
  604 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 5 - "chdsh"
C
C                       Set line style to 'chndsh'
      CALL LINE2D_CHNDSH
C                       Set current drawing color to 'white'
      CALL COLOR_SETNAM ('WHITE')
C                       Plot line 5 ("chdash") in white
      DO 605 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y5(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y5(I),0)
        ENDIF
  605 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 6 - "USER DEFINED"
C
C                       Set non-dimen length of line style mark
      RAY(1)=1.0
C                       Set non-dimen length of line style space
      RAY(2)=3.0
C                       Set user-defined line style: "--......"
      CALL LINE2D_CUSTOM (0.2,2,RAY)
C                       Set current drawing color to 'red'
      CALL COLOR_SETNAM ('RED')
C                       Plot line 6 ("user defined") in red
      DO 606 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y6(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y6(I),0)
        ENDIF
  606 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 7 - "SOLID"
C
C                       Set line style to 'solid'
      CALL GRAPHICS_RESET ('LINE2D_CHNDSH')
C                       Set current drawing color to 'cyan'
      CALL COLOR_SETNAM ('CYAN')
C                       Plot line 7 ("solid") in cyan
      DO 607 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z1(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z1(I),0)
        ENDIF
  607 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 8 - "THICK SOLID"
C
C                       Set line thickness in inches
      CALL LINE2D_THICK (0.04)
C                       Reset default line style, i.e., solid
      CALL GRAPHICS_RESET ('LINE2D_CUSTOM')
C                       Set current drawing color to 'green'
      CALL COLOR_SETNAM ('GREEN')
C                       Plot line 8 ("thick solid") in green
      DO 608 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z2(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z2(I),0)
        ENDIF
  608 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 9 - "THICK dot"
C
C                       Set current drawing color to 'magenta'
      CALL COLOR_SETNAM ('MAGENTA')
C                       Set line style to 'dot'
      CALL LINE2D_DOT
C                       Plot line 9 ("thick dot") in magenta
      DO 609 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z3(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z3(I),0)
        ENDIF
  609 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 10 - "THICK dash"
C
C                       Set current drawing color to 'yellow'
      CALL COLOR_SETNAM ('YELLOW')
C                       Set line style to 'dash'
      CALL LINE2D_DASH
C                       Plot line 10 ("thick dash") in yellow
      DO 610 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z4(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z4(I),0)
        ENDIF
  610 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 11 - "THICK chndot"
C
C                       Set line style to 'chndot'
      CALL LINE2D_CHNDOT
C                       Set current drawing color to 'blue'
      CALL COLOR_SETNAM ('BLUE')
C                       Plot line 1 ("thick chndot") in blue
      DO 611 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z5(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z5(I),0)
        ENDIF
  611 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 12 - "THICK chndsh"
C
C                       Set line style to 'chndsh'
      CALL LINE2D_CHNDSH
C                       Set current drawing color to 'white'
      CALL COLOR_SETNAM ('WHITE')
C                       Plot line 12 ("thick chndsh") in white
      DO 612 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z6(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z6(I),0)
        ENDIF
  612 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT LINE 13 - "THICK USER DEFINED"
C
C                       Store non-dimen length of 1st line style mark
      RAY(1)=25.0
C                       Store non-dimen length of 1st line style space
      RAY(2)=5.0
C                       Store non-dimen length of 2nd line style mark
      RAY(3)=3.0
C                       Store non-dimen length of 2nd line style space
      RAY(4)=5.0
C                       Store non-dimen length of 3rd line style mark
      RAY(5)=3.0
C                       Store non-dimen length of 3rd line style space
      RAY(6)=5.0
C                       Store non-dimen length of 4th line style mark
      RAY(7)=3.0
C                       Store non-dimen length of 4th line style space
      RAY(8)=5.0
C                       Set user defined line style: "-----.-.-.-."
      CALL LINE2D_CUSTOM (0.9,8,RAY)
C                       Set current drawing color to 'red'
      CALL COLOR_SETNAM ('RED')
C                       Plot line 13 ("thick user defined") in red
      DO 613 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z7(1),0)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z7(I),0)
        ENDIF
  613 CONTINUE
C                       Reset default line thickness
      CALL GRAPHICS_RESET ('LINE2D_THICK')
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./line2d_chndot.dat ]"
cat <<"STOP_CAT"> ././line2d_chndot.uuu
begin 660 ./line2d_chndot.dat
6("`@("`@("`@("`@("`@("`@("`R"O^_
`
end
STOP_CAT
echo "  Generating =====> [ ./line2d_draw.dat ]"
cat <<"STOP_CAT"> ././line2d_draw.uuu
begin 660 ./line2d_draw.dat
M("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@
M("`@("`@("`@("`@("`@,C(R("`M+C0P-S(T.#A%*S`Q("`M+C4P,30Q-S=%
M*S`Q("`M+C0P-S(T.#A%*S`Q("`M+C4P,30Q-S=%*S`Q("`M+C0P-S(T.#A%
M*S`Q("`M+C4P,30Q-S=%*S`Q("`M+C,S,S`P,#!%*S`Q("`M+C,S,S`P,#!%
M*S`Q("`@("`@("`@("`@("`@+3,R-S8X"B`@("`@("`@("`@("`@("`@(#(R
M,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@
M+2XT,#<R-#@X12LP,2`@+2XU,#$T,3<W12LP,2`@+2XT,#<R-#@X12LP,2`@
M+2XU,#$T,3<W12LP,2`@+2XT,#<R-#@X12LP,2`@+2XU,#$T,3<W12LP,2`@
M+2XS,S,P,#`P12LP,2`@+2XS,S,P,#`P12LP,2`@("`@("`@("`@("`@("`S
M,C<V-PH@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q
M,3$@("`@("`@("`@("`@("`@("`R,C(@("TN-#`W,C0X.$4K,#$@("TN-3`Q
M-#$W-T4K,#$@("TN-#`W,C0X.$4K,#$@("TN-3`Q-#$W-T4K,#$@("TN-#`W
M,C0X.$4K,#$@("TN-3`Q-#$W-T4K,#$@("TN,S,S,#`P,$4K,#$@("TN,S,S
M,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@
M("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@
M,C(R("`M+C0P-S(T.#A%*S`Q("`@+C$V.30R-3-%*S`R("`M+C0P-S(T.#A%
M*S`Q("`@+C$V.30R-3-%*S`R("`M+C0P-S(T.#A%*S`Q("`@+C$V.30R-3-%
M*S`R("`M+C,S,S`P,#!%*S`Q("`@+CDY.3`P,#!%*S`Q("`@("`@("`@("`@
M("`@+3,R-S8X"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@
M("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XT,#<R-#@X12LP,2`@
M("XQ-CDT,C4S12LP,B`@+2XT,#<R-#@X12LP,2`@("XQ-CDT,C4S12LP,B`@
M+2XT,#<R-#@X12LP,2`@("XQ-CDT,C4S12LP,B`@+2XS,S,P,#`P12LP,2`@
M("XY.3DP,#`P12LP,2`@("`@("`@("`@("`@("`S,C<V-PH@("`@("`@("`@
M("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@
M("`@("`R,C(@("TN-#`W,C0X.$4K,#$@("`N,38Y-#(U,T4K,#(@("TN-#`W
M,C0X.$4K,#$@("`N,38Y-#(U,T4K,#(@("TN-#`W,C0X.$4K,#$@("`N,38Y
M-#(U,T4K,#(@("TN,S,S,#`P,$4K,#$@("`N.3DY,#`P,$4K,#$@("`@("`@
M("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@
M("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`@+C$W.#@T,C)%
M*S`R("`M+C4P,30Q-S=%*S`Q("`@+C$W.#@T,C)%*S`R("`M+C4P,30Q-S=%
M*S`Q("`@+C$W.#@T,C)%*S`R("`M+C4P,30Q-S=%*S`Q("`@+CDY.3`P,#!%
M*S`Q("`M+C,S,S`P,#!%*S`Q("`@("`@("`@("`@("`@+3,R-S8X"B`@("`@
M("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@
M("`@("`@("`@(#(R,B`@("XQ-S@X-#(R12LP,B`@+2XU,#$T,3<W12LP,2`@
M("XQ-S@X-#(R12LP,B`@+2XU,#$T,3<W12LP,2`@("XQ-S@X-#(R12LP,B`@
M+2XU,#$T,3<W12LP,2`@("XY.3DP,#`P12LP,2`@+2XS,S,P,#`P12LP,2`@
M("`@("`@("`@("`@("`S,C<V-PH@("`@("`@("`@("`@("`@("`R,C(@("`@
M("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("`N,3<X
M.#0R,D4K,#(@("TN-3`Q-#$W-T4K,#$@("`N,3<X.#0R,D4K,#(@("TN-3`Q
M-#$W-T4K,#$@("`N,3<X.#0R,D4K,#(@("TN-3`Q-#$W-T4K,#$@("`N.3DY
M,#`P,$4K,#$@("TN,S,S,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#`*
M("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@
M("`@("`@("`@("`@("`@,C(R("`@+C$W.#@T,C)%*S`R("`@+C$V.30R-3-%
M*S`R("`@+C$W.#@T,C)%*S`R("`@+C$V.30R-3-%*S`R("`@+C$W.#@T,C)%
M*S`R("`@+C$V.30R-3-%*S`R("`@+CDY.3`P,#!%*S`Q("`@+CDY.3`P,#!%
M*S`Q("`@("`@("`@("`@("`@+3,R-S8X"B`@("`@("`@("`@("`@("`@(#(R
M,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@
M("XQ-S@X-#(R12LP,B`@("XQ-CDT,C4S12LP,B`@("XQ-S@X-#(R12LP,B`@
M("XQ-CDT,C4S12LP,B`@("XQ-S@X-#(R12LP,B`@("XQ-CDT,C4S12LP,B`@
M("XY.3DP,#`P12LP,2`@("XY.3DP,#`P12LP,2`@("`@("`@("`@("`@("`S
M,C<V-PH@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q
M,3$@("`@("`@("`@("`@("`@("`R,C(@("`N,3<X.#0R,D4K,#(@("`N,38Y
M-#(U,T4K,#(@("`N,3<X.#0R,D4K,#(@("`N,38Y-#(U,T4K,#(@("`N,3<X
M.#0R,D4K,#(@("`N,38Y-#(U,T4K,#(@("`N.3DY,#`P,$4K,#$@("`N.3DY
>,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#`*
`
end
STOP_CAT
echo "  Generating =====> [ ./line2d_drawr.dat ]"
cat <<"STOP_CAT"> ././line2d_drawr.uuu
begin 660 ./line2d_drawr.dat
M("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@
M("`@("`@("`@("`@("`@,C(R("`M+C4T.3,R-3%%*S`T("`M+C4T.30Q.3)%
M*S`T("`M+C4T.3,R-3%%*S`T("`M+C4T.30Q.3)%*S`T("`M+C4T.3,R-3%%
M*S`T("`M+C4T.30Q.3)%*S`T("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%
M*S`T("`@("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@("`P
M"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@
M("`@("`@("`@("`@("`@(#(R,B`@+2XQ,#DX-SDR12LP-2`@+2XU-#DT,3DR
M12LP-"`@+2XQ,#DX-SDR12LP-2`@+2XU-#DT,3DR12LP-"`@+2XQ,#DX-SDR
M12LP-2`@+2XU-#DT,3DR12LP-"`@+2XS,S,S,S,P12LP-"`@+2XS,S,S,S,P
M12LP-"`@("`@("`@("`@("`@("TS,C<V."`@("`@("`@("`@("`@("`@("`@
M,0H@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@
M("`@("`@("`@("`@("`@("`R,C(@("TN-30Y,S(U,44K,#0@("TN,3`Y.#@X
M-D4K,#4@("TN-30Y,S(U,44K,#0@("TN,3`Y.#@X-D4K,#4@("TN-30Y,S(U
M,44K,#0@("TN,3`Y.#@X-D4K,#4@("TN,S,S,S,S,$4K,#0@("TN,S,S,S,S
M,$4K,#0@("`@("`@("`@("`@("`M,S(W-C@@("`@("`@("`@("`@("`@("`@
M(#(*("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q
M("`@("`@("`@("`@("`@("`@,C(R("`M+C$P.3@W.3)%*S`U("`M+C$P.3@X
M.#9%*S`U("`M+C$P.3@W.3)%*S`U("`M+C$P.3@X.#9%*S`U("`M+C$P.3@W
M.3)%*S`U("`M+C$P.3@X.#9%*S`U("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S
M,S!%*S`T("`@("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@
M("`S"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q
M,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XU-#DS,C4Q12LP-"`@+2XU-#DT
M,3DR12LP-"`@+2XU-#DS,C4Q12LP-"`@+2XU-#DT,3DR12LP-"`@+2XU-#DS
M,C4Q12LP-"`@+2XU-#DT,3DR12LP-"`@+2XS,S,S,S,P12LP-"`@+2XS,S,S
M,S,P12LP-"`@("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@
M("`@,`H@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q
M,3$@("`@("`@("`@("`@("`@("`R,C(@("TN,3`Y.#<Y,D4K,#4@("TN-30Y
M-#$Y,D4K,#0@("TN,3`Y.#<Y,D4K,#4@("TN-30Y-#$Y,D4K,#0@("TN,3`Y
M.#<Y,D4K,#4@("TN-30Y-#$Y,D4K,#0@("TN,S,S,S,S,$4K,#0@("TN,S,S
M,S,S,$4K,#0@("`@("`@("`@("`@("`@,S(W-C<@("`@("`@("`@("`@("`@
M("`@(#$*("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@
M,3$Q("`@("`@("`@("`@("`@("`@,C(R("`M+C4T.3,R-3%%*S`T("`M+C$P
M.3@X.#9%*S`U("`M+C4T.3,R-3%%*S`T("`M+C$P.3@X.#9%*S`U("`M+C4T
M.3,R-3%%*S`T("`M+C$P.3@X.#9%*S`U("`M+C,S,S,S,S!%*S`T("`M+C,S
M,S,S,S!%*S`T("`@("`@("`@("`@("`@(#,R-S8W("`@("`@("`@("`@("`@
M("`@("`R"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@
M(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XQ,#DX-SDR12LP-2`@+2XQ
M,#DX.#@V12LP-2`@+2XQ,#DX-SDR12LP-2`@+2XQ,#DX.#@V12LP-2`@+2XQ
M,#DX-SDR12LP-2`@+2XQ,#DX.#@V12LP-2`@+2XS,S,S,S,P12LP-"`@+2XS
M,S,S,S,P12LP-"`@("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@
M("`@("`@,PH@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@
M("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("TN-30Y,S(U,44K,#0@("TN
M-30Y-#$Y,D4K,#0@("TN-30Y,S(U,44K,#0@("TN-30Y-#$Y,D4K,#0@("TN
M-30Y,S(U,44K,#0@("TN-30Y-#$Y,D4K,#0@("TN,S,S,S,S,$4K,#0@("TN
M,S,S,S,S,$4K,#0@("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@
M("`@("`@(#`*("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@
M("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`M+C$P.3@W.3)%*S`U("`M
M+C4T.30Q.3)%*S`T("`M+C$P.3@W.3)%*S`U("`M+C4T.30Q.3)%*S`T("`M
M+C$P.3@W.3)%*S`U("`M+C4T.30Q.3)%*S`T("`M+C,S,S,S,S!%*S`T("`M
M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@("`@("`P("`@("`@("`@("`@
M("`@("`@("`Q"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@
M("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XU-#DS,C4Q12LP-"`@
M+2XQ,#DX.#@V12LP-2`@+2XU-#DS,C4Q12LP-"`@+2XQ,#DX.#@V12LP-2`@
M+2XU-#DS,C4Q12LP-"`@+2XQ,#DX.#@V12LP-2`@+2XS,S,S,S,P12LP-"`@
M+2XS,S,S,S,P12LP-"`@("`@("`@("`@("`@("`@("`@,"`@("`@("`@("`@
M("`@("`@("`@,@H@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@
M("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("TN,3`Y.#<Y,D4K,#4@
M("TN,3`Y.#@X-D4K,#4@("TN,3`Y.#<Y,D4K,#4@("TN,3`Y.#@X-D4K,#4@
M("TN,3`Y.#<Y,D4K,#4@("TN,3`Y.#@X-D4K,#4@("TN,S,S,S,S,$4K,#0@
M("TN,S,S,S,S,$4K,#0@("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@
M("`@("`@("`@(#,*("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@
M("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`M+C4T.3,R-3%%*S`T
M("`@+C$V-#@T-#A%*S`U("`M+C4T.3,R-3%%*S`T("`@+C$V-#@T-#A%*S`U
M("`M+C4T.3,R-3%%*S`T("`@+C$V-#@T-#A%*S`U("`M+C,S,S,S,S!%*S`T
M("`@+CDY.3DY.3!%*S`T("`@("`@("`@("`@("`@+3,R-S8X("`@("`@("`@
M("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@
M("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XQ,#DX-SDR12LP
M-2`@("XQ-C0X-#0X12LP-2`@+2XQ,#DX-SDR12LP-2`@("XQ-C0X-#0X12LP
M-2`@+2XQ,#DX-SDR12LP-2`@("XQ-C0X-#0X12LP-2`@+2XS,S,S,S,P12LP
M-"`@("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@("TS,C<V."`@("`@("`@
M("`@("`@("`@("`@,0H@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@
M("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("TN-30Y,S(U,44K
M,#0@("`N,S(Y-C@T.$4K,#4@("TN-30Y,S(U,44K,#0@("`N,S(Y-C@T.$4K
M,#4@("TN-30Y,S(U,44K,#0@("`N,S(Y-C@T.$4K,#4@("TN,S,S,S,S,$4K
M,#0@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`M,S(W-C@@("`@("`@
M("`@("`@("`@("`@(#(*("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@
M("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`M+C$P.3@W.3)%
M*S`U("`@+C,R.38X-#A%*S`U("`M+C$P.3@W.3)%*S`U("`@+C,R.38X-#A%
M*S`U("`M+C$P.3@W.3)%*S`U("`@+C,R.38X-#A%*S`U("`M+C,S,S,S,S!%
M*S`T("`@+CDY.3DY.3!%*S`T("`@("`@("`@("`@("`@+3,R-S8X("`@("`@
M("`@("`@("`@("`@("`S"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@
M("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XU-#DS,C4Q
M12LP-"`@("XQ-C0X-#0X12LP-2`@+2XU-#DS,C4Q12LP-"`@("XQ-C0X-#0X
M12LP-2`@+2XU-#DS,C4Q12LP-"`@("XQ-C0X-#0X12LP-2`@+2XS,S,S,S,P
M12LP-"`@("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@("`S,C<V-R`@("`@
M("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@("`R,C(@("`@("`@
M("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("TN,3`Y.#<Y
M,D4K,#4@("`N,38T.#0T.$4K,#4@("TN,3`Y.#<Y,D4K,#4@("`N,38T.#0T
M.$4K,#4@("TN,3`Y.#<Y,D4K,#4@("`N,38T.#0T.$4K,#4@("TN,S,S,S,S
M,$4K,#0@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`@,S(W-C<@("`@
M("`@("`@("`@("`@("`@(#$*("`@("`@("`@("`@("`@("`@,C(R("`@("`@
M("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`M+C4T.3,R
M-3%%*S`T("`@+C,R.38X-#A%*S`U("`M+C4T.3,R-3%%*S`T("`@+C,R.38X
M-#A%*S`U("`M+C4T.3,R-3%%*S`T("`@+C,R.38X-#A%*S`U("`M+C,S,S,S
M,S!%*S`T("`@+CDY.3DY.3!%*S`T("`@("`@("`@("`@("`@(#,R-S8W("`@
M("`@("`@("`@("`@("`@("`R"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@
M("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XQ,#DX
M-SDR12LP-2`@("XS,CDV.#0X12LP-2`@+2XQ,#DX-SDR12LP-2`@("XS,CDV
M.#0X12LP-2`@+2XQ,#DX-SDR12LP-2`@("XS,CDV.#0X12LP-2`@+2XS,S,S
M,S,P12LP-"`@("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@("`S,C<V-R`@
M("`@("`@("`@("`@("`@("`@,PH@("`@("`@("`@("`@("`@("`R,C(@("`@
M("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("TN-30Y
M,S(U,44K,#0@("`N,38T.#0T.$4K,#4@("TN-30Y,S(U,44K,#0@("`N,38T
M.#0T.$4K,#4@("TN-30Y,S(U,44K,#0@("`N,38T.#0T.$4K,#4@("TN,S,S
M,S,S,$4K,#0@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`@("`@(#`@
M("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@("`@("`@,C(R("`@
M("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`M+C$P
M.3@W.3)%*S`U("`@+C$V-#@T-#A%*S`U("`M+C$P.3@W.3)%*S`U("`@+C$V
M-#@T-#A%*S`U("`M+C$P.3@W.3)%*S`U("`@+C$V-#@T-#A%*S`U("`M+C,S
M,S,S,S!%*S`T("`@+CDY.3DY.3!%*S`T("`@("`@("`@("`@("`@("`@("`P
M("`@("`@("`@("`@("`@("`@("`Q"B`@("`@("`@("`@("`@("`@(#(R,B`@
M("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@+2XU
M-#DS,C4Q12LP-"`@("XS,CDV.#0X12LP-2`@+2XU-#DS,C4Q12LP-"`@("XS
M,CDV.#0X12LP-2`@+2XU-#DS,C4Q12LP-"`@("XS,CDV.#0X12LP-2`@+2XS
M,S,S,S,P12LP-"`@("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@("`@("`@
M,"`@("`@("`@("`@("`@("`@("`@,@H@("`@("`@("`@("`@("`@("`R,C(@
M("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@("TN
M,3`Y.#<Y,D4K,#4@("`N,S(Y-C@T.$4K,#4@("TN,3`Y.#<Y,D4K,#4@("`N
M,S(Y-C@T.$4K,#4@("TN,3`Y.#<Y,D4K,#4@("`N,S(Y-C@T.$4K,#4@("TN
M,S,S,S,S,$4K,#0@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`@("`@
M(#`@("`@("`@("`@("`@("`@("`@(#,*("`@("`@("`@("`@("`@("`@,C(R
M("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R("`@
M+C$V-#@U-#)%*S`U("`M+C4T.30Q.3)%*S`T("`@+C$V-#@U-#)%*S`U("`M
M+C4T.30Q.3)%*S`T("`@+C$V-#@U-#)%*S`U("`M+C4T.30Q.3)%*S`T("`@
M+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@+3,R
M-S8X("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@("`@("`@("`@(#(R
M,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R,B`@
M("XS,CDV.30R12LP-2`@+2XU-#DT,3DR12LP-"`@("XS,CDV.30R12LP-2`@
M+2XU-#DT,3DR12LP-"`@("XS,CDV.30R12LP-2`@+2XU-#DT,3DR12LP-"`@
M("XY.3DY.3DP12LP-"`@+2XS,S,S,S,P12LP-"`@("`@("`@("`@("`@("TS
M,C<V."`@("`@("`@("`@("`@("`@("`@,0H@("`@("`@("`@("`@("`@("`R
M,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R,C(@
M("`N,38T.#4T,D4K,#4@("TN,3`Y.#@X-D4K,#4@("`N,38T.#4T,D4K,#4@
M("TN,3`Y.#@X-D4K,#4@("`N,38T.#4T,D4K,#4@("TN,3`Y.#@X-D4K,#4@
M("`N.3DY.3DY,$4K,#0@("TN,S,S,S,S,$4K,#0@("`@("`@("`@("`@("`M
M,S(W-C@@("`@("`@("`@("`@("`@("`@(#(*("`@("`@("`@("`@("`@("`@
M,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@,C(R
M("`@+C,R.38Y-#)%*S`U("`M+C$P.3@X.#9%*S`U("`@+C,R.38Y-#)%*S`U
M("`M+C$P.3@X.#9%*S`U("`@+C,R.38Y-#)%*S`U("`M+C$P.3@X.#9%*S`U
M("`@+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@
M+3,R-S8X("`@("`@("`@("`@("`@("`@("`S"B`@("`@("`@("`@("`@("`@
M(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@(#(R
M,B`@("XQ-C0X-30R12LP-2`@+2XU-#DT,3DR12LP-"`@("XQ-C0X-30R12LP
M-2`@+2XU-#DT,3DR12LP-"`@("XQ-C0X-30R12LP-2`@+2XU-#DT,3DR12LP
M-"`@("XY.3DY.3DP12LP-"`@+2XS,S,S,S,P12LP-"`@("`@("`@("`@("`@
M("`S,C<V-R`@("`@("`@("`@("`@("`@("`@,`H@("`@("`@("`@("`@("`@
M("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@("`R
M,C(@("`N,S(Y-CDT,D4K,#4@("TN-30Y-#$Y,D4K,#0@("`N,S(Y-CDT,D4K
M,#4@("TN-30Y-#$Y,D4K,#0@("`N,S(Y-CDT,D4K,#4@("TN-30Y-#$Y,D4K
M,#0@("`N.3DY.3DY,$4K,#0@("TN,S,S,S,S,$4K,#0@("`@("`@("`@("`@
M("`@,S(W-C<@("`@("`@("`@("`@("`@("`@(#$*("`@("`@("`@("`@("`@
M("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@("`@
M,C(R("`@+C$V-#@U-#)%*S`U("`M+C$P.3@X.#9%*S`U("`@+C$V-#@U-#)%
M*S`U("`M+C$P.3@X.#9%*S`U("`@+C$V-#@U-#)%*S`U("`M+C$P.3@X.#9%
M*S`U("`@+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@
M("`@(#,R-S8W("`@("`@("`@("`@("`@("`@("`R"B`@("`@("`@("`@("`@
M("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@("`@
M(#(R,B`@("XS,CDV.30R12LP-2`@+2XQ,#DX.#@V12LP-2`@("XS,CDV.30R
M12LP-2`@+2XQ,#DX.#@V12LP-2`@("XS,CDV.30R12LP-2`@+2XQ,#DX.#@V
M12LP-2`@("XY.3DY.3DP12LP-"`@+2XS,S,S,S,P12LP-"`@("`@("`@("`@
M("`@("`S,C<V-R`@("`@("`@("`@("`@("`@("`@,PH@("`@("`@("`@("`@
M("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@("`@
M("`R,C(@("`N,38T.#4T,D4K,#4@("TN-30Y-#$Y,D4K,#0@("`N,38T.#4T
M,D4K,#4@("TN-30Y-#$Y,D4K,#0@("`N,38T.#4T,D4K,#4@("TN-30Y-#$Y
M,D4K,#0@("`N.3DY.3DY,$4K,#0@("TN,S,S,S,S,$4K,#0@("`@("`@("`@
M("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@(#`*("`@("`@("`@("`@
M("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@("`@
M("`@,C(R("`@+C,R.38Y-#)%*S`U("`M+C4T.30Q.3)%*S`T("`@+C,R.38Y
M-#)%*S`U("`M+C4T.30Q.3)%*S`T("`@+C,R.38Y-#)%*S`U("`M+C4T.30Q
M.3)%*S`T("`@+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@
M("`@("`@("`@("`P("`@("`@("`@("`@("`@("`@("`Q"B`@("`@("`@("`@
M("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@("`@
M("`@(#(R,B`@("XQ-C0X-30R12LP-2`@+2XQ,#DX.#@V12LP-2`@("XQ-C0X
M-30R12LP-2`@+2XQ,#DX.#@V12LP-2`@("XQ-C0X-30R12LP-2`@+2XQ,#DX
M.#@V12LP-2`@("XY.3DY.3DP12LP-"`@+2XS,S,S,S,P12LP-"`@("`@("`@
M("`@("`@("`@("`@,"`@("`@("`@("`@("`@("`@("`@,@H@("`@("`@("`@
M("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@("`@
M("`@("`R,C(@("`N,S(Y-CDT,D4K,#4@("TN,3`Y.#@X-D4K,#4@("`N,S(Y
M-CDT,D4K,#4@("TN,3`Y.#@X-D4K,#4@("`N,S(Y-CDT,D4K,#4@("TN,3`Y
M.#@X-D4K,#4@("`N.3DY.3DY,$4K,#0@("TN,S,S,S,S,$4K,#0@("`@("`@
M("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@(#,*("`@("`@("`@
M("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@("`@
M("`@("`@,C(R("`@+C$V-#@U-#)%*S`U("`@+C$V-#@T-#A%*S`U("`@+C$V
M-#@U-#)%*S`U("`@+C$V-#@T-#A%*S`U("`@+C$V-#@U-#)%*S`U("`@+C$V
M-#@T-#A%*S`U("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%*S`T("`@("`@
M("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@("`P"B`@("`@("`@
M("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@("`@
M("`@("`@(#(R,B`@("XS,CDV.30R12LP-2`@("XQ-C0X-#0X12LP-2`@("XS
M,CDV.30R12LP-2`@("XQ-C0X-#0X12LP-2`@("XS,CDV.30R12LP-2`@("XQ
M-C0X-#0X12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-"`@("`@
M("`@("`@("`@("TS,C<V."`@("`@("`@("`@("`@("`@("`@,0H@("`@("`@
M("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@("`@
M("`@("`@("`R,C(@("`N,38T.#4T,D4K,#4@("`N,S(Y-C@T.$4K,#4@("`N
M,38T.#4T,D4K,#4@("`N,S(Y-C@T.$4K,#4@("`N,38T.#4T,D4K,#4@("`N
M,S(Y-C@T.$4K,#4@("`N.3DY.3DY,$4K,#0@("`N.3DY.3DY,$4K,#0@("`@
M("`@("`@("`@("`M,S(W-C@@("`@("`@("`@("`@("`@("`@(#(*("`@("`@
M("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@("`@
M("`@("`@("`@,C(R("`@+C,R.38Y-#)%*S`U("`@+C,R.38X-#A%*S`U("`@
M+C,R.38Y-#)%*S`U("`@+C,R.38X-#A%*S`U("`@+C,R.38Y-#)%*S`U("`@
M+C,R.38X-#A%*S`U("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%*S`T("`@
M("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@("`S"B`@("`@
M("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@("`@
M("`@("`@("`@(#(R,B`@("XQ-C0X-30R12LP-2`@("XQ-C0X-#0X12LP-2`@
M("XQ-C0X-30R12LP-2`@("XQ-C0X-#0X12LP-2`@("XQ-C0X-30R12LP-2`@
M("XQ-C0X-#0X12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-"`@
M("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@("`@,`H@("`@
M("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@("`@
M("`@("`@("`@("`R,C(@("`N,S(Y-CDT,D4K,#4@("`N,38T.#0T.$4K,#4@
M("`N,S(Y-CDT,D4K,#4@("`N,38T.#0T.$4K,#4@("`N,S(Y-CDT,D4K,#4@
M("`N,38T.#0T.$4K,#4@("`N.3DY.3DY,$4K,#0@("`N.3DY.3DY,$4K,#0@
M("`@("`@("`@("`@("`@,S(W-C<@("`@("`@("`@("`@("`@("`@(#$*("`@
M("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@("`@
M("`@("`@("`@("`@,C(R("`@+C$V-#@U-#)%*S`U("`@+C,R.38X-#A%*S`U
M("`@+C$V-#@U-#)%*S`U("`@+C,R.38X-#A%*S`U("`@+C$V-#@U-#)%*S`U
M("`@+C,R.38X-#A%*S`U("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%*S`T
M("`@("`@("`@("`@("`@(#,R-S8W("`@("`@("`@("`@("`@("`@("`R"B`@
M("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@("`@
M("`@("`@("`@("`@(#(R,B`@("XS,CDV.30R12LP-2`@("XS,CDV.#0X12LP
M-2`@("XS,CDV.30R12LP-2`@("XS,CDV.#0X12LP-2`@("XS,CDV.30R12LP
M-2`@("XS,CDV.#0X12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP12LP
M-"`@("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@("`@,PH@
M("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@("`@
M("`@("`@("`@("`@("`R,C(@("`N,38T.#4T,D4K,#4@("`N,38T.#0T.$4K
M,#4@("`N,38T.#4T,D4K,#4@("`N,38T.#0T.$4K,#4@("`N,38T.#4T,D4K
M,#4@("`N,38T.#0T.$4K,#4@("`N.3DY.3DY,$4K,#0@("`N.3DY.3DY,$4K
M,#0@("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@(#`*
M("`@("`@("`@("`@("`@("`@,C(R("`@("`@("`@("`@("`@("`@,3$Q("`@
M("`@("`@("`@("`@("`@,C(R("`@+C,R.38Y-#)%*S`U("`@+C$V-#@T-#A%
M*S`U("`@+C,R.38Y-#)%*S`U("`@+C$V-#@T-#A%*S`U("`@+C,R.38Y-#)%
M*S`U("`@+C$V-#@T-#A%*S`U("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%
M*S`T("`@("`@("`@("`@("`@("`@("`P("`@("`@("`@("`@("`@("`@("`Q
M"B`@("`@("`@("`@("`@("`@(#(R,B`@("`@("`@("`@("`@("`@(#$Q,2`@
M("`@("`@("`@("`@("`@(#(R,B`@("XQ-C0X-30R12LP-2`@("XS,CDV.#0X
M12LP-2`@("XQ-C0X-30R12LP-2`@("XS,CDV.#0X12LP-2`@("XQ-C0X-30R
M12LP-2`@("XS,CDV.#0X12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP
M12LP-"`@("`@("`@("`@("`@("`@("`@,"`@("`@("`@("`@("`@("`@("`@
M,@H@("`@("`@("`@("`@("`@("`R,C(@("`@("`@("`@("`@("`@("`Q,3$@
M("`@("`@("`@("`@("`@("`R,C(@("`N,S(Y-CDT,D4K,#4@("`N,S(Y-C@T
M.$4K,#4@("`N,S(Y-CDT,D4K,#4@("`N,S(Y-C@T.$4K,#4@("`N,S(Y-CDT
M,D4K,#4@("`N,S(Y-C@T.$4K,#4@("`N.3DY.3DY,$4K,#0@("`N.3DY.3DY
M,$4K,#0@("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@
#(#,*
`
end
STOP_CAT
echo "  Generating =====> [ ./line2d_thick.dat ]"
cat <<"STOP_CAT"> ././line2d_thick.uuu
begin 660 ./line2d_thick.dat
M("`@+C`P,#`P,#!%*S`P("`@+C(U-#`P,#!%+3`Q("`@("`@("`@("`@("`@
M("`@,C(R("`@+C$Y,#`P,#!%+3`Q"B`@("XQ.3`U,#`P12LP,2`@("XQ,C,V
L,S`Q12LP,2`@("`@("`@("`@("`@("`@(#$Q,2`@("XW-3`P,#`P12LP,`HV
`
end
STOP_CAT
echo "  Generating =====> [ ./logpen21.f ]"
cat <<"STOP_CAT"> ././logpen21.f
C     PROGRAM LOGPEN21
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LOGPEN2_SETP and
C              LOGPEN2_GETP
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       LOGPEN2 object access program
      EXTERNAL LOGPEN2_SETP, LOGPEN2_GETP
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  2)
      PARAMETER (NVV102 =  2)
      PARAMETER (NVV103 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER NPBSYM, TMP103
C
C                       Real variables and arrays
      REAL    XPOSP2, TMP101, YPOSP2, TMP102
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV102(NVV102)
      INTEGER VV103(NVV103)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-3333.33, 9999.99/
C
      DATA VV102 /-3333.33, 9999.99/
C
      DATA VV103 /-32768, 32767, 0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'logpen2_setp.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              LOGPEN2 Object Demo Program #1'/
     * ' This program tests the LOGPEN2 object access program'/
     * ' LOGPEN2_SETP.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates a blank plot.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test LOGPEN2_SETP object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        XPOSP2 = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        YPOSP2 = VV102(IVV102)
C
      DO 587 IVV103 = 1,NVV103
        NPBSYM = VV103(IVV103)
C
C                       Set coordinates of logical pen relative to
C                       origin
      CALL LOGPEN2_SETP (XPOSP2,YPOSP2,NPBSYM)
      CALL LOGPEN2_GETP (XPOSP2,YPOSP2)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XPOSP2 ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YPOSP2 ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) XPOSP2,YPOSP2,NPBSYM
  502 FORMAT (E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              LOGPEN2 Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./logpen22.f ]"
cat <<"STOP_CAT"> ././logpen22.f
C     PROGRAM LOGPEN22
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program LOGPEN2_SETR and
C              LOGPEN2_GETP
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       LOGPEN2 object access program
      EXTERNAL LOGPEN2_SETR, LOGPEN2_GETP
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  2)
      PARAMETER (NVV102 =  2)
      PARAMETER (NVV103 =  3)
      PARAMETER (NVV104 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER NPBSYM, TMP103, LREL, TMP104
C
C                       Real variables and arrays
      REAL    XPOSP2, TMP101, YPOSP2, TMP102
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV102(NVV102)
      INTEGER VV103(NVV103)
      INTEGER VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-3333.33, 9999.99/
C
      DATA VV102 /-3333.33, 9999.99/
C
      DATA VV103 /-32768, 32767, 0/
C
      DATA VV104 /0, 1, 2, 3/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'logpen2_setr.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              LOGPEN2 Object Demo Program #2'/
     * ' This program tests the LOGPEN2 object access program'/
     * ' LOGPEN2_SETR.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates a blank plot.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test LOGPEN2_SETR object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        XPOSP2 = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        YPOSP2 = VV102(IVV102)
C
      DO 587 IVV103 = 1,NVV103
        NPBSYM = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        LREL = VV104(IVV104)
C
C                       Set coordinates of logical pen relative to
C                       current location or origin
      CALL LOGPEN2_SETR (XPOSP2,YPOSP2,NPBSYM,LREL)
      CALL LOGPEN2_GETP (XPOSP2,YPOSP2)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XPOSP2 ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YPOSP2 ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) XPOSP2,YPOSP2,NPBSYM,LREL
  502 FORMAT (E15.7,E15.7,I21,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              LOGPEN2 Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./logpen2_setp.dat ]"
cat <<"STOP_CAT"> ././logpen2_setp.uuu
begin 660 ./logpen2_setp.dat
M("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@
M+3,R-S8X"B`@+2XS,S,S,S,P12LP-"`@+2XS,S,S,S,P12LP-"`@("`@("`@
M("`@("`@("`S,C<V-PH@("TN,S,S,S,S,$4K,#0@("TN,S,S,S,S,$4K,#0@
M("`@("`@("`@("`@("`@("`@(#`*("`M+C,S,S,S,S!%*S`T("`@+CDY.3DY
M.3!%*S`T("`@("`@("`@("`@("`@+3,R-S8X"B`@+2XS,S,S,S,P12LP-"`@
M("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@("`S,C<V-PH@("TN,S,S,S,S
M,$4K,#0@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`@("`@(#`*("`@
M+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@+3,R
M-S8X"B`@("XY.3DY.3DP12LP-"`@+2XS,S,S,S,P12LP-"`@("`@("`@("`@
M("`@("`S,C<V-PH@("`N.3DY.3DY,$4K,#0@("TN,S,S,S,S,$4K,#0@("`@
M("`@("`@("`@("`@("`@(#`*("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%
M*S`T("`@("`@("`@("`@("`@+3,R-S8X"B`@("XY.3DY.3DP12LP-"`@("XY
M.3DY.3DP12LP-"`@("`@("`@("`@("`@("`S,C<V-PH@("`N.3DY.3DY,$4K
G,#0@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`@("`@(#`*
`
end
STOP_CAT
echo "  Generating =====> [ ./logpen2_setr.dat ]"
cat <<"STOP_CAT"> ././logpen2_setr.uuu
begin 660 ./logpen2_setr.dat
M("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@
M+3,R-S8X("`@("`@("`@("`@("`@("`@("`P"B`@+2XV-C8V-C8P12LP-"`@
M+2XS,S,S,S,P12LP-"`@("`@("`@("`@("`@("TS,C<V."`@("`@("`@("`@
M("`@("`@("`@,0H@("TN-C8V-C8V,$4K,#0@("TN-C8V-C8V,$4K,#0@("`@
M("`@("`@("`@("`M,S(W-C@@("`@("`@("`@("`@("`@("`@(#(*("`M+C$S
M,S,S,S)%*S`U("`M+C$S,S,S,S)%*S`U("`@("`@("`@("`@("`@+3,R-S8X
M("`@("`@("`@("`@("`@("`@("`S"B`@+2XQ,S,S,S,R12LP-2`@+2XQ,S,S
M,S,R12LP-2`@("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@
M("`@,`H@("TN,C8V-C8V-$4K,#4@("TN,3,S,S,S,D4K,#4@("`@("`@("`@
M("`@("`@,S(W-C<@("`@("`@("`@("`@("`@("`@(#$*("`M+C(V-C8V-C1%
M*S`U("`M+C(V-C8V-C1%*S`U("`@("`@("`@("`@("`@(#,R-S8W("`@("`@
M("`@("`@("`@("`@("`R"B`@+2XU,S,S,S(X12LP-2`@+2XU,S,S,S(X12LP
M-2`@("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@("`@,PH@
M("TN-3,S,S,R.$4K,#4@("TN-3,S,S,R.$4K,#4@("`@("`@("`@("`@("`@
M("`@(#`@("`@("`@("`@("`@("`@("`@(#`*("`M+C$P-C8V-C9%*S`V("`M
M+C4S,S,S,CA%*S`U("`@("`@("`@("`@("`@("`@("`P("`@("`@("`@("`@
M("`@("`@("`Q"B`@+2XQ,#8V-C8V12LP-B`@+2XQ,#8V-C8V12LP-B`@("`@
M("`@("`@("`@("`@("`@,"`@("`@("`@("`@("`@("`@("`@,@H@("TN,C$S
M,S,S,44K,#8@("TN,C$S,S,S,44K,#8@("`@("`@("`@("`@("`@("`@(#`@
M("`@("`@("`@("`@("`@("`@(#,*("`M+C(Q,S,S,S%%*S`V("`@+CDY.3DY
M.3!%*S`T("`@("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@
M("`P"B`@+2XT,C8V-C8R12LP-B`@("XY.3DY.3DP12LP-"`@("`@("`@("`@
M("`@("TS,C<V."`@("`@("`@("`@("`@("`@("`@,0H@("TN-#(V-C8V,D4K
M,#8@("`N,3DY.3DY.$4K,#4@("`@("`@("`@("`@("`M,S(W-C@@("`@("`@
M("`@("`@("`@("`@(#(*("`M+C@U,S,S,C5%*S`V("`@+C,Y.3DY.39%*S`U
M("`@("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@("`S"B`@
M+2XX-3,S,S(U12LP-B`@("XS.3DY.3DV12LP-2`@("`@("`@("`@("`@("`S
M,C<V-R`@("`@("`@("`@("`@("`@("`@,`H@("TN,3<P-C8V-44K,#<@("`N
M,SDY.3DY-D4K,#4@("`@("`@("`@("`@("`@,S(W-C<@("`@("`@("`@("`@
M("`@("`@(#$*("`M+C$W,#8V-C5%*S`W("`@+C<Y.3DY.3%%*S`U("`@("`@
M("`@("`@("`@(#,R-S8W("`@("`@("`@("`@("`@("`@("`R"B`@+2XS-#$S
M,S,P12LP-R`@("XQ-3DY.3DX12LP-B`@("`@("`@("`@("`@("`S,C<V-R`@
M("`@("`@("`@("`@("`@("`@,PH@("TN,S0Q,S,S,$4K,#<@("`N,34Y.3DY
M.$4K,#8@("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@
M(#`*("`M+C8X,C8V-C!%*S`W("`@+C$U.3DY.3A%*S`V("`@("`@("`@("`@
M("`@("`@("`P("`@("`@("`@("`@("`@("`@("`Q"B`@+2XV.#(V-C8P12LP
M-R`@("XS,3DY.3DW12LP-B`@("`@("`@("`@("`@("`@("`@,"`@("`@("`@
M("`@("`@("`@("`@,@H@("TN,3,V-3,S,D4K,#@@("`N-C,Y.3DY,T4K,#8@
M("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@(#,*("`@
M+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@+3,R
M-S8X("`@("`@("`@("`@("`@("`@("`P"B`@("XQ.3DY.3DX12LP-2`@+2XS
M,S,S,S,P12LP-"`@("`@("`@("`@("`@("TS,C<V."`@("`@("`@("`@("`@
M("`@("`@,0H@("`N,3DY.3DY.$4K,#4@("TN-C8V-C8V,$4K,#0@("`@("`@
M("`@("`@("`M,S(W-C@@("`@("`@("`@("`@("`@("`@(#(*("`@+C,Y.3DY
M.39%*S`U("`M+C$S,S,S,S)%*S`U("`@("`@("`@("`@("`@+3,R-S8X("`@
M("`@("`@("`@("`@("`@("`S"B`@("XS.3DY.3DV12LP-2`@+2XQ,S,S,S,R
M12LP-2`@("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@("`@
M,`H@("`N-SDY.3DY,D4K,#4@("TN,3,S,S,S,D4K,#4@("`@("`@("`@("`@
M("`@,S(W-C<@("`@("`@("`@("`@("`@("`@(#$*("`@+C<Y.3DY.3)%*S`U
M("`M+C(V-C8V-C1%*S`U("`@("`@("`@("`@("`@(#,R-S8W("`@("`@("`@
M("`@("`@("`@("`R"B`@("XQ-3DY.3DX12LP-B`@+2XU,S,S,S(X12LP-2`@
M("`@("`@("`@("`@("`S,C<V-R`@("`@("`@("`@("`@("`@("`@,PH@("`N
M,34Y.3DY.$4K,#8@("TN-3,S,S,R.$4K,#4@("`@("`@("`@("`@("`@("`@
M(#`@("`@("`@("`@("`@("`@("`@(#`*("`@+C,Q.3DY.3=%*S`V("`M+C4S
M,S,S,CA%*S`U("`@("`@("`@("`@("`@("`@("`P("`@("`@("`@("`@("`@
M("`@("`Q"B`@("XS,3DY.3DW12LP-B`@+2XQ,#8V-C8V12LP-B`@("`@("`@
M("`@("`@("`@("`@,"`@("`@("`@("`@("`@("`@("`@,@H@("`N-C,Y.3DY
M-$4K,#8@("TN,C$S,S,S,44K,#8@("`@("`@("`@("`@("`@("`@(#`@("`@
M("`@("`@("`@("`@("`@(#,*("`@+C8S.3DY.31%*S`V("`@+CDY.3DY.3!%
M*S`T("`@("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@("`P
M"B`@("XQ,C<Y.3DY12LP-R`@("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@
M("TS,C<V."`@("`@("`@("`@("`@("`@("`@,0H@("`N,3(W.3DY.44K,#<@
M("`N,3DY.3DY.$4K,#4@("`@("`@("`@("`@("`M,S(W-C@@("`@("`@("`@
M("`@("`@("`@(#(*("`@+C(U-3DY.3=%*S`W("`@+C,Y.3DY.39%*S`U("`@
M("`@("`@("`@("`@+3,R-S8X("`@("`@("`@("`@("`@("`@("`S"B`@("XR
M-34Y.3DW12LP-R`@("XS.3DY.3DV12LP-2`@("`@("`@("`@("`@("`S,C<V
M-R`@("`@("`@("`@("`@("`@("`@,`H@("`N-3$Q.3DY-44K,#<@("`N,SDY
M.3DY-D4K,#4@("`@("`@("`@("`@("`@,S(W-C<@("`@("`@("`@("`@("`@
M("`@(#$*("`@+C4Q,3DY.35%*S`W("`@+C<Y.3DY.3%%*S`U("`@("`@("`@
M("`@("`@(#,R-S8W("`@("`@("`@("`@("`@("`@("`R"B`@("XQ,#(S.3DY
M12LP."`@("XQ-3DY.3DX12LP-B`@("`@("`@("`@("`@("`S,C<V-R`@("`@
M("`@("`@("`@("`@("`@,PH@("`N,3`R,SDY.44K,#@@("`N,34Y.3DY.$4K
M,#8@("`@("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@(#`*
M("`@+C(P-#<Y.3A%*S`X("`@+C$U.3DY.3A%*S`V("`@("`@("`@("`@("`@
M("`@("`P("`@("`@("`@("`@("`@("`@("`Q"B`@("XR,#0W.3DX12LP."`@
M("XS,3DY.3DW12LP-B`@("`@("`@("`@("`@("`@("`@,"`@("`@("`@("`@
M("`@("`@("`@,@H@("`N-#`Y-3DY-D4K,#@@("`N-C,Y.3DY,T4K,#8@("`@
G("`@("`@("`@("`@("`@(#`@("`@("`@("`@("`@("`@("`@(#,*
`
end
STOP_CAT
echo "  Generating =====> [ ./margin1.f ]"
cat <<"STOP_CAT"> ././margin1.f
C     PROGRAM MARGIN1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARGIN_SET
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       MARGIN object access program
      EXTERNAL MARGIN_SET
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  6)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'MARGIN.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, GRACEM, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV103(NVV103)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /0.0, 0.5, 3.33, 0.0, -0.5, -3.33/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'margin_set.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              MARGIN Object Demo Program #1'/
     * ' This program tests the MARGIN object access program'/
     * ' MARGIN_SET.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test MARGIN_SET object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        GRACEM = VV103(IVV103)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Expand or contract grace margin around clipping
C                       border
      CALL MARGIN_SET (GRACEM)
C
      CALL LOGPEN2_SETP (-100.,5.,0)
      CALL LINE2D_DRAW  ( 100.,5.,0)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(UUGRCE ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZGRCE ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) UUGRCE,ZZGRCE,GRACEM
  502 FORMAT (E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              MARGIN Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./margin2.f ]"
cat <<"STOP_CAT"> ././margin2.f
C     PROGRAM MARGIN2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARGIN_SET
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      EXTERNAL  CHAR_LENBT
      INTEGER   CHAR_LENBT
C
C                       MARGIN object access program
      EXTERNAL MARGIN_SET
C
      DIMENSION RAY(12)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Loop for each plot
      DO 800 IPLT=1,2
C                       Clear terminal screen
      CALL TERM_CLEAR (0)
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.10*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 2.0*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DEFINE PLOT HEADING AND LABELS
C
C                       DRAW TITLE FOR PLOT 1
C
      IF (IPLT .EQ. 1) THEN
C                       Compute text height based on page height
        SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
        CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
        XX = TEXT2D_GETLEN
     *       ('MARGIN2 Demo: Box with No Clipping$',100)
C                       Compute X coord of start of string in inches
        XX = 0.50*(XPG-XX)
C                       Plot text string
        CALL TEXT2D_PDRAW
     *       ('MARGIN2 Demo: Box with No Clipping$',100,XX,-0.50)
C
C                       DRAW TITLE FOR PLOT 2
C
      ELSE
C                       Compute text height based on page height
        SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
        CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
        XX = TEXT2D_GETLEN
     *       ('MARGIN2 Demo: Box with Clipping Margin$',100)
C                       Compute X coord of start of string in inches
        XX = 0.50*(XPG-XX)
C                       Plot text string
        CALL TEXT2D_PDRAW
     *       ('MARGIN2 Demo: Box with Clipping Margin$',100,XX,-0.50)
      ENDIF
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW
C                       Contract grace margin to box boundary
      IF (IPLT .EQ. 2) THEN
        CALL MARGIN_SET (0.0)
      ENDIF
C
C     ------------------------------------------------------------------
C
C                       DRAW HORIZONTAL LINES USING NEW (CUSTOM)
C                       LINE STYLE: "---......"
C
C                       Store non-dimen length of line style mark
      RAY(1) = 1.0
C                       Store non-dimen length of line style space
      RAY(2) = 2.0
C                       Compute length of line style pattern in inches
      TLENG  = YPG/10.0
C                       Define the new (custom) line style
C                       and make it the current line style
      CALL LINE2D_CUSTOM (TLENG,2,RAY)
C                       Draw horiz lines in subplot area at one inch
C                       increments using current (custom) line style
      X0 = -XPG
      X1 = XPG*2.
      DY = YPG/20.
      DO 300 I=-20,40
        Y0 = FLOAT(I)*DY
        CALL LOGPEN2_SETP (X0,Y0,0)
        Y1 = Y0
        CALL LINE2D_DRAW (X1,Y1,0)
  300 CONTINUE
 
C                       Reset default line style
      CALL GRAPHICS_RESET ('LINE2D_CUSTOM')
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C                       Loop for next plot
  800 CONTINUE
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
C                       Exit
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./margin_set.dat ]"
cat <<"STOP_CAT"> ././margin_set.uuu
begin 660 ./margin_set.dat
M("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%*S`P
M"B`@("XQ,C<P,#`P12LP,2`@("XX,C0R,#`Y12LP,"`@("XU,#`P,#`P12LP
M,`H@("`N.#0U.#(P,$4K,#$@("`N-30X.3$W.$4K,#$@("`N,S,S,#`P,$4K
M,#$*("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%
M*S`P"B`@+2XQ,C<P,#`P12LP,2`@+2XX,C0R,#`Y12LP,"`@+2XU,#`P,#`P
M12LP,`H@("TN.#0U.#(P,$4K,#$@("TN-30X.3$W.$4K,#$@("TN,S,S,#`P
&,$4K,#$*
`
end
STOP_CAT
echo "  Generating =====> [ ./marker1.f ]"
cat <<"STOP_CAT"> ././marker1.f
C     PROGRAM MARKER1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARKER_BLANK
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       Array for storing custom line style data
      REAL RAY(12)
C                       Arrays for storing curve coordinates
      REAL Y1(10),Y2(10),Y3(10),Y4(10),Y5(10),Y6(10),X1(10)
      REAL Z1(10),Z2(10),Z3(10),Z4(10),Z5(10),Z6(10),Z7(10)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALIZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Turn off border plotting by SUBPLOT_DEFINE
      CALL FRAME_OFF
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.25*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 2.5*YRL
C                       Compute text height based on page height
      SIZE = 0.15*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches (border plotting
C                       disabled by previous call to FRAME_OFF)
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ------------------------------------------------------------------
C
C                       CALCULATE COORDINATES FOR CURVES
C
C                       Line X point spacing
      DX = XPG/8.
C                       Each succeeding line is "DY" inch higher in Y
      DY = YPG/17.
C                       Four points per curve
      DO 100 I=1,4
C                       Fourth point has
        IF (I.EQ.4) THEN
C                         large X (is on right side of plot)
          X1(I)=7.0*DX
C                         and zero slope (flat line segment)
          Z7(I)=Z7(3)
        ELSE
C                       Points 1,2,3
          X1(I)=REAL(I)*DX
C                         and 22.5 degree (1:2) slope
C                       Z7 is "thick user defined" - lowest curve
          Z7(I)=X1(I)/2.0
        ENDIF
C                       Each succeeding curve is 1 unit higher in Y
C                       Z6 is "thick chndsh"
        Z6(I)=Z7(I)+DY
C                       Z5 is "thick chndot"
        Z5(I)=Z6(I)+DY
C                       Z4 is "thick dash"
        Z4(I)=Z5(I)+DY
C                       Z3 is "thick dot"
        Z3(I)=Z4(I)+DY
C                       Z2 is "thick solid"
        Z2(I)=Z3(I)+DY
C                       Z1 is "symbols only"
        Z1(I)=Z2(I)+DY
C                       Y6 is "user defined"
        Y6(I)=Z1(I)+DY
C                       Y5 is "chndsh"
        Y5(I)=Y6(I)+DY
C                       Y4 is "chndot, no symbol"
        Y4(I)=Y5(I)+DY
C                       Y3 is "dash, big symbols"
        Y3(I)=Y4(I)+DY
C                       Y2 is "dot, blanked at symbols"
        Y2(I)=Y3(I)+DY
C                       Y1 is "solid"
        Y1(I)=Y2(I)+DY
 100  CONTINUE
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN ('MARKER1 Demo: Marker Blanking$',100)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW ('MARKER1 Demo: Marker Blanking$',100,XX,-0.5)
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around plot
      CALL FRAME_DRAW
C
C                       Compute text height based on page height
      SIZE = 0.12*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C
C                       DIFFERENT LINE STYLES
C
C                       Enable blanking of symbols
      CALL MARKER_BLANK
C                       Set symbol size to 3x normal
      CALL MARKER_SIZE (3.0)
C
C     ------------------------------------------------------------------
C
C                        PLOT CURVE 1 - "SOLID"
C
C                       Set current drawing color to 'green'
      CALL COLOR_SETNAM ('GREEN')
C                       Plot curve 1 ("solid") in green
      DO 601 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y1(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y1(I),1)
        ENDIF
  601 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 2 - "dot"
C
C                       Set current drawing color to 'magenta'
      CALL COLOR_SETNAM ('MAGENTA')
C                       Set line style to 'dot'
      CALL LINE2D_DOT
C                       Set symbol type to octagon
      CALL MARKER_SHAPE (1)
C                       Plot curve 2 ("dot, blanked at symbols")
C                       in magenta
      DO 602 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y2(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y2(I),1)
        ENDIF
  602 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 3 - "dash, BIG SYMBOLS"
C
C                       Set current drawing color to 'yellow'
      CALL COLOR_SETNAM ('YELLOW')
C                       Set line style to 'dash'
      CALL LINE2D_DASH
C                       Set symbol type to triangle
      CALL MARKER_SHAPE (2)
C                       Plot curve 3 ("dash, big symbols") in yellow
      DO 603 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y3(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y3(I),1)
        ENDIF
  603 CONTINUE
C                       Reset normal symbol size of .08 inches
c     CALL GRAPHICS_RESET ('MARKER_SIZE')
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 4 - "chndot, NO SYMBOL"
C
C                       Set line style to 'chndot'
      CALL LINE2D_CHNDOT
C                       Set current drawing color to 'blue'
      CALL COLOR_SETNAM ('BLUE')
C                       Set symbol type to plus sign
      CALL MARKER_SHAPE (3)
C                       Plot curve 4 ("chndot, no symbol") in blue
      DO 604 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y4(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y4(I),1)
        ENDIF
  604 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 5 - "chdsh"
C
C                       Set line style to 'chndsh'
      CALL LINE2D_CHNDSH
C                       Set current drawing color to 'white'
      CALL COLOR_SETNAM ('WHITE')
C                       Set symbol type to "X"
      CALL MARKER_SHAPE (4)
C                       Plot curve 5 ("chdash") in white
      DO 605 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y5(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y5(I),1)
        ENDIF
  605 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 6 - "USER DEFINED"
C
C                       Set non-dimen length of line style mark
      RAY(1)=1.0
C                       Set non-dimen length of line style space
      RAY(2)=3.0
C                       Set user-defined line style: "--......"
      CALL LINE2D_CUSTOM (0.2,2,RAY)
C                       Set current drawing color to 'red'
      CALL COLOR_SETNAM ('RED')
C                       Set symbol type to diamond
      CALL MARKER_SHAPE (5)
C                       Plot curve 6 ("user defined") in red
      DO 606 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Y6(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Y6(I),1)
        ENDIF
  606 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 7 - "SYMBOLS ONLY"
C
C                       Set current drawing color to 'cyan'
      CALL COLOR_SETNAM ('CYAN')
C                       Set symbol type to inverted triangle
      CALL MARKER_SHAPE (6)
C                       Plot curve 7 ("symbols only") in cyan
      DO 607 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z1(1),1)
        ELSE
          CALL LOGPEN2_SETP (X1(I),Z1(I),1)
        ENDIF
  607 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 8 - "THICK SOLID"
C
C                       Set curve thickness in inches
      CALL LINE2D_THICK (0.04)
C                       Set symbol size to 1.5x normal
c     CALL MARKER_SIZE (1.5)
C                       Reset default line style, i.e., solid
      CALL GRAPHICS_RESET ('LINE2D_CUSTOM')
C                       Set current drawing color to 'green'
      CALL COLOR_SETNAM ('GREEN')
C                       Set symbol type to boxed "X"
      CALL MARKER_SHAPE (7)
C                       Plot curve 8 ("thick solid") in green
      DO 608 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z2(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z2(I),1)
        ENDIF
  608 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 9 - "THICK dot"
C
C                       Set current drawing color to 'magenta'
      CALL COLOR_SETNAM ('MAGENTA')
C                       Set line style to 'dot'
      CALL LINE2D_DOT
C                       Set symbol type to asterisk
      CALL MARKER_SHAPE (8)
C                       Plot curve 9 ("thick dot") in magenta
      DO 609 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z3(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z3(I),1)
        ENDIF
  609 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 10 - "THICK dash"
C
C                       Set current drawing color to 'yellow'
      CALL COLOR_SETNAM ('YELLOW')
C                       Set line style to 'dash'
      CALL LINE2D_DASH
C                       Set symbol type to ruled diamond
      CALL MARKER_SHAPE (9)
C                       Plot curve 10 ("thick dash") in yellow
      DO 610 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z4(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z4(I),1)
        ENDIF
  610 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 11 - "THICK chndot"
C
C                       Set line style to 'chndot'
      CALL LINE2D_CHNDOT
C                       Set current drawing color to 'blue'
      CALL COLOR_SETNAM ('BLUE')
C                       Set symbol type to ruled octagon
      CALL MARKER_SHAPE (10)
C                       Plot curve 1 ("thick chndot") in blue
      DO 611 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z5(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z5(I),1)
        ENDIF
  611 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 12 - "THICK chndsh"
C
C                       Set line style to 'chndsh'
      CALL LINE2D_CHNDSH
C                       Set current drawing color to 'white'
      CALL COLOR_SETNAM ('WHITE')
C                       Set symbol type to double triangle
      CALL MARKER_SHAPE (11)
C                       Plot curve 12 ("thick chndsh") in white
      DO 612 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z6(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z6(I),1)
        ENDIF
  612 CONTINUE
C
C     ------------------------------------------------------------------
C
C                       PLOT CURVE 13 - "THICK USER DEFINED"
C
C                       Store non-dimen length of 1st line style mark
      RAY(1)=25.0
C                       Store non-dimen length of 1st line style space
      RAY(2)=5.0
C                       Store non-dimen length of 2nd line style mark
      RAY(3)=3.0
C                       Store non-dimen length of 2nd line style space
      RAY(4)=5.0
C                       Store non-dimen length of 3rd line style mark
      RAY(5)=3.0
C                       Store non-dimen length of 3rd line style space
      RAY(6)=5.0
C                       Store non-dimen length of 4th line style mark
      RAY(7)=3.0
C                       Store non-dimen length of 4th line style space
      RAY(8)=5.0
C                       Set user defined line style: "-----.-.-.-."
      CALL LINE2D_CUSTOM (0.9,8,RAY)
C                       Set current drawing color to 'red'
      CALL COLOR_SETNAM ('RED')
C                       Set symbol type to ruled box
      CALL MARKER_SHAPE (12)
C                       Plot curve 13 ("thick user defined") in red
      DO 613 I=1,4
        IF (I .EQ. 1) THEN
          CALL LOGPEN2_SETP (X1(1),Z7(1),1)
        ELSE
          CALL LINE2D_DRAW (X1(I),Z7(I),1)
        ENDIF
  613 CONTINUE
C                       Reset default curve thickness
      CALL GRAPHICS_RESET ('LINE2D_THICK')
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./marker2.f ]"
cat <<"STOP_CAT"> ././marker2.f
C     PROGRAM MARKER2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARKER_SIZE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       MARKER object access program
      EXTERNAL MARKER_SIZE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL MARKER_SHAPE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  8)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'MARKER.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, FAC, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV103(NVV103)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /.000001, 1.0, 10.0, 20.0, 30.0, 40, 50, 9999.99/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'marker_size.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              MARKER Object Demo Program #2'/
     * ' This program tests the MARKER object access program'/
     * ' MARKER_SIZE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL MARKER_SHAPE (5)
C
C     ------------------------------------------------------------------
C
C                       Test MARKER_SIZE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        FAC = VV103(IVV103)
C
C                       Set marker size factor
      CALL MARKER_SIZE (FAC)
C
      CALL LOGPEN2_SETP (5.5,5.5,1)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(UUSMSZ ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZSMSZ ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) UUSMSZ,ZZSMSZ,FAC
  502 FORMAT (E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              MARKER Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./marker3.f ]"
cat <<"STOP_CAT"> ././marker3.f
C     PROGRAM MARKER3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARKER_DRAWCUST
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       MARKER object access program
      EXTERNAL MARKER_DRAWCUST
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL LOGPEN2_SETP
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  2)
      PARAMETER (NVV104 =  4)
      PARAMETER (NVV105 =  4)
      PARAMETER (NVV106 =  1)
C
C                       Argument maximum array sizes
      PARAMETER (MX104 = 4)
      PARAMETER (MX105 = 4)
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'MARKER.INC'
C
C                       Integer variables and arrays
      INTEGER NSY, TMP106
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, TMP103, XSY(MX104), TMP104(MX104)
     *      , YSY(MX105), TMP105(MX105)
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV104(NVV104)
      REAL    VV105(NVV105)
      INTEGER VV106(NVV106)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /0.05, 0.1/
C
      DATA VV104 /0., 2., 0., 0.0/
C
      DATA VV105 /0., 1., 2., 0.0/
C
      DATA VV106 /4/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'marker_drawcust.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              MARKER Object Demo Program #3'/
     * ' This program tests the MARKER object access program'/
     * ' MARKER_DRAWCUST.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL LOGPEN2_SETP (5.5,5.5,0)
C
C     ------------------------------------------------------------------
C
C                       Test MARKER_DRAWCUST object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        ZZSMSZ = VV101(IVV101)
C
      DO 588 IVV104 = 1,NVV104
        XSY(IVV104) = VV104(IVV104)
  588 CONTINUE
C
      DO 587 IVV105 = 1,NVV105
        YSY(IVV105) = VV105(IVV105)
  587 CONTINUE
C
      NSY = VV106(NVV106)
C
C                       Draw custom marker symbol
      CALL MARKER_DRAWCUST (XSY,YSY,NSY)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=510) TMP101,TMP102,TMP103,TMP104,TMP105,
     *       TMP106
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XSYMOR ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YSYMOR ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 523
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=512) ZZSMSZ,XSYMOR,YSYMOR,XSY,YSY,NSY
  502 FORMAT (E15.7,E15.7,E15.7,E15.7,E15.7,I21)
      GOTO 523
C                       Print file I/O error messages
  510 WRITE (IER,511) FILNAM
  511 FORMAT (' Error reading file ',A)
      GOTO 523
C
  512 WRITE (IER,513) FILNAM
  513 FORMAT (' Error writing file ',A)
C
  523 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              MARKER Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./marker4.f ]"
cat <<"STOP_CAT"> ././marker4.f
C     PROGRAM MARKER4
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARKER_GET
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       MARKER object access program
      EXTERNAL MARKER_GET
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  2)
      PARAMETER (NVV102 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'MARKER.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, XPOSP2, TMP103, YPOSP2, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-3333.33, 9999.99/
C
      DATA VV102 /-3333.33, 9999.99/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'marker_get.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              MARKER Object Demo Program #4'/
     * ' This program tests the MARKER object access program'/
     * ' MARKER_GET.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates a blank plot.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test MARKER_GET object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        XSYMOR = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        YSYMOR = VV102(IVV102)
C
C                       Get location of current marker
      CALL MARKER_GET (XPOSP2,YPOSP2)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XPOSP2 ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YPOSP2 ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) XSYMOR,YSYMOR,XPOSP2,YPOSP2
  502 FORMAT (E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
  589 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              MARKER Demo Program #4 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./marker5.f ]"
cat <<"STOP_CAT"> ././marker5.f
C     PROGRAM MARKER5
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program MARKER_SHAPE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      DIMENSION   XM(19),YM(19)
      CHARACTER*2 MNUM(19)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Marker display coordinates
C                       (based on scale of 1.-10.)
      DATA XM /1.,3.,5.,7.,9.,1.,3.,5.,7.,9.,
     1         1.,3.,5.,7.,9.,1.,3.,5.,7.0/
      DATA YM /8.,8.,8.,8.,8.,6.,6.,6.,6.,6.,
     1         4.,4.,4.,4.,4.,2.,2.,2.,2.0/
C
C                       Marker index numbers
      DATA MNUM /' 0',' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9',
     1           '10','11','12','13','14','15','16','17','18'/
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALIZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Compute length of X and Y axis in inches
C                       for a square plot
      IF (XPAGE .GT. YPAGE) THEN
        YPG = YPAGE * 0.75
        XPG = YPG
      ELSE
        XPG = XPAGE * 0.75
        YPG = XPG
      END IF
C                       Compute location of physical origin in inches
C                       so that plot will be centered on the page
      XRL = 0.5 * (XPAGE-XPG)
      YRL = 0.5 * (YPAGE-YPG)
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (XRL,YRL)
C                       Turn off border plotting by SUBPLOT_DEFINE
      CALL FRAME_OFF
C                       Define subplot area in terms of length
C                       of X and Y axis in inches (border plotting
C                       disabled by previous call to FRAME_OFF)
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN
     *     ('MARKER5 Demo: Pre-Defined Marker Shapes$',100)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW
     *     ('MARKER5 Demo: Pre-Defined Marker Shapes$',100,XX,-0.5)
C
C     ******************************************************************
C
C                       DRAW EACH OF THE 19 PREDEFINED SHOWSYM TYPES
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW
C                       Compute text height for marker numbers
C                       based on page height
      SIZE = 0.2*YPAGE/11.
C                       Set text height in inches
      CALL TEXT2D_SETHT (SIZE)
C
C                       Set symbol size to 5x normal
      CALL MARKER_SIZE (5.)
C
C                       Marker label offset
      XML = XPG*.03
      YML = YPG*.08
C                       Loop for each marker type
      DO 690 I=1,19
C                       Set index of predefined marker
        MARK = I-1
C                       Enable marker type
        CALL MARKER_SHAPE (MARK)
C                       Store X and Y coords of line
        X = XM(I)*XPG*0.1
        Y = YM(I)*YPG*0.1
C                       Draw marker at specified location
        CALL LOGPEN2_SETP (X,Y,-1)
C                       Draw number under marker
        CALL TEXT2D_PDRAW (MNUM(I),2,X-XML,Y-YML)
C                       Repeat for next marker type
  690 CONTINUE
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./marker_drawcust.dat ]"
cat <<"STOP_CAT"> ././marker_drawcust.uuu
begin 660 ./marker_drawcust.dat
M("`@+C4P,#`P,#!%+3`Q("`@+C$P-#@R.3!%*S`R("`@+CDU-#$R,3!%*S`Q
M("`@+C`P,#`P,#!%*S`P("`@+C(P,#`P,#!%*S`Q("`@("`@("`@("`@("`@
M("`@("`P"B`@("XP,#`P,#`P12LP,"`@("XP,#`P,#`P12LP,"`@("XQ,#`P
M,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("XP,#`P,#`P12LP,"`@("`@("`@
M("`@("`@("`@("`@-`H@("`N,3`P,#`P,$4K,#`@("`N,3`T.#(Y,$4K,#(@
M("`N.34T,3(Q,$4K,#$@("`N,#`P,#`P,$4K,#`@("`N,C`P,#`P,$4K,#$@
M("`@("`@("`@("`@("`@("`@(#`*("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P
M,#!%*S`P("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@+C`P,#`P
<,#!%*S`P("`@("`@("`@("`@("`@("`@("`T"C`P
`
end
STOP_CAT
echo "  Generating =====> [ ./marker_get.dat ]"
cat <<"STOP_CAT"> ././marker_get.uuu
begin 660 ./marker_get.dat
M("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%*S`T("`M+C(P,C,P,3A%*S`T
M("`M+C(P,C(T-#=%*S`T"B`@+2XS,S,S,S,P12LP-"`@("XY.3DY.3DP12LP
M-"`@+2XR,#(S,#$X12LP-"`@("XV,#8V,3@X12LP-`H@("`N.3DY.3DY,$4K
M,#0@("TN,S,S,S,S,$4K,#0@("`N-C`V-38Q-T4K,#0@("TN,C`R,C0T-T4K
M,#0*("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%*S`T("`@+C8P-C4V,3=%
3*S`T("`@+C8P-C8Q.#A%*S`T"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./marker_size.dat ]"
cat <<"STOP_CAT"> ././marker_size.uuu
begin 660 ./marker_size.dat
M("`@+C(P,S(P,#!%+3`V("`@+C$S,3@W,C%%+3`V("`@+C$P,#`P,#!%+3`U
M"B`@("XR,#,R,#`P12LP,"`@("XQ,S$X-S(Q12LP,"`@("XQ,#`P,#`P12LP
M,0H@("`N,C`S,C`P,$4K,#$@("`N,3,Q.#<R,44K,#$@("`N,3`P,#`P,$4K
M,#(*("`@+C0P-C0P,#!%*S`Q("`@+C(V,S<T-#-%*S`Q("`@+C(P,#`P,#!%
M*S`R"B`@("XV,#DV,#`P12LP,2`@("XS.34V,38T12LP,2`@("XS,#`P,#`P
M12LP,@H@("`N.#$R-SDY.44K,#$@("`N-3(W-#@X-D4K,#$@("`N-#`P,#`P
M,$4K,#(*("`@+C$P,38P,#!%*S`R("`@+C8U.3,V,#=%*S`Q("`@+C4P,#`P
M,#!%*S`R"B`@("XR,#,Q.3DX12LP-"`@("XQ,S$X-S(P12LP-"`@("XY.3DY
(.3DP12LP-`H@
`
end
STOP_CAT
echo "  Generating =====> [ ./origin1.f ]"
cat <<"STOP_CAT"> ././origin1.f
C     PROGRAM ORIGIN1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program ORIGIN_MOVE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       ORIGIN object access program
      EXTERNAL ORIGIN_MOVE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  2)
      PARAMETER (NVV104 =  2)
      PARAMETER (NVV106 =  2)
      PARAMETER (NVV107 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'ORIGIN.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
      REAL    TMP102, TMP104, XOREL, TMP106, YOREL, TMP107
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV102(NVV102)
      REAL    VV104(NVV104)
      REAL    VV106(NVV106)
      REAL    VV107(NVV107)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /0.0, 9999.99/
C
      DATA VV104 /0.0, 9999.99/
C
      DATA VV106 /-3333.33, 9999.99/
C
      DATA VV107 /-3333.33, 9999.99/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'origin_move.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              ORIGIN Object Demo Program #1'/
     * ' This program tests the ORIGIN object access program'/
     * ' ORIGIN_MOVE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test ORIGIN_MOVE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        UUXOR = VV102(IVV102)
C
      DO 588 IVV104 = 1,NVV104
        UUYOR = VV104(IVV104)
C
      DO 587 IVV106 = 1,NVV106
        XOREL = VV106(IVV106)
C
      DO 586 IVV107 = 1,NVV107
        YOREL = VV107(IVV107)
C
C                       Move origin relative to current origin location
      CALL ORIGIN_MOVE (XOREL,YOREL)
C
C                       Define subplot area
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP104,TMP106,TMP107
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZOR .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUXOR ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUYOR ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZOR,UUXOR,UUYOR,XOREL,YOREL
  502 FORMAT (I21,E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END(0)
C                       End plotting on current page
      CALL PAGE_END (ISPARE)
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              ORIGIN Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./origin2.f ]"
cat <<"STOP_CAT"> ././origin2.f
C     PROGRAM ORIGIN2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program ORIGIN_SET
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       ORIGIN object access program
      EXTERNAL ORIGIN_SET
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV104 =  2)
      PARAMETER (NVV105 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'ORIGIN.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
      REAL    TMP102, TMP103, XOABS, TMP104, YOABS, TMP105
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV104(NVV104)
      REAL    VV105(NVV105)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV104 /-3333.33, 9999.99/
C
      DATA VV105 /-3333.33, 9999.99/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'origin_set.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              ORIGIN Object Demo Program #2'/
     * ' This program tests the ORIGIN object access program'/
     * ' ORIGIN_SET.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test ORIGIN_SET object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV104 = 1,NVV104
        XOABS = VV104(IVV104)
C
      DO 588 IVV105 = 1,NVV105
        YOABS = VV105(IVV105)
C
C                       Set location of origin relative to lower left
C                       corner of page
      CALL ORIGIN_SET (XOABS,YOABS)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZOR .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUXOR ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUYOR ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZOR,UUXOR,UUYOR,XOABS,YOABS
  502 FORMAT (I21,E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              ORIGIN Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./origin_move.dat ]"
cat <<"STOP_CAT"> ././origin_move.uuu
begin 660 ./origin_move.dat
M("`@("`@("`@("`@("`@("`@,3$Q("`M+C@T-C8V-3A%*S`T("`M+C@T-C8V
M-3A%*S`T("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%*S`T"B`@("`@("`@
M("`@("`@("`@(#$Q,2`@+2XQ-CDS,S,R12LP-2`@("XQ-CDS,S,R12LP-2`@
M+2XS,S,S,S,P12LP-"`@("XY.3DY.3DP12LP-`H@("`@("`@("`@("`@("`@
M("`Q,3$@("`N.#0V-C8U.$4K,#0@("`N.#0V-C8U.$4K,#0@("`N.3DY.3DY
M,$4K,#0@("TN,S,S,S,S,$4K,#0*("`@("`@("`@("`@("`@("`@,3$Q("`@
M+C,S.#8V-C-%*S`U("`@+C,S.#8V-C-%*S`U("`@+CDY.3DY.3!%*S`T("`@
M+CDY.3DY.3!%*S`T"B`@("`@("`@("`@("`@("`@(#$Q,2`@("XR-3,Y.3DW
M12LP-2`@("XQ-3,S,S,R12LP-"`@+2XS,S,S,S,P12LP-"`@+2XS,S,S,S,P
M12LP-`H@("`@("`@("`@("`@("`@("`Q,3$@("`N,38Y,S,S,D4K,#4@("`N
M,C8Y,S,S,44K,#4@("TN,S,S,S,S,$4K,#0@("`N.3DY.3DY,$4K,#0*("`@
M("`@("`@("`@("`@("`@,3$Q("`@+C0R,S,S,CE%*S`U("`@+C$X-#8V-C5%
M*S`U("`@+CDY.3DY.3!%*S`T("`M+C,S,S,S,S!%*S`T"B`@("`@("`@("`@
M("`@("`@(#$Q,2`@("XV-S<S,S(W12LP-2`@("XT,S@V-C8R12LP-2`@("XY
M.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-`H@("`@("`@("`@("`@("`@("`Q
M,3$@("`N,34S,S,S,D4K,#0@("TN.#0V-C8U.$4K,#0@("TN,S,S,S,S,$4K
M,#0@("TN,S,S,S,S,$4K,#0*("`@("`@("`@("`@("`@("`@,3$Q("`M+C8Y
M,S,S,C9%*S`T("`@+C$V.3,S,S)%*S`U("`M+C,S,S,S,S!%*S`T("`@+CDY
M.3DY.3!%*S`T"B`@("`@("`@("`@("`@("`@(#$Q,2`@("XQ.#0V-C8U12LP
M-2`@("XX-#8V-C4X12LP-"`@("XY.3DY.3DP12LP-"`@+2XS,S,S,S,P12LP
M-`H@("`@("`@("`@("`@("`@("`Q,3$@("`N-#,X-C8V,D4K,#4@("`N,S,X
M-C8V,T4K,#4@("`N.3DY.3DY,$4K,#0@("`N.3DY.3DY,$4K,#0*("`@("`@
M("`@("`@("`@("`@,3$Q("`@+C,U,SDY.39%*S`U("`@+C$U,S,S,S)%*S`T
M("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%*S`T"B`@("`@("`@("`@("`@
M("`@(#$Q,2`@("XR-CDS,S,Q12LP-2`@("XR-CDS,S,Q12LP-2`@+2XS,S,S
M,S,P12LP-"`@("XY.3DY.3DP12LP-`H@("`@("`@("`@("`@("`@("`Q,3$@
M("`N-3(S,S,R.$4K,#4@("`N,3@T-C8V-44K,#4@("`N.3DY.3DY,$4K,#0@
M("TN,S,S,S,S,$4K,#0*("`@("`@("`@("`@("`@("`@,3$Q("`@+C<W-S,S
M,C9%*S`U("`@+C0S.#8V-C)%*S`U("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY
'.3!%*S`T"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./origin_set.dat ]"
cat <<"STOP_CAT"> ././origin_set.uuu
begin 660 ./origin_set.dat
M("`@("`@("`@("`@("`@("`@,3$Q("`M+C@T-C8V-3A%*S`T("`M+C@T-C8V
M-3A%*S`T("`M+C,S,S,S,S!%*S`T("`M+C,S,S,S,S!%*S`T"B`@("`@("`@
M("`@("`@("`@(#$Q,2`@+2XX-#8V-C4X12LP-"`@("XR-3,Y.3DW12LP-2`@
M+2XS,S,S,S,P12LP-"`@("XY.3DY.3DP12LP-`H@("`@("`@("`@("`@("`@
M("`Q,3$@("`N,C4S.3DY-T4K,#4@("TN.#0V-C8U.$4K,#0@("`N.3DY.3DY
M,$4K,#0@("TN,S,S,S,S,$4K,#0*("`@("`@("`@("`@("`@("`@,3$Q("`@
M+C(U,SDY.3=%*S`U("`@+C(U,SDY.3=%*S`U("`@+CDY.3DY.3!%*S`T("`@
-+CDY.3DY.3!%*S`T"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./page1.f ]"
cat <<"STOP_CAT"> ././page1.f
C     PROGRAM PAGE1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PAGE_END
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       PAGE object access program
      EXTERNAL PAGE_END
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, ORIGIN_SET, SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER ISPARE
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER
C
      DOUBLE PRECISION  DTOLER
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
      DATA TOLER /1.0E-5/
      DATA DTOLER /1.0D-13/
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
      WRITE (IOUT,301)
  301 FORMAT (
     * '              PAGE Object Demo Program #1'/
     * ' This program tests the PAGE object access program'/
     * ' PAGE_END.'/
     * ' This demo first queries for a graphics device to initialize.'/
     * ' It then uses PAGE_END to clear the screen or otherwise'/
     * ' obtain a new drawing surface.  There is no input to'/
     * ' PAGE_END.'//
     * ' Note: selecting a Tektronix terminal driver may result in'/
     * ' "garbage" characters being written to the screen if you have'/
     * ' a non-Tektronix terminal.'//
     * '                      Press <CR> to continue')
      READ (IN,811) PAUS
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Test PAGE_END object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        ISPARE = 0
C
C     ------------------------------------------------------------------
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL SUBPLOT_END(0)
C
C     ------------------------------------------------------------------
C
C                       End plotting on current page
      CALL PAGE_END (ISPARE)
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C                       Repeat for next variable value
  589 CONTINUE
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              PAGE Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./page2.f ]"
cat <<"STOP_CAT"> ././page2.f
C     PROGRAM PAGE2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PAGE_ORIENT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       PAGE object access program
      EXTERNAL PAGE_ORIENT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  3)
      PARAMETER (NVVTYP = 13)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'PAGE.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER ORIENT*4, TMP102*4
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*4 VV102(NVV102)
      INTEGER     VVTYP(NVVTYP)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /'AUTO', 'MOVI', 'COMI'/
C
      DATA VVTYP /2, 3, 4, 5, 6, 7, 8, 10, 11, 12, 13, 14, 15/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'page_orient.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              PAGE Object Demo Program #2'/
     * ' This program tests the PAGE object access program'/
     * ' PAGE_ORIENT.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * '                      Press <CR> to continue')
      READ (IN,811) PAUS
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Loop for each device
      DO 590 IVVTYP=1,NVVTYP
C                       Select device and advance package to level 1
      KTYPE = VVTYP(IVVTYP)
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test PAGE_ORIENT object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        ORIENT = VV102(IVV102)
C
C                       Specify page orientation
      CALL PAGE_ORIENT (ORIENT)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZAUTO .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZAUTO,ORIENT
  502 FORMAT (I21,A)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
  590 CONTINUE
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * ' Note:'/
     * ' In the above output, occasional strings of "garbage"'/
     * ' characters are normal,  They are the result of printing'/
     * ' Tektronix control code sequences to a non-Tektronix'/
     * ' terminal while exercising the Tektronix drivers.'//
     * '              PAGE Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./page3.f ]"
cat <<"STOP_CAT"> ././page3.f
C     PROGRAM PAGE3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PAGE_SCALE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       PAGE object access program
      EXTERNAL PAGE_SCALE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  5)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'PAGE.INC'
C
C                       Integer variables and arrays
      INTEGER TMP101
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER OSCAL*4, TMP102*4
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*4 VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /'DOWN', 'CLIP', 'ABOR', 'SCRE', 'NONE'/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'page_scale.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              PAGE Object Demo Program #3'/
     * ' This program tests the PAGE object access program'/
     * ' PAGE_SCALE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test PAGE_SCALE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        OSCAL = VV102(IVV102)
C
C                       Set plot scaling behavior for page size that
C                       exceeds device size
      CALL PAGE_SCALE (OSCAL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZSCAL .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZSCAL,OSCAL
  502 FORMAT (I21,A)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              PAGE Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./page4.f ]"
cat <<"STOP_CAT"> ././page4.f
C     PROGRAM PAGE4
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PAGE_SIZE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       PAGE object access program
      EXTERNAL PAGE_SIZE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  3)
      PARAMETER (NVV105 =  3)
      PARAMETER (NVV106 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'PAGE.INC'
C
C                       Integer variables and arrays
      INTEGER TMP102
C
C                       Real variables and arrays
      REAL    TMP101, TMP103, TMP104, PAGEX, TMP105, PAGEY, TMP106
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV105(NVV105)
      REAL    VV106(NVV106)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /2.54, 0.1, 1.0/
C
      DATA VV105 /.000001, 9999.99, 8.5/
C
      DATA VV106 /.000001, 9999.99, 11.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'page_size.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              PAGE Object Demo Program #4'/
     * ' This program tests the PAGE object access program'/
     * ' PAGE_SIZE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test PAGE_SIZE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        ZZUNIT = VV101(IVV101)
C
      DO 588 IVV105 = 1,NVV105
        PAGEX = VV105(IVV105)
C
      DO 587 IVV106 = 1,NVV106
        PAGEY = VV106(IVV106)
C
C                       Set page size for plot
      CALL PAGE_SIZE (PAGEX,PAGEY)
C
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (PAGEX,PAGEY)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105,
     *       TMP106
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZPAGE .NE. TMP102 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUPAGX ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUPAGY ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ZZUNIT,KZPAGE,UUPAGX,UUPAGY,PAGEX,PAGEY
  502 FORMAT (E15.7,I21,E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
      CALL SUBPLOT_END(0)
      CALL PAGE_END (ISPARE)
C
C                       Repeat for next variable value
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              PAGE Demo Program #4 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./page5.f ]"
cat <<"STOP_CAT"> ././page5.f
C     PROGRAM PAGE5
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PAGE_UNIT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       PAGE object access program
      EXTERNAL PAGE_UNIT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  5)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'PAGE.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER CSCAL*4, TMP102*4
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*4 VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /'IN', 'CM', 'CENT', 'MM', 'MILL'/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'page_unit.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              PAGE Object Demo Program #5'/
     * ' This program tests the PAGE object access program'/
     * ' PAGE_UNIT.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test PAGE_UNIT object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        CSCAL = VV102(IVV102)
C
C                       Set page units to one of several standard units
      CALL PAGE_UNIT (CSCAL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(ZZUNIT ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ZZUNIT,CSCAL
  502 FORMAT (E15.7,A)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              PAGE Demo Program #5 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./page6.f ]"
cat <<"STOP_CAT"> ././page6.f
C     PROGRAM PAGE6
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PAGE_UNITCUST
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       PAGE object access program
      EXTERNAL PAGE_UNITCUST
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'PAGE.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, SCALE, TMP102
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /1.0E-36, 9999.99/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'page_unitcust.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              PAGE Object Demo Program #6'/
     * ' This program tests the PAGE object access program'/
     * ' PAGE_UNITCUST.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       Test PAGE_UNITCUST object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        SCALE = VV102(IVV102)
C
C                       Set custom page units
      CALL PAGE_UNITCUST (SCALE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(ZZUNIT ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ZZUNIT,SCALE
  502 FORMAT (E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  589 CONTINUE
C
C     ******************************************************************
C
C                       Clean up environment
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              PAGE Demo Program #6 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./page_orient.dat ]"
cat <<"STOP_CAT"> ././page_orient.uuu
begin 660 ./page_orient.dat
M("`@("`@("`@("`@("`@("`@,3$Q05543PH@("`@("`@("`@("`@("`@("`Q
M,3%-3U9)"B`@("`@("`@("`@("`@("`@(#$Q,4-/34D*("`@("`@("`@("`@
M("`@("`@,3$Q05543PH@("`@("`@("`@("`@("`@("`Q,3%-3U9)"B`@("`@
M("`@("`@("`@("`@(#$Q,4-/34D*("`@("`@("`@("`@("`@("`@,3$Q0554
M3PH@("`@("`@("`@("`@("`@("`R,C)-3U9)"B`@("`@("`@("`@("`@("`@
M(#(R,D-/34D*("`@("`@("`@("`@("`@("`@,3$Q05543PH@("`@("`@("`@
M("`@("`@("`Q,3%-3U9)"B`@("`@("`@("`@("`@("`@(#$Q,4-/34D*("`@
M("`@("`@("`@("`@("`@,3$Q05543PH@("`@("`@("`@("`@("`@("`Q,3%-
M3U9)"B`@("`@("`@("`@("`@("`@(#$Q,4-/34D*("`@("`@("`@("`@("`@
M("`@,3$Q05543PH@("`@("`@("`@("`@("`@("`Q,3%-3U9)"B`@("`@("`@
M("`@("`@("`@(#$Q,4-/34D*("`@("`@("`@("`@("`@("`@,3$Q05543PH@
M("`@("`@("`@("`@("`@("`Q,3%-3U9)"B`@("`@("`@("`@("`@("`@(#$Q
M,4-/34D*("`@("`@("`@("`@("`@("`@,3$Q05543PH@("`@("`@("`@("`@
M("`@("`Q,3%-3U9)"B`@("`@("`@("`@("`@("`@(#$Q,4-/34D*("`@("`@
M("`@("`@("`@("`@,3$Q05543PH@("`@("`@("`@("`@("`@("`R,C)-3U9)
M"B`@("`@("`@("`@("`@("`@(#(R,D-/34D*("`@("`@("`@("`@("`@("`@
M,3$Q05543PH@("`@("`@("`@("`@("`@("`R,C)-3U9)"B`@("`@("`@("`@
M("`@("`@(#(R,D-/34D*("`@("`@("`@("`@("`@("`@,3$Q05543PH@("`@
M("`@("`@("`@("`@("`Q,3%-3U9)"B`@("`@("`@("`@("`@("`@(#$Q,4-/
M34D*("`@("`@("`@("`@("`@("`@,3$Q05543PH@("`@("`@("`@("`@("`@
M("`R,C)-3U9)"B`@("`@("`@("`@("`@("`@(#(R,D-/34D*("`@("`@("`@
M("`@("`@("`@,3$Q05543PH@("`@("`@("`@("`@("`@("`R,C)-3U9)"B`@
8("`@("`@("`@("`@("`@(#(R,D-/34D*
`
end
STOP_CAT
echo "  Generating =====> [ ./page_scale.dat ]"
cat <<"STOP_CAT"> ././page_scale.uuu
begin 660 ./page_scale.dat
M("`@("`@("`@("`@("`@("`@(#$S1$]73@H@("`@("`@("`@("`@("`@("`@
M,3)#3$E0"B`@("`@("`@("`@("`@("`@("`Q-4%"3U(*("`@("`@("`@("`@
H("`@("`@(#$T4T-210H@("`@("`@("`@("`@("`@("`@,3).3TY%"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./page_size.dat ]"
cat <<"STOP_CAT"> ././page_size.uuu
begin 660 ./page_size.dat
M("`@+C(U-#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@,3$Q("`@+C(U-#`P
M,#!%+3`U("`@+C(U-#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P
M,#!%+3`U"B`@("XR-30P,#`P12LP,2`@("`@("`@("`@("`@("`@(#$Q,2`@
M("XR-30P,#`P12TP-2`@("XR-3,Y.3DW12LP-2`@("XQ,#`P,#`P12TP-2`@
M("XY.3DY.3DP12LP-`H@("`N,C4T,#`P,$4K,#$@("`@("`@("`@("`@("`@
M("`Q,3$@("`N,C4T,#`P,$4M,#4@("`N,C<Y-#`P,$4K,#(@("`N,3`P,#`P
M,$4M,#4@("`N,3$P,#`P,$4K,#(*("`@+C(U-#`P,#!%*S`Q("`@("`@("`@
M("`@("`@("`@,3$Q("`@+C(U,SDY.3=%*S`U("`@+C(U-#`P,#!%+3`U("`@
M+CDY.3DY.3!%*S`T("`@+C$P,#`P,#!%+3`U"B`@("XR-30P,#`P12LP,2`@
M("`@("`@("`@("`@("`@(#$Q,2`@("XR-3,Y.3DW12LP-2`@("XR-3,Y.3DW
M12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-`H@("`N,C4T,#`P
M,$4K,#$@("`@("`@("`@("`@("`@("`Q,3$@("`N,C4S.3DY-T4K,#4@("`N
M,C<Y-#`P,$4K,#(@("`N.3DY.3DY,$4K,#0@("`N,3$P,#`P,$4K,#(*("`@
M+C(U-#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@,3$Q("`@+C(Q-3DP,#!%
M*S`R("`@+C(U-#`P,#!%+3`U("`@+C@U,#`P,#!%*S`Q("`@+C$P,#`P,#!%
M+3`U"B`@("XR-30P,#`P12LP,2`@("`@("`@("`@("`@("`@(#$Q,2`@("XR
M,34Y,#`P12LP,B`@("XR-3,Y.3DW12LP-2`@("XX-3`P,#`P12LP,2`@("XY
M.3DY.3DP12LP-`H@("`N,C4T,#`P,$4K,#$@("`@("`@("`@("`@("`@("`Q
M,3$@("`N,C$U.3`P,$4K,#(@("`N,C<Y-#`P,$4K,#(@("`N.#4P,#`P,$4K
M,#$@("`N,3$P,#`P,$4K,#(*("`@+C$P,#`P,#!%*S`P("`@("`@("`@("`@
M("`@("`@,3$Q("`@+C$P,#`P,#!%+3`V("`@+C$P,#`P,#!%+3`V("`@+C$P
M,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U"B`@("XR-30P,#`P12LP,2`@("`@
M("`@("`@("`@("`@(#$Q,2`@("XR-30P,#`P12TP-2`@("XR-3,Y.3DW12LP
M-2`@("XQ,#`P,#`P12TP-2`@("XY.3DY.3DP12LP-`H@("`N,C4T,#`P,$4K
M,#$@("`@("`@("`@("`@("`@("`Q,3$@("`N,C4T,#`P,$4M,#4@("`N,C<Y
M-#`P,$4K,#(@("`N,3`P,#`P,$4M,#4@("`N,3$P,#`P,$4K,#(*("`@+C(U
M-#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@,3$Q("`@+C(U,SDY.3=%*S`U
M("`@+C(U-#`P,#!%+3`U("`@+CDY.3DY.3!%*S`T("`@+C$P,#`P,#!%+3`U
M"B`@("XR-30P,#`P12LP,2`@("`@("`@("`@("`@("`@(#$Q,2`@("XR-3,Y
M.3DW12LP-2`@("XR-3,Y.3DW12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY
M.3DP12LP-`H@("`N,C4T,#`P,$4K,#$@("`@("`@("`@("`@("`@("`Q,3$@
M("`N,C4S.3DY-T4K,#4@("`N,C<Y-#`P,$4K,#(@("`N.3DY.3DY,$4K,#0@
M("`N,3$P,#`P,$4K,#(*("`@+C(U-#`P,#!%*S`Q("`@("`@("`@("`@("`@
M("`@,3$Q("`@+C(Q-3DP,#!%*S`R("`@+C(U-#`P,#!%+3`U("`@+C@U,#`P
M,#!%*S`Q("`@+C$P,#`P,#!%+3`U"B`@("XR-30P,#`P12LP,2`@("`@("`@
M("`@("`@("`@(#$Q,2`@("XR,34Y,#`P12LP,B`@("XR-3,Y.3DW12LP-2`@
M("XX-3`P,#`P12LP,2`@("XY.3DY.3DP12LP-`H@("`N,C4T,#`P,$4K,#$@
M("`@("`@("`@("`@("`@("`Q,3$@("`N,C$U.3`P,$4K,#(@("`N,C<Y-#`P
M,$4K,#(@("`N.#4P,#`P,$4K,#$@("`N,3$P,#`P,$4K,#(*("`@+C$P,#`P
M,#!%*S`Q("`@("`@("`@("`@("`@("`@,3$Q("`@+C$P,#`P,#!%+3`U("`@
M+C$P,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U"B`@
M("XR-30P,#`P12LP,2`@("`@("`@("`@("`@("`@(#$Q,2`@("XR-30P,#`P
M12TP-2`@("XR-3,Y.3DW12LP-2`@("XQ,#`P,#`P12TP-2`@("XY.3DY.3DP
M12LP-`H@("`N,C4T,#`P,$4K,#$@("`@("`@("`@("`@("`@("`Q,3$@("`N
M,C4T,#`P,$4M,#4@("`N,C<Y-#`P,$4K,#(@("`N,3`P,#`P,$4M,#4@("`N
M,3$P,#`P,$4K,#(*("`@+C(U-#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@
M,3$Q("`@+C(U,SDY.3=%*S`U("`@+C(U-#`P,#!%+3`U("`@+CDY.3DY.3!%
M*S`T("`@+C$P,#`P,#!%+3`U"B`@("XR-30P,#`P12LP,2`@("`@("`@("`@
M("`@("`@(#$Q,2`@("XR-3,Y.3DW12LP-2`@("XR-3,Y.3DW12LP-2`@("XY
M.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-`H@("`N,C4T,#`P,$4K,#$@("`@
M("`@("`@("`@("`@("`Q,3$@("`N,C4S.3DY-T4K,#4@("`N,C<Y-#`P,$4K
M,#(@("`N.3DY.3DY,$4K,#0@("`N,3$P,#`P,$4K,#(*("`@+C(U-#`P,#!%
M*S`Q("`@("`@("`@("`@("`@("`@,3$Q("`@+C(Q-3DP,#!%*S`R("`@+C(U
M-#`P,#!%+3`U("`@+C@U,#`P,#!%*S`Q("`@+C$P,#`P,#!%+3`U"B`@("XR
M-30P,#`P12LP,2`@("`@("`@("`@("`@("`@(#$Q,2`@("XR,34Y,#`P12LP
M,B`@("XR-3,Y.3DW12LP-2`@("XX-3`P,#`P12LP,2`@("XY.3DY.3DP12LP
M-`H@("`N,C4T,#`P,$4K,#$@("`@("`@("`@("`@("`@("`Q,3$@("`N,C$U
M.3`P,$4K,#(@("`N,C<Y-#`P,$4K,#(@("`N.#4P,#`P,$4K,#$@("`N,3$P
),#`P,$4K,#(*
`
end
STOP_CAT
echo "  Generating =====> [ ./page_unit.dat ]"
cat <<"STOP_CAT"> ././page_unit.uuu
begin 660 ./page_unit.dat
M("`@+C(U-#`P,#!%*S`Q24X@(`H@("`N,3`P,#`P,$4K,#%#32`@"B`@("XQ
M,#`P,#`P12LP,4-%3E0*("`@+C$P,#`P,#!%*S`P34T@(`H@("`N,3`P,#`P
*,$4K,#!-24Q,"D-%
`
end
STOP_CAT
echo "  Generating =====> [ ./page_unitcust.dat ]"
cat <<"STOP_CAT"> ././page_unitcust.uuu
begin 660 ./page_unitcust.dat
M("`@+C$P,#`P,#!%+3,U("`@+C$P,#`P,#!%+3,U"B`@("XY.3DY.3DP12LP
1-"`@("XY.3DY.3DP12LP-`H@
`
end
STOP_CAT
echo "  Generating =====> [ ./prl1.f ]"
cat <<"STOP_CAT"> ././prl1.f
C     PROGRAM PRL1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PRL_LIBVER
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      INTRINSIC INDEX,LEN
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       POSIX object access programs
      EXTERNAL POSIX_INIT
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C     ------------------------------------------------------------------
C
      PARAMETER (MAXVER=9)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERSQ(MAXVER)
      CHARACTER*80 STRING
C
C                       Required PRL version number (update DATA value
C                       when program updated to new version of library)
      DATA VERSQ /'0.7     ',
     2            '0.6     ',
     3            '0.6.10  ',
     4            '0.7.1   ',
     5            '0.8     ',
     6            '0.8.1   ',
     9            '1.6     ',
     7            '1.7     ',
     8            '1.8     '/
C
C     ******************************************************************
C
C                       STEP 1 - Initialize library
C
      CALL POSIX_INIT (0)
C
C     ******************************************************************
C
C                       Write demo program introduction message
C
C                       Write intro message
C                       (use * for logical unit since TERM_SETSIO will
C                       not be called in this demo)
      WRITE (*,401)
  401 FORMAT (
     * '                   PRL "PRL1" Object Demo Program'//
     * ' PRL_LIBVER should be used to check the version of the'/
     * ' Programmer''s Reusable Library being used and print the'/
     * ' following types of WARNING or ERROR messages if the'/
     * ' version is not correct.')
C
C     ******************************************************************
C
C                       STEP 2 - Check PRL version
C
C                       Loop for each test case
      DO 200 IVER=1,MAXVER
C
C                       Get actual PRL version being used
C                       but do not perform check
      CALL PRL_LIBVER (VERAQ,' ')
C
C                       Compare actual & required major release numbers
      LOCAQ = INDEX (VERAQ,'.')
      LOCRQ = INDEX (VERSQ(IVER),'.')
      LENAQ = LEN (VERAQ)
      LENRQ = LEN (VERSQ(IVER))
      IF (VERAQ(1:LOCAQ) .NE. VERSQ(IVER)(1:LOCRQ)) THEN
        WRITE (*,213) VERAQ,VERSQ(IVER)
  213   FORMAT (/
     *  ' SAMPLE MESSAGE FOR INCORRECT LIBRARY VERSION:'/
     *  ' ERROR: Incompatible version of Programmer''s Reusable Library'
     *  /' Program is using version ',A,'but requires version ',A)
        GOTO 200
C
C                       Compare actual & reqd secondary release numbers
      ELSE IF (VERAQ(LOCAQ+1:LENAQ) .LT.
     *         VERSQ(IVER)(LOCRQ+1:LENRQ)) THEN
        WRITE (*,223) VERAQ,VERSQ(IVER)
  223   FORMAT (/
     *   ' SAMPLE MESSAGE FOR OUT-OF-DATE LIBRARY VERSION:'/
     *   ' WARNING: Old version of Programmer''s Reusable Library'/
     *   ' Program is using version ',A,'but requires version ',A)
C                       Print message for acceptable version
      ELSE
        WRITE (*,233) VERAQ,VERSQ(IVER)
  233   FORMAT (/
     *   ' NO MESSAGE PRINTED WHEN LIBRARY VERSION IS ACCEPTABLE:'/
     *   ' (Program is using version ',A,'and requires version ',A,' )')
      ENDIF
  200 CONTINUE
C
C     ******************************************************************
C
C                       STEP 5 - Terminate program execution
C                       Wait until user presses a key before exiting
C
      WRITE (*,810)
  810 FORMAT (/
     * '                 Demo Program PRL1 Execution Completed'/
     * '                         Press <CR> to exit demo')
      READ (*,811) STRING
  811 FORMAT (A)
C                       Exit demo
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./process1.f ]"
cat <<"STOP_CAT"> ././process1.f
C     PROGRAM PROCESS1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program PROCESS_EXIT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       POSIX object access programs
      EXTERNAL POSIX_INIT
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C     ------------------------------------------------------------------
C
      CHARACTER*80 STRING
C
C     ******************************************************************
C
C                       STEP 1 - Initialize library
C
      CALL POSIX_INIT (0)
C
C     ******************************************************************
C
C                       Write demo program introduction message
C
C                       Write intro message
C                       (use * for logical unit since TERM_SETSIO will
C                       not be called in this demo)
      WRITE (*,401)
  401 FORMAT (
     * '                PRL-POSIX "PROCESS" Object Demo Program #1'//
     * ' PROCESS_EXIT may be used to terminate execution of programs'/
     * ' that use the PRL-POSIX library.  PROCESS_EXIT will be used'/
     * ' to exit from this demo after you press the Carriage Return'/
     * ' or Enter key <CR>.')
C
C     ******************************************************************
C
C                       STEP 5 - Terminate program execution
C                       Wait until user presses a key before exiting
C
      WRITE (*,810)
  810 FORMAT (/
     * '                 Demo Program PROCESS1 Execution Completed'/
     * '                         Press <CR> to exit demo')
      READ (*,811) STRING
  811 FORMAT (A)
C                       Exit demo
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./real1.f ]"
cat <<"STOP_CAT"> ././real1.f
C     PROGRAM REAL1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program REAL_PDRAWR
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       REAL object access program
      EXTERNAL REAL_PDRAWR
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL TEXT2D_SETHT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV102 =  6)
      PARAMETER (NVV103 =  1)
      PARAMETER (NVV104 =  1)
      PARAMETER (NVV105 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER IPLACE, TMP102, LREL, TMP105
C
C                       Real variables and arrays
      REAL    ANUM, TMP101, XPOSP2, TMP103, YPOSP2, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      INTEGER VV102(NVV102)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
      INTEGER VV105(NVV105)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-9.876543E-03/
C
      DATA VV102 /1, 7, 101, 107, -1, -7/
C
      DATA VV103 /1.0/
C
      DATA VV104 /2.0/
C
      DATA VV105 /0, 1, 2, 3/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'realnum_pdrawr.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              REAL Object Demo Program #1'/
     * ' This program tests the REAL object access program'/
     * ' REAL_PDRAWR.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test REAL_PDRAWR object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        ANUM = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        IPLACE = VV102(IVV102)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL TEXT2D_SETHT (0.25)
C
      DO 587 IVV103 = 1,NVV103
        XPOSP2 = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        YPOSP2 = VV104(IVV104)
C
      DO 585 IVV105 = 1,NVV105
        LREL = VV105(IVV105)
C
C                       Draw real number relative to current location or
C                       origin in page units
      CALL REAL_PDRAWR (ANUM,IPLACE,XPOSP2,YPOSP2,LREL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ANUM,IPLACE,XPOSP2,YPOSP2,LREL
  502 FORMAT (E15.7,I21,E15.7,E15.7,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  585 CONTINUE
  586 CONTINUE
  587 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
  588 CONTINUE
  589 CONTINUE
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              REAL Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./real2.f ]"
cat <<"STOP_CAT"> ././real2.f
C     PROGRAM REAL2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program REAL_PDRAW
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       REAL object access program
      EXTERNAL REAL_PDRAW
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL TEXT2D_SETHT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  3)
      PARAMETER (NVV102 =  6)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER IPLACE, TMP102
C
C                       Real variables and arrays
      REAL    ANUM, TMP101, XPOSP2, TMP103, YPOSP2, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      INTEGER VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /-3333.33, 0.0, 9999.99/
C
      DATA VV102 /1, 7, 101, 107, -7, -1/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'realnum_pdraw.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              REAL Object Demo Program #2'/
     * ' This program tests the REAL object access program'/
     * ' REAL_PDRAW.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test REAL_PDRAW object access program
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        ANUM = VV101(IVV101)
C
        XPOSP2 = 5.
        YPOSP2 = 1.
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL TEXT2D_SETHT (0.25)
C
      DO 588 IVV102 = 1,NVV102
        IPLACE = VV102(IVV102)
C
        YPOSP2 = YPOSP2+1.
C
C                       Draw real number relative to origin in page
C                       units
      CALL REAL_PDRAW (ANUM,IPLACE,XPOSP2,YPOSP2)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) ANUM,IPLACE,XPOSP2,YPOSP2
  502 FORMAT (E15.7,I21,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
  589 CONTINUE
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              REAL Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./realnum_pdraw.dat ]"
cat <<"STOP_CAT"> ././realnum_pdraw.uuu
begin 660 ./realnum_pdraw.dat
M("`M+C,S,S,S,S!%*S`T("`@("`@("`@("`@("`@("`@("`Q("`@+C4P,#`P
M,#!%*S`Q("`@+C(P,#`P,#!%*S`Q"B`@+2XS,S,S,S,P12LP-"`@("`@("`@
M("`@("`@("`@("`@-R`@("XU,#`P,#`P12LP,2`@("XS,#`P,#`P12LP,0H@
M("TN,S,S,S,S,$4K,#0@("`@("`@("`@("`@("`@("`Q,#$@("`N-3`P,#`P
M,$4K,#$@("`N-#`P,#`P,$4K,#$*("`M+C,S,S,S,S!%*S`T("`@("`@("`@
M("`@("`@("`@,3`W("`@+C4P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q"B`@
M+2XS,S,S,S,P12LP-"`@("`@("`@("`@("`@("`@("`M-R`@("XU,#`P,#`P
M12LP,2`@("XV,#`P,#`P12LP,0H@("TN,S,S,S,S,$4K,#0@("`@("`@("`@
M("`@("`@("`@+3$@("`N-3`P,#`P,$4K,#$@("`N-S`P,#`P,$4K,#$*("`@
M+C`P,#`P,#!%*S`P("`@("`@("`@("`@("`@("`@("`Q("`@+C4P,#`P,#!%
M*S`Q("`@+C(P,#`P,#!%*S`Q"B`@("XP,#`P,#`P12LP,"`@("`@("`@("`@
M("`@("`@("`@-R`@("XU,#`P,#`P12LP,2`@("XS,#`P,#`P12LP,0H@("`N
M,#`P,#`P,$4K,#`@("`@("`@("`@("`@("`@("`Q,#$@("`N-3`P,#`P,$4K
M,#$@("`N-#`P,#`P,$4K,#$*("`@+C`P,#`P,#!%*S`P("`@("`@("`@("`@
M("`@("`@,3`W("`@+C4P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q"B`@("XP
M,#`P,#`P12LP,"`@("`@("`@("`@("`@("`@("`M-R`@("XU,#`P,#`P12LP
M,2`@("XV,#`P,#`P12LP,0H@("`N,#`P,#`P,$4K,#`@("`@("`@("`@("`@
M("`@("`@+3$@("`N-3`P,#`P,$4K,#$@("`N-S`P,#`P,$4K,#$*("`@+CDY
M.3DY.3!%*S`T("`@("`@("`@("`@("`@("`@("`Q("`@+C4P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q"B`@("XY.3DY.3DP12LP-"`@("`@("`@("`@("`@
M("`@("`@-R`@("XU,#`P,#`P12LP,2`@("XS,#`P,#`P12LP,0H@("`N.3DY
M.3DY,$4K,#0@("`@("`@("`@("`@("`@("`Q,#$@("`N-3`P,#`P,$4K,#$@
M("`N-#`P,#`P,$4K,#$*("`@+CDY.3DY.3!%*S`T("`@("`@("`@("`@("`@
M("`@,3`W("`@+C4P,#`P,#!%*S`Q("`@+C4P,#`P,#!%*S`Q"B`@("XY.3DY
M.3DP12LP-"`@("`@("`@("`@("`@("`@("`M-R`@("XU,#`P,#`P12LP,2`@
M("XV,#`P,#`P12LP,0H@("`N.3DY.3DY,$4K,#0@("`@("`@("`@("`@("`@
D("`@+3$@("`N-3`P,#`P,$4K,#$@("`N-S`P,#`P,$4K,#$*
`
end
STOP_CAT
echo "  Generating =====> [ ./realnum_pdrawr.dat ]"
cat <<"STOP_CAT"> ././realnum_pdrawr.uuu
begin 660 ./realnum_pdrawr.dat
M("`M+CDX-S8U-#-%+3`R("`@("`@("`@("`@("`@("`@("`Q("`@+C$P,#`P
M,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@("`P"B`@
M+2XY.#<V-30S12TP,B`@("`@("`@("`@("`@("`@("`@,2`@("XQ,#`P,#`P
M12LP,2`@("XR,#`P,#`P12LP,2`@("`@("`@("`@("`@("`@("`@,0H@("TN
M.3@W-C4T,T4M,#(@("`@("`@("`@("`@("`@("`@(#$@("`N,3`P,#`P,$4K
M,#$@("`N,C`P,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#(*("`M+CDX
M-S8U-#-%+3`R("`@("`@("`@("`@("`@("`@("`Q("`@+C$P,#`P,#!%*S`Q
M("`@+C(P,#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@("`S"B`@+2XY.#<V
M-30S12TP,B`@("`@("`@("`@("`@("`@("`@-R`@("XQ,#`P,#`P12LP,2`@
M("XR,#`P,#`P12LP,2`@("`@("`@("`@("`@("`@("`@,`H@("TN.3@W-C4T
M,T4M,#(@("`@("`@("`@("`@("`@("`@(#<@("`N,3`P,#`P,$4K,#$@("`N
M,C`P,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#$*("`M+CDX-S8U-#-%
M+3`R("`@("`@("`@("`@("`@("`@("`W("`@+C$P,#`P,#!%*S`Q("`@+C(P
M,#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@("`R"B`@+2XY.#<V-30S12TP
M,B`@("`@("`@("`@("`@("`@("`@-R`@("XQ,#`P,#`P12LP,2`@("XR,#`P
M,#`P12LP,2`@("`@("`@("`@("`@("`@("`@,PH@("TN.3@W-C4T,T4M,#(@
M("`@("`@("`@("`@("`@("`Q,#$@("`N,3`P,#`P,$4K,#$@("`N,C`P,#`P
M,$4K,#$@("`@("`@("`@("`@("`@("`@(#`*("`M+CDX-S8U-#-%+3`R("`@
M("`@("`@("`@("`@("`@,3`Q("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%
M*S`Q("`@("`@("`@("`@("`@("`@("`Q"B`@+2XY.#<V-30S12TP,B`@("`@
M("`@("`@("`@("`@(#$P,2`@("XQ,#`P,#`P12LP,2`@("XR,#`P,#`P12LP
M,2`@("`@("`@("`@("`@("`@("`@,@H@("TN.3@W-C4T,T4M,#(@("`@("`@
M("`@("`@("`@("`Q,#$@("`N,3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@
M("`@("`@("`@("`@("`@("`@(#,*("`M+CDX-S8U-#-%+3`R("`@("`@("`@
M("`@("`@("`@,3`W("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@
M("`@("`@("`@("`@("`@("`P"B`@+2XY.#<V-30S12TP,B`@("`@("`@("`@
M("`@("`@(#$P-R`@("XQ,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("`@
M("`@("`@("`@("`@("`@,0H@("TN.3@W-C4T,T4M,#(@("`@("`@("`@("`@
M("`@("`Q,#<@("`N,3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`@("`@
M("`@("`@("`@("`@(#(*("`M+CDX-S8U-#-%+3`R("`@("`@("`@("`@("`@
M("`@,3`W("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@("`@("`@
M("`@("`@("`@("`S"B`@+2XY.#<V-30S12TP,B`@("`@("`@("`@("`@("`@
M("`M,2`@("XQ,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("`@("`@("`@
M("`@("`@("`@,`H@("TN.3@W-C4T,T4M,#(@("`@("`@("`@("`@("`@("`@
M+3$@("`N,3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`@("`@("`@("`@
M("`@("`@(#$*("`M+CDX-S8U-#-%+3`R("`@("`@("`@("`@("`@("`@("TQ
M("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@("`@("`@("`@("`@
M("`@("`R"B`@+2XY.#<V-30S12TP,B`@("`@("`@("`@("`@("`@("`M,2`@
M("XQ,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("`@("`@("`@("`@("`@
M("`@,PH@("TN.3@W-C4T,T4M,#(@("`@("`@("`@("`@("`@("`@+3<@("`N
M,3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@
M(#`*("`M+CDX-S8U-#-%+3`R("`@("`@("`@("`@("`@("`@("TW("`@+C$P
M,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@("`@("`@("`@("`@("`@("`Q
M"B`@+2XY.#<V-30S12TP,B`@("`@("`@("`@("`@("`@("`M-R`@("XQ,#`P
M,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("`@("`@("`@("`@("`@("`@,@H@
M("TN.3@W-C4T,T4M,#(@("`@("`@("`@("`@("`@("`@+3<@("`N,3`P,#`P
J,$4K,#$@("`N,C`P,#`P,$4K,#$@("`@("`@("`@("`@("`@("`@(#,*
`
end
STOP_CAT
echo "  Generating =====> [ ./skeleton.f ]"
cat <<"STOP_CAT"> ././skeleton.f
C     PROGRAM SKELETON
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate use of PRL-GRAPHICS library
C
C     LOCAL VARIABLES:
C
C
C     NOTES:
C       1. This is a program skeleton that may be used for development
C          of any program that uses the PRL-GRAPHICS library.  Customize
C          to your needs by retaining desired lines.
C
C       2. Steps 1 through 2 must be performed first in sequence, and
C          step 11 must be performed last.  Other steps may be mixed
C          as necessary.
C
C     ******************************************************************
C
C     INTRINSIC
C
C                       BLNKAREA object access programs
      EXTERNAL BLNKAREA_DEF, BLNKAREA_DEF1, BLNKAREA_DEF2, BLNKAREA_DEF3
     *        , BLNKAREA_DEF4, BLNKAREA_DEFR
C
C                       COLOR object access programs
      EXTERNAL COLOR_DEFHSI, COLOR_DEFRGB, COLOR_SETNAM, COLOR_SETNUM
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_END, DEVICE_SELECT
C
C                       FONT object access programs
      EXTERNAL FONT_ALPHA, FONT_ALPHA1, FONT_ALPHA2, FONT_ALPHA3
     *        , FONT_ALPHA4, FONT_ALPHA5, FONT_ALPHA6, FONT_ALPHAB
     *        , FONT_CARTOG, FONT_CLASIC, FONT_CMPLX2, FONT_COMPLX
     *        , FONT_DUPLEX, FONT_GOTHIC, FONT_ROMANB, FONT_ROMANL
     *        , FONT_SETPAT, FONT_SIMPLX, FONT_STYLEX, FONT_TRIPLX
C
C                       FRAME object access programs
      EXTERNAL FRAME_DRAW, FRAME_OFF, FRAME_THICK
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT, GRAPHICS_RESET
C
C                       HEADING object access programs
      EXTERNAL HEADING_DRAW
C
C                       INT object access programs
      EXTERNAL INT_PDRAWR, INT_PDRAW
C
C                       LINE2D object access programs
      EXTERNAL LINE2D_CHNDOT, LINE2D_CHNDSH, LINE2D_CUSTOM, LINE2D_DASH
     *        , LINE2D_DOT, LINE2D_DRAW, LINE2D_DRAWR, LINE2D_THICK
C
C                       LOGPEN2 object access programs
      EXTERNAL LOGPEN2_GETP, LOGPEN2_SETP, LOGPEN2_SETR
C
C                       MARGIN object access programs
      EXTERNAL MARGIN_SET
C
C                       MARKER object access programs
      EXTERNAL MARKER_BLANK, MARKER_DEFCUST, MARKER_DRAWCUST, MARKER_GET
     *        , MARKER_SHAPE, MARKER_SIZE
C
C                       ORIGIN object access programs
      EXTERNAL ORIGIN_MOVE, ORIGIN_SET
C
C                       PAGE object access programs
      EXTERNAL PAGE_END, PAGE_ORIENT, PAGE_SCALE, PAGE_SIZE, PAGE_UNIT
     *        , PAGE_UNITCUST
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       REAL object access programs
      EXTERNAL REAL_PDRAWR, REAL_PDRAW
C
C                       SUBPLOT object access programs
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END, SUBPLOT_MAGNIFY
     *        , SUBPLOT_ROTATE, SUBPLOT_SCALE, SUBPLOT_SHIFT
C
C                       TEXT2D object access programs
      EXTERNAL TEXT2D_GETLEN, TEXT2D_PDRAW, TEXT2D_PDRAWR, TEXT2D_ROTATE
     *        , TEXT2D_SETERM, TEXT2D_SETHT
      REAL TEXT2D_GETLEN
C
C     ------------------------------------------------------------------
C
C                       Maximum array sizes
      PARAMETER (MX101 = 1)
      PARAMETER (MX102 = 1)
      PARAMETER (MX103 = 1)
C
C                       Integer variables and arrays
      INTEGER IVAL, IFRAME, LREL, ICOLOR, IERR, KTYPQ, NANGLE, NGAP
     *        , ISCOPE, LSTRNG, NLINES, NMRKSP, NPBSYM, ISYMU, NSY, ISYM
     *        , ISPARE, IPLACE, IMESS, LENGTH
C
C                       Real variables and arrays
      REAL XPOS1, XPOS2, YPOS1, YPOS2, FRM, HUE, SAT, AINT, RED, GRN
     *        , BLU, XCURR, YCURR, ANUM, XORG, YORG, WIDE, HIGH, XPAGE
     *        , YPAGE, ANGARR, GAPARR, THKNES, HTMULT, XPOSP2, YPOSP2
     *        , TLENG, RATRAY(MX101), THICK, GRACEM, XSY(MX102)
     *        , YSY(MX103), FAC, XOREL, YOREL, XOABS, YOABS, PAGEX
     *        , PAGEY, SCALE, AX, AY, XYFAC, ANGLE, XSCALE, YSCALE
     *        , XTRAN, YTRAN, HITE
      REAL RRETRN
C
C                       Double precision variables and arrays
C     DOUBLE PRECISION
C
C                       Complex variables and arrays
C     COMPLEX
C
C                       Logical variables and arrays
C     LOGICAL
C
C                       Character variables and arrays
      CHARACTER ORIENT*4, OSCAL*4, VERAQ*8, LMESS*160, COLORN*4
     *        , LALPHA*5, LCHAR*1, PARAM*6, LHEAD*64, CSCAL*4, VERRQ*8
     *        , TSTRM*4
C
C                       Program required PRL version (update DATA value
C                       when program updated to new version of library)
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       STEP 1  - Initialize the library
C
C     ------------------------------------------------------------------
C
C                       Use GRAPHICS_INIT object access program
C
C                       Initialize the PRL-GRAPHICS library
C     ISCOPE =
      CALL GRAPHICS_INIT (ISCOPE)
C
C     ******************************************************************
C
C                       STEP 2  - Check the Programmer's Reusable
C                       Library version
C
C     ------------------------------------------------------------------
C
C                       Use PRL_LIBVER object access program
C
C                       Return the version of the Programmer's Reusable
C                       Librar
C     VERRQ =
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       STEP 3  - Use PRL-DEVICE to initialize a
C                       graphics device
C
C     ------------------------------------------------------------------
C
C                       Use DEVICE_SELECT object access program
C
C                       Non-interactively select a graphics output
C                       device
C     KTYPQ =
      CALL DEVICE_SELECT (KTYPQ,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       STEP 4  - Define plotting page
C
C     ------------------------------------------------------------------
C
C                       Use PAGE_ORIENT object access program
C
C                       Specify page orientation
C     ORIENT =
      CALL PAGE_ORIENT (ORIENT)
C
C     ------------------------------------------------------------------
C
C                       Use PAGE_SCALE object access program
C
C                       Set plot scaling behavior for page size that
C                       exceeds device size
C     OSCAL =
      CALL PAGE_SCALE (OSCAL)
C
C     ------------------------------------------------------------------
C
C                       Use PAGE_UNIT object access program
C
C                       Set page units to one of several standard units
C     CSCAL =
      CALL PAGE_UNIT (CSCAL)
C
C     ------------------------------------------------------------------
C
C                       Use PAGE_UNITCUST object access program
C
C                       Set custom page units
C     SCALE =
      CALL PAGE_UNITCUST (SCALE)
C
C     ------------------------------------------------------------------
C
C                       Use PAGE_SIZE object access program
C
C                       Set page size for plot
C     PAGEX =
C     PAGEY =
      CALL PAGE_SIZE (PAGEX,PAGEY)
C
C     ******************************************************************
C
C                       STEP 5  - Set origin location and and subplot
C                       properties
C
C     ------------------------------------------------------------------
C
C                       Use ORIGIN object access programs
C
C                       Move origin relative to current origin location
C     XOREL =
C     YOREL =
      CALL ORIGIN_MOVE (XOREL,YOREL)
C
C                       Set location of origin relative to lower left
C                       corner of page
C     XOABS =
C     YOABS =
      CALL ORIGIN_SET (XOABS,YOABS)
C
C     ------------------------------------------------------------------
C
C                       Use SUBPLOT_MAGNIFY object access program
C
C                       Set subplot uniform scale factor
C     XYFAC =
      CALL SUBPLOT_MAGNIFY (XYFAC)
C
C     ------------------------------------------------------------------
C
C                       Use SUBPLOT_SCALE object access program
C
C                       Set subplot X and Y scale factors
C     XSCALE =
C     YSCALE =
      CALL SUBPLOT_SCALE (XSCALE,YSCALE)
C
C     ------------------------------------------------------------------
C
C                       Use SUBPLOT_ROTATE object access program
C
C                       Set subplot rotation angle
C     ANGLE =
      CALL SUBPLOT_ROTATE (ANGLE)
C
C     ------------------------------------------------------------------
C
C                       Use SUBPLOT_SHIFT object access program
C
C                       Set subplot X and Y translation distances
C     XTRAN =
C     YTRAN =
      CALL SUBPLOT_SHIFT (XTRAN,YTRAN)
C
C     ------------------------------------------------------------------
C
C                       Use FRAME_OFF object access program
C
C                       Disable drawing of frame around clipping
C                       boundary during subplot definition
      CALL FRAME_OFF ()
C
C     ******************************************************************
C
C                       STEP 6  - Define subplot area
C
C     ------------------------------------------------------------------
C
C                       Use SUBPLOT_DEFINE object access program
C
C                       Define subplot area
C     AX =
C     AY =
      CALL SUBPLOT_DEFINE (AX,AY)
C
C     ******************************************************************
C
C                       STEP 7  - Invoke other library objects as needed
C                       to draw plot
C
C     ------------------------------------------------------------------
C
C                       Use BLNKAREA object access programs
C
C                       Define and activate fifth and higher blank areas
C                       relative to origin
C     XORG =
C     YORG =
C     WIDE =
C     HIGH =
C     FRM =
      CALL BLNKAREA_DEF (XORG,YORG,WIDE,HIGH,FRM)
C
C                       Define and activate first blank area
C     XPOS1 =
C     XPOS2 =
C     YPOS1 =
C     YPOS2 =
C     IFRAME =
      CALL BLNKAREA_DEF1 (XPOS1,XPOS2,YPOS1,YPOS2,IFRAME)
C
C                       Define and activate second blank area
C     XPOS1 =
C     XPOS2 =
C     YPOS1 =
C     YPOS2 =
C     IFRAME =
      CALL BLNKAREA_DEF2 (XPOS1,XPOS2,YPOS1,YPOS2,IFRAME)
C
C                       Define and activate third blank area
C     XPOS1 =
C     XPOS2 =
C     YPOS1 =
C     YPOS2 =
C     IFRAME =
      CALL BLNKAREA_DEF3 (XPOS1,XPOS2,YPOS1,YPOS2,IFRAME)
C
C                       Define and activate fourth blank area
C     XPOS1 =
C     XPOS2 =
C     YPOS1 =
C     YPOS2 =
C     IFRAME =
      CALL BLNKAREA_DEF4 (XPOS1,XPOS2,YPOS1,YPOS2,IFRAME)
C
C                       Define and activate blank areas 5+ relative to
C                       current location or origin
C     XORG =
C     YORG =
C     WIDE =
C     HIGH =
C     FRM =
C     LREL =
      CALL BLNKAREA_DEFR (XORG,YORG,WIDE,HIGH,FRM,LREL)
C
C     ------------------------------------------------------------------
C
C                       Use COLOR object access programs
C
C                       Define a new drawing color using the HSI color
C                       model
C     ICOLOR =
C     HUE =
C     SAT =
C     AINT =
      CALL COLOR_DEFHSI (ICOLOR,HUE,SAT,AINT,IERR)
C
C                       Define a new drawing color using the RGB color
C                       model
C     ICOLOR =
C     RED =
C     GRN =
C     BLU =
      CALL COLOR_DEFRGB (ICOLOR,RED,GRN,BLU,IERR)
C
C                       Select current drawing color using color name
C     COLORN =
      CALL COLOR_SETNAM (COLORN)
C
C                       Select current drawing color using color number
C     ICOLOR =
      CALL COLOR_SETNUM (ICOLOR,IERR)
C
C     ------------------------------------------------------------------
C
C                       Use LOGPEN2 object access programs
C
C                       Get coordinates of logical pen in page units
      CALL LOGPEN2_GETP (XPOSP2,YPOSP2)
C
C                       Set coordinates of logical pen relative to
C                       origin
C     XPOSP2 =
C     YPOSP2 =
C     NPBSYM =
      CALL LOGPEN2_SETP (XPOSP2,YPOSP2,NPBSYM)
C
C                       Set coordinates of logical pen relative to
C                       current location or origin
C     XPOSP2 =
C     YPOSP2 =
C     NPBSYM =
C     LREL =
      CALL LOGPEN2_SETR (XPOSP2,YPOSP2,NPBSYM,LREL)
C
C     ------------------------------------------------------------------
C
C                       Use FONT object access programs
C
C                       Specify first (default) active alphabet set
C     LALPHA =
      CALL FONT_ALPHA (LALPHA)
C
C                       Specify first active alphabet set
C     LALPHA =
C     LCHAR =
      CALL FONT_ALPHA1 (LALPHA,LCHAR)
C
C                       Specify second active alphabet set
C     LALPHA =
C     LCHAR =
      CALL FONT_ALPHA2 (LALPHA,LCHAR)
C
C                       Specify third active alphabet set
C     LALPHA =
C     LCHAR =
      CALL FONT_ALPHA3 (LALPHA,LCHAR)
C
C                       Specify fourth active alphabet set
C     LALPHA =
C     LCHAR =
      CALL FONT_ALPHA4 (LALPHA,LCHAR)
C
C                       Specify fifth active alphabet set
C     LALPHA =
C     LCHAR =
      CALL FONT_ALPHA5 (LALPHA,LCHAR)
C
C                       Specify sixth active alphabet set
C     LALPHA =
C     LCHAR =
      CALL FONT_ALPHA6 (LALPHA,LCHAR)
C
C                       Specify second active alphabet set
C     LALPHA =
      CALL FONT_ALPHAB (LALPHA)
C
C                       Set current text style to cartographic
      CALL FONT_CARTOG ()
C
C                       Set current text style to classic
      CALL FONT_CLASIC ()
C
C                       Set current text style to complex2
      CALL FONT_CMPLX2 ()
C
C                       Set current text style to complex
      CALL FONT_COMPLX ()
C
C                       Set current text style to duplex
      CALL FONT_DUPLEX ()
C
C                       Set current text style to gothic
      CALL FONT_GOTHIC ()
C
C                       Set current text style to romanb
      CALL FONT_ROMANB ()
C
C                       Set current text style to romanl
      CALL FONT_ROMANL ()
C
C                       Define text string fill pattern
C     ANGARR =
C     NANGLE =
C     GAPARR =
C     NGAP =
      CALL FONT_SETPAT (ANGARR,NANGLE,GAPARR,NGAP)
C
C                       Set current text style to simplex
      CALL FONT_SIMPLX ()
C
C                       Set current text style to stylex
      CALL FONT_STYLEX ()
C
C                       Set current text style to triplex
      CALL FONT_TRIPLX ()
C
C     ------------------------------------------------------------------
C
C                       Use FRAME_THICK object access program
C
C                       Set subplot area frame thickness
C     THKNES =
      CALL FRAME_THICK (THKNES)
C
C     ------------------------------------------------------------------
C
C                       Use FRAME_DRAW object access program
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW ()
C
C     ------------------------------------------------------------------
C
C                       Use GRAPHICS_RESET object access program
C
C                       Reset graphics objects to default state
C     PARAM =
      CALL GRAPHICS_RESET (PARAM)
C
C     ------------------------------------------------------------------
C
C                       Use HEADING object access programs
C
C                       Draw heading of one to four lines above subplot
C                       area
C     LHEAD =
C     LSTRNG =
C     HTMULT =
C     NLINES =
      CALL HEADING_DRAW (LHEAD,LSTRNG,HTMULT,NLINES)
C
C     ------------------------------------------------------------------
C
C                       Use INT object access programs
C
C                       Draw integer number relative to current location
C                       or origin in page units
C     IVAL =
C     XPOSP2 =
C     YPOSP2 =
C     LREL =
      CALL INT_PDRAWR (IVAL,XPOSP2,YPOSP2,LREL)
C
C                       Draw integer number relative to origin in page
C                       units
C     IVAL =
C     XPOSP2 =
C     YPOSP2 =
      CALL INT_PDRAW (IVAL,XPOSP2,YPOSP2)
C
C     ------------------------------------------------------------------
C
C                       Use LINE2D object access programs
C
C                       Set line style to chain-dot
      CALL LINE2D_CHNDOT ()
C
C                       Set line style to chain-dash
      CALL LINE2D_CHNDSH ()
C
C                       Define custom line style
C     TLENG =
C     NMRKSP =
C     RATRAY(1) =
      CALL LINE2D_CUSTOM (TLENG,NMRKSP,RATRAY)
C
C                       Set line style to dash
      CALL LINE2D_DASH ()
C
C                       Set line style to dot
      CALL LINE2D_DOT ()
C
C                       Draw straight line relative to origin
C     XPOSP2 =
C     YPOSP2 =
C     NPBSYM =
      CALL LINE2D_DRAW (XPOSP2,YPOSP2,NPBSYM)
C
C                       Draw straight line relative to current location
C                       or origin
C     XPOSP2 =
C     YPOSP2 =
C     NPBSYM =
C     LREL =
      CALL LINE2D_DRAWR (XPOSP2,YPOSP2,NPBSYM,LREL)
C
C                       Set line thickness
C     THICK =
      CALL LINE2D_THICK (THICK)
C
C     ------------------------------------------------------------------
C
C                       Use MARGIN object access programs
C
C                       Expand or contract grace margin around clipping
C                       border
C     GRACEM =
      CALL MARGIN_SET (GRACEM)
C
C     ------------------------------------------------------------------
C
C                       Use MARKER object access programs
C
C                       Enable marker area blanking
      CALL MARKER_BLANK ()
C
C                       Define custom marker shape
C     ISYMU =
      CALL MARKER_DEFCUST (ISYMU)
C
C                       Draw custom marker symbol
C     XSY(1) =
C     YSY(1) =
C     NSY =
      CALL MARKER_DRAWCUST (XSY,YSY,NSY)
C
C                       Get location of current marker
      CALL MARKER_GET (XPOSP2,YPOSP2)
C
C                       Set current marker symbol shape
C     ISYM =
      CALL MARKER_SHAPE (ISYM)
C
C                       Set marker size factor
C     FAC =
      CALL MARKER_SIZE (FAC)
C
C     ------------------------------------------------------------------
C
C                       Use REAL object access programs
C
C                       Draw real number relative to current location or
C                       origin in page units
C     ANUM =
C     IPLACE =
C     XPOSP2 =
C     YPOSP2 =
C     LREL =
      CALL REAL_PDRAWR (ANUM,IPLACE,XPOSP2,YPOSP2,LREL)
C
C                       Draw real number relative to origin in page
C                       units
C     ANUM =
C     IPLACE =
C     XPOSP2 =
C     YPOSP2 =
      CALL REAL_PDRAW (ANUM,IPLACE,XPOSP2,YPOSP2)
C
C     ------------------------------------------------------------------
C
C                       Use TEXT2D object access programs
C
C                       Get length of text string
C     LMESS =
C     IMESS =
      RRETRN = TEXT2D_GETLEN (LMESS,IMESS)
C
C                       Draw text string relative to origin in page
C                       units
C     LMESS =
C     IMESS =
C     XPOSP2 =
C     YPOSP2 =
      CALL TEXT2D_PDRAW (LMESS,IMESS,XPOSP2,YPOSP2)
C
C                       Draw text string relative to current location or
C                       origin in page units
C     LMESS =
C     IMESS =
C     XPOSP2 =
C     YPOSP2 =
C     LREL =
      CALL TEXT2D_PDRAWR (LMESS,IMESS,XPOSP2,YPOSP2,LREL)
C
C                       Set text string rotation angle
C     ANGLE =
      CALL TEXT2D_ROTATE (ANGLE)
C
C                       Set text string terminator
C     TSTRM =
C     LENGTH =
      CALL TEXT2D_SETERM (TSTRM,LENGTH)
C
C                       Set text string height
C     HITE =
      CALL TEXT2D_SETHT (HITE)
C
C     ******************************************************************
C
C                       STEP 8  - End the subplot
C
C     ------------------------------------------------------------------
C
C                       Use SUBPLOT_END object access program
C
C                       End current subplot
C     ISPARE =
      CALL SUBPLOT_END (ISPARE)
C
C     ******************************************************************
C
C                       STEP 9  - End plotting on the page
C
C     ------------------------------------------------------------------
C
C                       Use PAGE_END object access program
C
C                       End plotting on current page
C     ISPARE =
      CALL PAGE_END (ISPARE)
C
C     ******************************************************************
C
C                       STEP 10 - Use PRL-DEVICE to release graphics
C                       device
C
C     ------------------------------------------------------------------
C
C                       Use DEVICE_END object access program
C
C                       End plotting and release the current graphics
C                       device
      CALL DEVICE_END ()
C
C     ******************************************************************
C
C                       STEP 11 - Use PRL-POSIX to terminate program
C                       execution
C
C     ------------------------------------------------------------------
C
C                       Use PROCESS_EXIT object access program
C
C                       Silently terminate process execution
      CALL PROCESS_EXIT ()
      END
STOP_CAT
echo "  Generating =====> [ ./subplot1.f ]"
cat <<"STOP_CAT"> ././subplot1.f
C     PROGRAM SUBPLOT1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program SUBPLOT_DEFINE and
C              SUBPLOT_END
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       SUBPLOT object access program
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV111 =  1)
      PARAMETER (NVV113 =  1)
      PARAMETER (NVV115 =  2)
      PARAMETER (NVV116 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'SUBPLOT.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, TMP103, TMP104, TMP105, TMP106, TMP107
     *      , TMP108, TMP109, TMP110, TMP111, TMP113, AX, TMP115, AY
     *      , TMP116
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV111(NVV111)
      REAL    VV113(NVV113)
      REAL    VV115(NVV115)
      REAL    VV116(NVV116)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV111 /-3333.33/
C
      DATA VV113 /9999.99/
C
      DATA VV115 /.000001, 9999.99/
C
      DATA VV116 /.000001, 9999.99/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'subplot_define.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              SUBPLOT Object Demo Program #1'/
     * ' This program tests the SUBPLOT object access program'/
     * ' SUBPLOT_DEFINE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates several blank view surfaces.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test SUBPLOT_DEFINE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV111 = 1,NVV111
        XT = VV111(IVV111)
C
      DO 588 IVV113 = 1,NVV113
        YT = VV113(IVV113)
C
      DO 587 IVV115 = 1,NVV115
        AX = VV115(IVV115)
C
      DO 586 IVV116 = 1,NVV116
        AY = VV116(IVV116)
C
C     ------------------------------------------------------------------
C
C                       Set up proper environment for access program
C                       under test
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C     ------------------------------------------------------------------
C
C                       Define subplot area
      CALL SUBPLOT_DEFINE (AX,AY)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=510) TMP101,TMP102,TMP103,TMP104,TMP105,
     *       TMP106,TMP107,TMP108,TMP109,TMP110,TMP111,TMP113,TMP115,
     *       TMP116
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(UUXAXS ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(UUYAXS ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZXAXS ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZYAXS ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZXLFT ,TMP105 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZXRGT ,TMP106 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZYBOT ,TMP107 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZYTOP ,TMP108 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZXAXR ,TMP109 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZYAXR ,TMP110 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(XT ,TMP111 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YT ,TMP113 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 523
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=512) UUXAXS,UUYAXS,ZZXAXS,ZZYAXS,ZZXLFT,ZZXRGT,
     *       ZZYBOT,ZZYTOP,ZZXAXR,ZZYAXR,XT,YT,AX,AY
  502 FORMAT (E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,E15.7,
     *       E15.7,E15.7,E15.7,E15.7,E15.7)
      GOTO 523
C                       Print file I/O error messages
  510 WRITE (IER,511) FILNAM
  511 FORMAT (' Error reading file ',A)
      GOTO 523
C
  512 WRITE (IER,513) FILNAM
  513 FORMAT (' Error writing file ',A)
C
  523 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END(0)
C
C     ------------------------------------------------------------------
C
C                       End plotting on current page
      CALL PAGE_END (0)
C
C     ------------------------------------------------------------------
C
C                       Repeat for next variable value
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              SUBPLOT Demo Program #1 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./subplot2.f ]"
cat <<"STOP_CAT"> ././subplot2.f
C     PROGRAM SUBPLOT2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program SUBPLOT_SHIFT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       SUBPLOT object access program
      EXTERNAL SUBPLOT_SHIFT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  3)
      PARAMETER (NVV104 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'SUBPLOT.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, XTRAN, TMP103, YTRAN, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /.000001, 9999.99, 0.0/
C
      DATA VV104 /.000001, 9999.99, 0.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'subplot_shift.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              SUBPLOT Object Demo Program #2'/
     * ' This program tests the SUBPLOT object access program'/
     * ' SUBPLOT_SHIFT.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates several blank view surfaces.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test SUBPLOT_SHIFT object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        XTRAN = VV103(IVV103)
C
      DO 588 IVV104 = 1,NVV104
        YTRAN = VV104(IVV104)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C                       Set subplot X and Y translation distances
      CALL SUBPLOT_SHIFT (XTRAN,YTRAN)
C
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XT ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YT ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) XT,YT,XTRAN,YTRAN
  502 FORMAT (E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  588 CONTINUE
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              SUBPLOT Demo Program #2 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./subplot3.f ]"
cat <<"STOP_CAT"> ././subplot3.f
C     PROGRAM SUBPLOT3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program SUBPLOT_MAGNIFY
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       SUBPLOT object access program
      EXTERNAL SUBPLOT_MAGNIFY
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV102 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'SUBPLOT.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, XYFAC, TMP102
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV102(NVV102)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV102 /.000001, 9999.99, 1.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'subplot_magnify.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              SUBPLOT Object Demo Program #3'/
     * ' This program tests the SUBPLOT object access program'/
     * ' SUBPLOT_MAGNIFY.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates several blank view surfaces.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test SUBPLOT_MAGNIFY object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV102 = 1,NVV102
        XYFAC = VV102(IVV102)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C                       Set subplot uniform scale factor
      CALL SUBPLOT_MAGNIFY (XYFAC)
C
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(BLOWXY ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) BLOWXY,XYFAC
  502 FORMAT (E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              SUBPLOT Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./subplot4.f ]"
cat <<"STOP_CAT"> ././subplot4.f
C     PROGRAM SUBPLOT4
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program SUBPLOT_ROTATE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       SUBPLOT object access program
      EXTERNAL SUBPLOT_ROTATE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  12)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'SUBPLOT.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, ANGLE, TMP103
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV103(NVV103)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /0.0, .001, 30., 45., 60., 85.,
     *            0.0,-.001,-30.,-45.,-60.,-85.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'subplot_rotate.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              SUBPLOT Object Demo Program #4'/
     * ' This program tests the SUBPLOT object access program'/
     * ' SUBPLOT_ROTATE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test SUBPLOT_ROTATE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        ANGLE = VV103(IVV103)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C                       Set subplot rotation angle
      CALL SUBPLOT_ROTATE (ANGLE)
C
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(RCOS ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(RSIN ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) RCOS,RSIN,ANGLE
  502 FORMAT (E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
 
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              SUBPLOT Demo Program #4 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./subplot5.f ]"
cat <<"STOP_CAT"> ././subplot5.f
C     PROGRAM SUBPLOT5
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program SUBPLOT_SCALE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       SUBPLOT object access program
      EXTERNAL SUBPLOT_SCALE
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  3)
      PARAMETER (NVV104 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'SUBPLOT.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, XSCALE, TMP103, YSCALE, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /.000001, 9999.99, 1.0/
C
      DATA VV104 /.000001, 9999.99, 1.0/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'subplot_scale.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              SUBPLOT Object Demo Program #5'/
     * ' This program tests the SUBPLOT object access program'/
     * ' SUBPLOT_SCALE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A//
     * ' This demo generates several blank view surfaces.'/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test SUBPLOT_SCALE object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        XSCALE = VV103(IVV103)
C
      DO 588 IVV104 = 1,NVV104
        YSCALE = VV104(IVV104)
C
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
C
C                       Set subplot X and Y scale factors
      CALL SUBPLOT_SCALE (XSCALE,YSCALE)
C
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(XS ,TMP101 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(YS ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) XS,YS,XSCALE,YSCALE
  502 FORMAT (E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C
C                       Repeat for next variable value
  588 CONTINUE
  589 CONTINUE
C
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              SUBPLOT Demo Program #5 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./subplot6.f ]"
cat <<"STOP_CAT"> ././subplot6.f
C     PROGRAM SUBPLOT6
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program SUBPLOT_SCALE,
C              SUBPLOT_SHIFT and SUBPLOT_ROTATE
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the plot package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA (ENTIRE PLOT)
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.25*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 2.0*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Set foreground color
      CALL COLOR_SETNAM ('FORE')
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of plot title in inches
      XX = TEXT2D_GETLEN
     *     ('SUBPLOT6 Demo: Plot Rotation & Translation$',100)
C                       Compute X coord of start of title in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      YY = -YPG*0.07
      CALL TEXT2D_PDRAW
     *     ('SUBPLOT6 Demo: Plot Rotation & Translation$',100,XX,YY)
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C                       (INDIVIDUAL PLOTS)
C
C                       Set plot scaling factors
      CALL SUBPLOT_SCALE (0.5,0.5)
C                       Set translation factors for 1st plot
      DO 10 I =1, 2
      IF ( I .EQ. 1 ) THEN
        CALL SUBPLOT_SHIFT (XRL,YPG*0.65)
C                       Set translation and rotation factors
C                       for 2nd plot
      ELSE
        CALL SUBPLOT_ROTATE (90.0)
        CALL SUBPLOT_SHIFT (XPG+XRL,0.0)
      ENDIF
C                       Set drawing color to green
      CALL COLOR_SETNAM ('GREE')
C                       Define subplot area in terms of length
C                       of X and Y axis in inches
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DRAW HEADING OVER SUBPLOT AREA
C
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE*1.3)
C                       Determine length of title in inches
      XX = TEXT2D_GETLEN ('Rotated & Translated Subplot$',100)
C                       Compute X coord of start of title in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW
     *     ('Rotated & Translated Subplot$',100,XX,-YPG*0.12)
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
  10  CONTINUE
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
C                       Exit
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./subplot_define.dat ]"
cat <<"STOP_CAT"> ././subplot_define.uuu
begin 660 ./subplot_define.dat
M("`@+C(U-#`P,#!%+3`U("`@+C(U-#`P,#!%+3`U("`@+C$V-#@T,#)%+3`U
M("`@+C$V-#@T,#)%+3`U("`@+C$T,38V.3!%*S`Q("`@+C$T,38V.3)%*S`Q
M("`@+C0W-3`P,#1%*S`P("`@+C0W-3`P,C!%*S`P("`@+C$P,#`P,#!%*S`Q
M("`@+C$P,#`P,#!%*S`Q("`M+C(Q-C,R-35%*S`T("`@+C8T.#DW-C5%*S`T
M("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U"B`@("XR-30P,#`P12TP
M-2`@("XR-3,Y.3DW12LP-2`@("XQ-C0X-#`R12TP-2`@("XQ-C0X-#`P12LP
M-2`@("XQ-#$V-CDP12LP,2`@("XQ-#$V-CDR12LP,2`@("XT-S4P,#`T12LP
M,"`@("XQ.#4R-3`P12LP,B`@("XQ,#`P,#`P12LP,2`@("XQ,#DU,#`Q12TP
M,B`@("XP,#`P,#`P12LP,"`@("XP,#`P,#`P12LP,"`@("XQ,#`P,#`P12TP
M-2`@("XY.3DY.3DP12LP-`H@("`N,C4S.3DY-T4K,#4@("`N,C4T,#`P,$4M
M,#4@("`N,38T.#0P,$4K,#4@("`N,38T.#0P,D4M,#4@("`N,30Q-C8Y,$4K
M,#$@("`N,C,Y.#,S,44K,#(@("`N-#<U,#`P-$4K,#`@("`N-#<U,#`R,$4K
M,#`@("`N,3,V.3`P,44M,#(@("`N,3`P,#`P,$4K,#$@("`N,#`P,#`P,$4K
M,#`@("`N,#`P,#`P,$4K,#`@("`N.3DY.3DY,$4K,#0@("`N,3`P,#`P,$4M
M,#4*("`@+C(U,SDY.3=%*S`U("`@+C(U,SDY.3=%*S`U("`@+C$V-#@T,#!%
M*S`U("`@+C$V-#@T,#!%*S`U("`@+C$T,38V.3!%*S`Q("`@+C(S.3@S,S%%
M*S`R("`@+C0W-3`P,#1%*S`P("`@+C$X-3(U,#!%*S`R("`@+C$S-CDP,#%%
M+3`R("`@+C$P.34P,#%%+3`R("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%
B*S`P("`@+CDY.3DY.3!%*S`T("`@+CDY.3DY.3!%*S`T"B`@
`
end
STOP_CAT
echo "  Generating =====> [ ./subplot_magnify.dat ]"
cat <<"STOP_CAT"> ././subplot_magnify.uuu
begin 660 ./subplot_magnify.dat
M("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U"B`@("XY.3DY.3DP12LP
M-"`@("XY.3DY.3DP12LP-`H@("`N,3`P,#`P,$4K,#$@("`N,3`P,#`P,$4K
#,#$*
`
end
STOP_CAT
echo "  Generating =====> [ ./subplot_rotate.dat ]"
cat <<"STOP_CAT"> ././subplot_rotate.uuu
begin 660 ./subplot_rotate.dat
M("`@+C$P,#`P,#!%*S`Q("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P,#!%*S`P
M"B`@("XQ,#`P,#`P12LP,2`@+2XQ-S0U,S(X12TP-"`@("XQ,#`P,#`P12TP
M,@H@("`N.#8V,#(U-D4K,#`@("TN-#DY.3DY-D4K,#`@("`N,S`P,#`P,$4K
M,#(*("`@+C<P-S$P-S)%*S`P("`M+C<P-S$P-C1%*S`P("`@+C0U,#`P,#!%
M*S`R"B`@("XU,#`P,#`W12LP,"`@+2XX-C8P,C4P12LP,"`@("XV,#`P,#`P
M12LP,@H@("`N.#<Q-38X-T4M,#$@("TN.3DV,3DT-D4K,#`@("`N.#4P,#`P
M,$4K,#(*("`@+C$P,#`P,#!%*S`Q("`@+C`P,#`P,#!%*S`P("`@+C`P,#`P
M,#!%*S`P"B`@("XQ,#`P,#`P12LP,2`@("XQ-S0U,S(X12TP-"`@+2XQ,#`P
M,#`P12TP,@H@("`N.#8V,#(U-D4K,#`@("`N-#DY.3DY-D4K,#`@("TN,S`P
M,#`P,$4K,#(*("`@+C<P-S$P-S)%*S`P("`@+C<P-S$P-C1%*S`P("`M+C0U
M,#`P,#!%*S`R"B`@("XU,#`P,#`W12LP,"`@("XX-C8P,C4P12LP,"`@+2XV
M,#`P,#`P12LP,@H@("`N.#<Q-38X-T4M,#$@("`N.3DV,3DT-D4K,#`@("TN
,.#4P,#`P,$4K,#(*
`
end
STOP_CAT
echo "  Generating =====> [ ./subplot_scale.dat ]"
cat <<"STOP_CAT"> ././subplot_scale.uuu
begin 660 ./subplot_scale.dat
M("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P,#!%+3`U
M("`@+C$P,#`P,#!%+3`U"B`@("XQ,#`P,#`P12TP-2`@("XY.3DY.3DP12LP
M-"`@("XQ,#`P,#`P12TP-2`@("XY.3DY.3DP12LP-`H@("`N,3`P,#`P,$4M
M,#4@("`N,3`P,#`P,$4K,#$@("`N,3`P,#`P,$4M,#4@("`N,3`P,#`P,$4K
M,#$*("`@+CDY.3DY.3!%*S`T("`@+C$P,#`P,#!%+3`U("`@+CDY.3DY.3!%
M*S`T("`@+C$P,#`P,#!%+3`U"B`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP
M12LP-"`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-`H@("`N.3DY.3DY
M,$4K,#0@("`N,3`P,#`P,$4K,#$@("`N.3DY.3DY,$4K,#0@("`N,3`P,#`P
M,$4K,#$*("`@+C$P,#`P,#!%*S`Q("`@+C$P,#`P,#!%+3`U("`@+C$P,#`P
M,#!%*S`Q("`@+C$P,#`P,#!%+3`U"B`@("XQ,#`P,#`P12LP,2`@("XY.3DY
M.3DP12LP-"`@("XQ,#`P,#`P12LP,2`@("XY.3DY.3DP12LP-`H@("`N,3`P
M,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@("`N,3`P,#`P,$4K,#$@("`N,3`P
),#`P,$4K,#$*
`
end
STOP_CAT
echo "  Generating =====> [ ./subplot_shift.dat ]"
cat <<"STOP_CAT"> ././subplot_shift.uuu
begin 660 ./subplot_shift.dat
M("`@+C$V-#@T,#)%+3`U("`@+C$V-#@T,#)%+3`U("`@+C$P,#`P,#!%+3`U
M("`@+C$P,#`P,#!%+3`U"B`@("XQ-C0X-#`R12TP-2`@("XQ-C0X-#`P12LP
M-2`@("XQ,#`P,#`P12TP-2`@("XY.3DY.3DP12LP-`H@("`N,38T.#0P,D4M
M,#4@("`N,#`P,#`P,$4K,#`@("`N,3`P,#`P,$4M,#4@("`N,#`P,#`P,$4K
M,#`*("`@+C$V-#@T,#!%*S`U("`@+C$V-#@T,#)%+3`U("`@+CDY.3DY.3!%
M*S`T("`@+C$P,#`P,#!%+3`U"B`@("XQ-C0X-#`P12LP-2`@("XQ-C0X-#`P
M12LP-2`@("XY.3DY.3DP12LP-"`@("XY.3DY.3DP12LP-`H@("`N,38T.#0P
M,$4K,#4@("`N,#`P,#`P,$4K,#`@("`N.3DY.3DY,$4K,#0@("`N,#`P,#`P
M,$4K,#`*("`@+C`P,#`P,#!%*S`P("`@+C$V-#@T,#)%+3`U("`@+C`P,#`P
M,#!%*S`P("`@+C$P,#`P,#!%+3`U"B`@("XP,#`P,#`P12LP,"`@("XQ-C0X
M-#`P12LP-2`@("XP,#`P,#`P12LP,"`@("XY.3DY.3DP12LP-`H@("`N,#`P
M,#`P,$4K,#`@("`N,#`P,#`P,$4K,#`@("`N,#`P,#`P,$4K,#`@("`N,#`P
),#`P,$4K,#`*
`
end
STOP_CAT
echo "  Generating =====> [ ./text2d1.f ]"
cat <<"STOP_CAT"> ././text2d1.f
C     PROGRAM TEXT2D1
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program TEXT2D_PDRAW and
C              TEXT2D_GETLEN
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
      EXTERNAL TEXT2D_GETLEN
      REAL     TEXT2D_GETLEN
C
      CHARACTER*40 KODE
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C     ******************************************************************
C
C                       INITIALIZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C                       Enable software character fonts
      CALL GRAPHICS_RESET ('HRDTXT')
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.10*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 3.0*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of title in inches
      XX = TEXT2D_GETLEN ('TEXT2D1 Demo: Italic-Script-Greek',100)
C                       Compute X coord of start of title in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW
     *     ('TEXT2D1 Demo: Italic-Script-Greek',100,XX,-0.5)
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW
C
C                       DRAW CONTROL STRING
C
C                       Define text style
      CALL FONT_COMPLX
C                       Store control string
      KODE = '(Italic Script Greek in one string)$'
C                       Increase current text height in inches
      CALL TEXT2D_SETHT (SIZE*1.2)
C                       Compute X coord of start of string in inches
      XX = (XPG-TEXT2D_GETLEN(KODE,100))*0.5
C                       Plot control string in 3 mixed alphabets
      CALL TEXT2D_PDRAW (KODE,100,XX,YPG*0.35)
C
C                       DRAW FANCY STRING
C
C                       Define alphabet set 1
      CALL FONT_ALPHA ('ITALIC')
C                       Define alphabet set 2
      CALL FONT_ALPHAB ('SCRIPT')
C                       Define alphabet set 3
      CALL FONT_ALPHA3 ('GREEK','{')
C                       Store fancy string
      KODE = 'Italic (Script {Greek )in (one {string$'
C                       Compute X coord of start of string in inches
      XX = (XPG-TEXT2D_GETLEN(KODE,100))*0.5
C                       Plot fancy string in 3 mixed alphabets
      CALL TEXT2D_PDRAW (KODE,100,XX,YPG*0.5)
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
C                       Exit
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./text2d2.f ]"
cat <<"STOP_CAT"> ././text2d2.f
C     PROGRAM TEXT2D2
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program TEXT2D_PDRAW and
C              TEXT2D_GETLEN with upper and lower case alphabet sets
C
C     NOTES:  None
C
C     ******************************************************************
C
      CHARACTER*39 TITL(9)
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
      DATA TITL /'TEXT2D2 Demo: Lower Case Default$      ',
     2           'TEXT2D2 Demo: Upper/Lower Case Italic$ ',
     3           'TEXT2D2 Demo: Lower Case Italic$       ',
     4           'TEXT2D2 Demo: Upper/Lower Case Greek$  ',
     5           'TEXT2D2 Demo: Lower Case Greek$        ',
     6           'TEXT2D2 Demo: Upper/Lower Case Script$ ',
     7           'TEXT2D2 Demo: Lower Case Script$       ',
     8           'TEXT2D2 Demo: Upper/Lower Case Math$   ',
     9           'TEXT2D2 Demo: Upper/Lower Case Default$'/
C
C     ******************************************************************
C
C                       INITIALZE LIBRARIES
C
C                       Initialize the graphics package
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       INITIALZE OUTPUT DEVICE
C
C                       Allow user to choose a device interactively
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
C
C                       Enable software character fonts
      CALL GRAPHICS_RESET ('HRDTXT')
C
C                       Loop for each alphabet set
      DO 11 J=1,9
C
C     ******************************************************************
C
C                       DEFINE PAGE SIZE
C
C                       Define page size in inches
      CALL PAGE_SIZE (XPAGE,YPAGE)
C
C     ******************************************************************
C
C                       DEFINE SUBPLOT AREA
C
C                       Define location of physical origin relative
C                       to lower left corner of page
      CALL ORIGIN_SET (0.0,0.0)
C                       Compute new location of physical origin in
C                       inches from current location
      XRL = 0.10*XPAGE
      YRL = 0.10*YPAGE
C                       Compute length of X and Y axis in inches
      XPG = XPAGE - 2.0*XRL
      YPG = YPAGE - 3.0*YRL
C                       Move physical origin relative to current
C                       location (distance in inches)
      CALL ORIGIN_MOVE (XRL,YRL)
C                       Define subplot area in terms of length
C                       of X and Y axis in inches and draw border
C                       around outer edge of plot
      CALL SUBPLOT_DEFINE (XPG,YPG)
C
C     ******************************************************************
C
C                       DRAW TITLE UNDER SUBPLOT AREA
C
C                       Compute text height based on page height
      SIZE = 0.25*YPAGE/11.0
C                       Set current text height in inches
      CALL TEXT2D_SETHT (SIZE)
C                       Determine length of title in inches
      XX = TEXT2D_GETLEN (TITL(J),100)
C                       Compute X coord of start of title in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string
      CALL TEXT2D_PDRAW (TITL(J),100,XX,-0.5)
C
C     ******************************************************************
C
C                       DRAW THE PLOT
C
C                       Draw frame around subplot area
      CALL FRAME_DRAW
C                       Set alphabet set for this loop
      CALL FONT_ALPHA ('STAND')
      IF (J .EQ. 1) CALL FONT_ALPHAB('L/CSTD')
      IF (J .EQ. 2) CALL FONT_ALPHAB('ITALI')
      IF (J .EQ. 3) CALL FONT_ALPHAB('L/CIT')
      IF (J .EQ. 4) CALL FONT_ALPHAB('GREEK')
      IF (J .EQ. 5) CALL FONT_ALPHAB('L/CGR')
      IF (J .EQ. 6) CALL FONT_ALPHAB('SCRIP')
      IF (J .EQ. 7) CALL FONT_ALPHAB('L/CSC')
      IF (J .EQ. 8) CALL FONT_ALPHAB('MATHE')
      IF (J .EQ. 9) CALL FONT_ALPHAB('DEFAU')
C
C                       Increase current text height in inches
      CALL TEXT2D_SETHT (SIZE*1.5)
C                       Determine length of text string in inches
      XX = TEXT2D_GETLEN ('T(EST) H(EADING)$',100)
C                       Compute X coord of start of string in inches
      XX = 0.50*(XPG-XX)
C                       Plot text string in mixed alphabets
C                       with upper case character codes
      CALL TEXT2D_PDRAW ('T(EST) H(EADING)$',100,XX,YPG*0.6)
C                       with lower case character codes
      CALL TEXT2D_PDRAW ('T(est) H(eading)$',100,XX,YPG*0.4)
C
C     ******************************************************************
C
C                       END THE SUBPLOT
C
      CALL SUBPLOT_END (0)
C
C     ******************************************************************
C
C                       END THE PLOT
C
C                       End current plot and advance paper
      CALL PAGE_END (0)
C                       Repeat for next alphabet set
   11 CONTINUE
C
C     ******************************************************************
C
C                       CLOSE THE OUTPUT DEVICE
C
C                       Finish plotting and release device
      CALL DEVICE_END
C                       Exit
      CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./text2d3.f ]"
cat <<"STOP_CAT"> ././text2d3.f
C     PROGRAM TEXT2D3
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program TEXT2D_PDRAWR and
C              TEXT2D_SETHT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       TEXT2D object access program
      EXTERNAL TEXT2D_PDRAWR, TEXT2D_SETHT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  1)
      PARAMETER (NVV102 =  1)
      PARAMETER (NVV103 =  1)
      PARAMETER (NVV104 =  1)
      PARAMETER (NVV105 =  4)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Integer variables and arrays
      INTEGER IMESS, TMP102, LREL, TMP105
C
C                       Real variables and arrays
      REAL    XPOSP2, TMP103, YPOSP2, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER LMESS*160, TMP101*160
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*160 VV101(NVV101)
      INTEGER VV102(NVV102)
      REAL    VV103(NVV103)
      REAL    VV104(NVV104)
      INTEGER VV105(NVV105)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /'Relative String$'/
C
      DATA VV102 /100/
C
      DATA VV103 /1.0/
C
      DATA VV104 /2.0/
C
      DATA VV105 /0, 1, 2, 3/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'text2d_pdrawr.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              TEXT2D Object Demo Program #3'/
     * ' This program tests the TEXT2D object access program'/
     * ' TEXT2D_PDRAWR.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test TEXT2D_PDRAWR object access program
C
      HITE = 0.0
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        LMESS = VV101(IVV101)
C
      DO 588 IVV102 = 1,NVV102
        IMESS = VV102(IVV102)
C
      DO 587 IVV103 = 1,NVV103
        XPOSP2 = VV103(IVV103)
C
      DO 586 IVV104 = 1,NVV104
        YPOSP2 = VV104(IVV104)
C
      DO 585 IVV105 = 1,NVV105
        LREL = VV105(IVV105)
C
C                       Set text string height
      HITE = HITE+0.125
      CALL TEXT2D_SETHT (HITE)
C
C                       Draw text string relative to current location or
C                       origin in page units
      CALL TEXT2D_PDRAWR (LMESS,IMESS,XPOSP2,YPOSP2,LREL)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=510) TMP101,TMP102,TMP103,TMP104,TMP105
        GOTO 523
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=512) LMESS,IMESS,XPOSP2,YPOSP2,LREL
  502 FORMAT (A,I21,E15.7,E15.7,I21)
      GOTO 523
C                       Print file I/O error messages
  510 WRITE (IER,511) FILNAM
  511 FORMAT (' Error reading file ',A)
      GOTO 523
C
  512 WRITE (IER,513) FILNAM
  513 FORMAT (' Error writing file ',A)
C
  523 CONTINUE
C
C                       Repeat for next variable value
  585 CONTINUE
  586 CONTINUE
  587 CONTINUE
  588 CONTINUE
  589 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
      CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              TEXT2D Demo Program #3 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./text2d4.f ]"
cat <<"STOP_CAT"> ././text2d4.f
C     PROGRAM TEXT2D4
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program TEXT2D_ROTATE and
C              TEXT2D_SETERM
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       TEXT2D object access program
      EXTERNAL TEXT2D_ROTATE, TEXT2D_SETERM
C
C                       Environment object access programs
      EXTERNAL DEVICE_PROMPT, DEVICE_RELEASE
      EXTERNAL PAGE_SIZE, PAGE_END, ORIGIN_SET
      EXTERNAL SUBPLOT_DEFINE, SUBPLOT_END
      EXTERNAL TEXT2D_PDRAW, TEXT2D_SETHT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV104 =  8)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'TEXT2D.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, TMP103, ANGLE, TMP104
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER  TSTRM*1
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV104(NVV104)
      CHARACTER  VV105(NVV104)*1
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV104 /0.0, 45., 90., 135., 180, -135., -90., -45.0/
      DATA VV105 /'!', '@', '#', '$',  '%', '^',   '&',  '*'/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'text2d_rotate.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              TEXT2D Object Demo Program #4'/
     * ' This program tests the TEXT2D object access program'/
     * ' TEXT2D_ROTATE.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 0
      CALL DEVICE_PROMPT (KTYPE,XPAGE,YPAGE)
      CALL PAGE_SIZE (XPAGE,YPAGE)
      CALL ORIGIN_SET (0.0,0.0)
      CALL SUBPLOT_DEFINE (XPAGE,YPAGE)
      CALL TEXT2D_SETHT (0.25)
C
C     ------------------------------------------------------------------
C
C                       Test TEXT2D_ROTATE object access program
C
      DO 587 IVV104 = 1,NVV104
        ANGLE = VV104(IVV104)
        TSTRM = VV105(IVV104)
C
C                       Set text string rotation angle
      CALL TEXT2D_ROTATE (ANGLE)
C                       Set text string terminator
      CALL TEXT2D_SETERM (TSTRM,1)
C
      CALL TEXT2D_PDRAW
     *     ('  Rotated String'//TSTRM//' Not Working!',100,6.5,5.5)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(ZZANGL ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) UUHITE,ZZHITE,ZZANGL,ANGLE
  502 FORMAT (E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  587 CONTINUE
C                       Finish subplot
      CALL SUBPLOT_END (0)
C                       End plotting on current page
      CALL PAGE_END (0)
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              TEXT2D Demo Program #4 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./text2d5.f ]"
cat <<"STOP_CAT"> ././text2d5.f
C     PROGRAM TEXT2D5
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program TEXT2D_SETERM
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       TEXT2D object access program
      EXTERNAL TEXT2D_SETERM
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV103 =  1)
      PARAMETER (NVV104 =  2)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'TEXT2D.INC'
C
C                       Integer variables and arrays
      INTEGER TMP102, LENGTH, TMP104
C
C                       Real variables and arrays
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
      CHARACTER TMP101*4, TSTRM*4, TMP103*4
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      CHARACTER*4 VV103(NVV103)
      INTEGER VV104(NVV104)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV103 /'$'/
C
      DATA VV104 /1, 4/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'text2d_seterm.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              TEXT2D Object Demo Program #5'/
     * ' This program tests the TEXT2D object access program'/
     * ' TEXT2D_SETERM.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test TEXT2D_SETERM object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV103 = 1,NVV103
        TSTRM = VV103(IVV103)
C
      DO 588 IVV104 = 1,NVV104
        LENGTH = VV104(IVV104)
C
C                       Set text string terminator
      CALL TEXT2D_SETERM (TSTRM,LENGTH)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (KZSTRM .NE. TMP101 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (KZTMLN .NE. TMP102 ) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) KZSTRM,KZTMLN,TSTRM,LENGTH
  502 FORMAT (A,I21,A,I21)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
  589 CONTINUE
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              TEXT2D Demo Program #5 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./text2d6.f ]"
cat <<"STOP_CAT"> ././text2d6.f
C     PROGRAM TEXT2D6
C
C       Programmer's Reusable Library, Version 0.7      (TM)
C
C            Copyright (C) 1995 Object Access (SM)
C
C     Permission is granted to any individual or institution
C     to use, copy, modify, and distribute this single program
C     unit, provided that this complete copyright and
C     permission notice is maintained, intact, in all copies.
C
C     Object Access Incorporated provides this software
C     "as is" without express or implied warranty.
C
C     PURPOSE: Demonstrate and test access program TEXT2D_SETHT
C
C     LOCAL VARIABLES:
C
C
C     NOTES:  None
C
C     ******************************************************************
C
C                       External subprogram declarations
C
C     INTRINSIC
C
C                       TEXT2D object access program
      EXTERNAL TEXT2D_SETHT
C
C                       GRAPHICS object access programs
      EXTERNAL GRAPHICS_INIT
C
C                       PRL object access programs
      EXTERNAL PRL_LIBVER
C
C                       DEVICE object access programs
      EXTERNAL DEVICE_SELECT, DEVICE_RELEASE
C
C                       REAL object access programs
      EXTERNAL REAL_IDIF0, REAL_SETTOL
      LOGICAL  REAL_IDIF0
C
C                       DBL object access programs
      EXTERNAL DBL_IDIF0, DBL_SETTOL
      LOGICAL  DBL_IDIF0
C
C                       CMPLX object access programs
      EXTERNAL CMPLX_IDIF0
      LOGICAL  CMPLX_IDIF0
C
C                       TERM object access programs
      EXTERNAL TERM_GETIN, TERM_GETOUT, TERM_GETERR, TERM_SETSIO
      INTEGER  TERM_GETIN, TERM_GETOUT, TERM_GETERR
C
C                       PROCESS object access programs
      EXTERNAL PROCESS_EXIT
C
C                       FILE object access programs
      EXTERNAL PXFCLS, PXFOPN
C
C                       PCONS object access programs
      EXTERNAL IPXCON
      INTEGER  IPXCON
C
C     ------------------------------------------------------------------
C
C                       Test program parameter values
C
C                       Standard input logical unit for the system
      PARAMETER (LUNSI=5)
C                       Standard output logical unit for the system
      PARAMETER (LUNSO=6)
C                       Standard error logical unit for the system
      PARAMETER (LUNSE=6)
C
C                       REAL subtraction tolerance
      PARAMETER (TOLER=0.00001)
C                       DBL subtraction tolerance
      DOUBLE PRECISION DTOLER
      PARAMETER (DTOLER=1.0D-13)
C
C                       Number of input variable test values
      PARAMETER (NVV101 =  3)
      PARAMETER (NVV105 =  3)
C
C                       Argument maximum array sizes
C
C     ------------------------------------------------------------------
C
C                       Access program variables
C
C                       Private variables and arrays
      INCLUDE 'TEXT2D.INC'
C
C                       Integer variables and arrays
C
C                       Real variables and arrays
      REAL    TMP101, TMP102, TMP103, TMP104, HITE, TMP105
C
C                       Double precision variables and arrays
C
C                       Complex variables and arrays
C
C                       Logical variables and arrays
C
C                       Character variables and arrays
C
C     ------------------------------------------------------------------
C
C                       Test program variables
C
      CHARACTER*1 PAUS
C                       Program logical unit numbers
      INTEGER     IN, IOUT, IER, IFILE, IO
C
C                       Name of results file for the access program
      CHARACTER*(40) FILNAM
C
C                       Library version numbers (actual & required)
      CHARACTER*8  VERAQ,VERRQ
C
C                       Input variable test value arrays
      REAL    VV101(NVV101)
      REAL    VV105(NVV105)
C
C                       Program required PRL version
      DATA VERRQ /'0.7     '/
C
C                       Input variable test values
      DATA VV101 /0.0, 9999.99, 1.0/
C
      DATA VV105 /.000001, 9999.99, 0.14/
C
C     ******************************************************************
C
C                       Initialize library
C
      CALL GRAPHICS_INIT (0)
C
C     ******************************************************************
C
C                       Check PRL version
C
C                       Get actual PRL version being used
      CALL PRL_LIBVER (VERAQ,VERRQ)
C
C     ******************************************************************
C
C                       Set machine-specific constants
C
      CALL TERM_SETSIO (LUNSI,LUNSO,LUNSE)
C
C                       Logical unit number (LUN) of standard in
      IN = TERM_GETIN ()
C                       LUN of standard out
      IOUT = TERM_GETOUT ()
C                       LUN of standard error
      IER = TERM_GETERR ()
C
C                       REAL subtraction tolerance
      CALL REAL_SETTOL (TOLER)
C
C                       DBL subtraction tolerance
      CALL DBL_SETTOL (DTOLER)
C
C     ******************************************************************
C
C                       Print introduction message
C
C                       Set file pathname
      FILNAM = 'text2d_setht.dat'
C
      WRITE (IOUT,301) FILNAM
  301 FORMAT (
     * '              TEXT2D Object Demo Program #6'/
     * ' This program tests the TEXT2D object access program'/
     * ' TEXT2D_SETHT.'/
     * ' The input variables are varied through a wide range of valid'/
     * ' combinations.  The results for each combination are compared'/
     * ' to previously-computed results stored on file, and any '/
     * ' differences are displayed.  If no results file is found, the'/
     * ' computed results are saved in a file named'/
     * ' ',A/)
C
C                       Initialize program completion status
      IOK = 0
C
C     ******************************************************************
C
C                       Open test results file
C
C                       Open read-only
      IOPFLG = IPXCON ('O_RDONLY')
C
C                       Assume file exists and open read-only
      CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IRESLT)
C
C                       If file does not exist,
C                       create and open read/write
      IF (IRESLT .NE. 0) THEN
        IF (IRESLT .EQ. IPXCON('ENOENT')) THEN
C                       Open read-write
          IOPFLG = IPXCON ('O_RDWR')
C                       Allow file creation
     *            +IPXCON ('O_CREAT')
C                       Create file and open read/write
          CALL PXFOPN (FILNAM,0,IOPFLG,0,IFILE,IERROR)
C
C                       If error creating and opening file,
C                       print error message and exit
          IF (IERROR .NE. 0) THEN
            WRITE (IER,409) FILNAM
  409       FORMAT (' Error opening results file ',A)
            GOTO 900
          ENDIF
C                       Print message that file is being created
          WRITE (IOUT,411) FILNAM
  411     FORMAT (' Creating file ',A)
          IOK = 1
C
C                       If error opening existing file,
C                       print error message and exit
        ELSE
          WRITE (IER,409) FILNAM
          GOTO 900
        ENDIF
      ENDIF
C
C     ******************************************************************
C
C                       Set up proper environment for access program
C                       under test
C
C                       Select device and advance package to level 1
      KTYPE = 2
      CALL DEVICE_SELECT (KTYPE,XPAGE,YPAGE)
C
C     ------------------------------------------------------------------
C
C                       Test TEXT2D_SETHT object access program
C
C                       Loop for each input variable of access program
      DO 589 IVV101 = 1,NVV101
        FACXY = VV101(IVV101)
C
      DO 588 IVV105 = 1,NVV105
        HITE = VV105(IVV105)
C
C                       Set text string height
      CALL TEXT2D_SETHT (HITE)
C
C                       Read input and output variable values from file
      IF (IRESLT .EQ. 0) THEN
        READ (IFILE,502,ERR=610) TMP101,TMP102,TMP103,TMP104,TMP105
C
C                       Compare output with previously-computed values
C                       and write to error device if they do not match
        IF (.NOT. REAL_IDIF0(UUHITE ,TMP102 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZHITE ,TMP103 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ELSE IF (.NOT. REAL_IDIF0(ZZANGL ,TMP104 )) THEN
          IO = IER
          IOK = 1
          GOTO 501
        ENDIF
C                       Test combination matches previous results
        GOTO 503
C
C                       Write input and output variable values to file
      ELSE
        IO = IFILE
        GOTO 501
      ENDIF
C                       Write input and output variable values
C                       to file or error device
  501 CONTINUE
      WRITE (IO,502,ERR=612) FACXY,UUHITE,ZZHITE,ZZANGL,HITE
  502 FORMAT (E15.7,E15.7,E15.7,E15.7,E15.7)
  503 CONTINUE
C
C                       Repeat for next variable value
  588 CONTINUE
  589 CONTINUE
C                       Release device
      CALL DEVICE_RELEASE ()
C
C     ******************************************************************
C
C                       Print program status message
C
      IF (IOK .EQ. 0) THEN
        WRITE (IOUT,601)
  601   FORMAT (' Program results identical to file values')
      ENDIF
      GOTO 700
C
  610 WRITE (IER,611) FILNAM
  611 FORMAT (' Error reading file ',A)
      GOTO 700
C
  612 WRITE (IER,613) FILNAM
  613 FORMAT (' Error writing file ',A)
C
C     ******************************************************************
C
C                       Close test results file
C
C                       Close file
  700 CALL PXFCLS (IFILDS,IERROR)
C
C     ******************************************************************
C
C                       Print demo termination message
C
C                       Wait until user presses a key before exiting
      WRITE (IOUT,810)
  810 FORMAT (/
     * '              TEXT2D Demo Program #6 Execution Completed'/
     * '                      Press <CR> to exit demo')
      READ (IN,811) PAUS
  811 FORMAT (A)
C
C     ******************************************************************
C
C                       Terminate program execution
C
  900 CALL PROCESS_EXIT
      END
STOP_CAT
echo "  Generating =====> [ ./text2d_pdrawr.dat ]"
cat <<"STOP_CAT"> ././text2d_pdrawr.uuu
begin 660 ./text2d_pdrawr.dat
M4F5L871I=F4@4W1R:6YG)"`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@(#$P
M,"`@("XQ,#`P,#`P12LP,2`@("XR,#`P,#`P12LP,2`@("`@("`@("`@("`@
M("`@("`@,`I296QA=&EV92!3=')I;F<D("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@,3`P("`@+C$P,#`P,#!%*S`Q("`@+C(P,#`P,#!%*S`Q("`@("`@
M("`@("`@("`@("`@("`Q"E)E;&%T:79E(%-T<FEN9R0@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`Q,#`@("`N,3`P,#`P,$4K,#$@("`N,C`P,#`P,$4K
M,#$@("`@("`@("`@("`@("`@("`@(#(*4F5L871I=F4@4W1R:6YG)"`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@
M("`@("`@("`@("`@("`@("`@("`@(#$P,"`@("XQ,#`P,#`P12LP,2`@("XR
@,#`P,#`P12LP,2`@("`@("`@("`@("`@("`@("`@,PHP
`
end
STOP_CAT
echo "  Generating =====> [ ./text2d_rotate.dat ]"
cat <<"STOP_CAT"> ././text2d_rotate.uuu
begin 660 ./text2d_rotate.dat
M("`@+C8S-3`P,#!%*S`P("`@+C0Q,C$P,#5%*S`P("`@+C`P,#`P,#!%*S`P
M("`@+C`P,#`P,#!%*S`P"B`@("XV,S4P,#`P12LP,"`@("XT,3(Q,#`U12LP
M,"`@("XT-3`P,#`P12LP,B`@("XT-3`P,#`P12LP,@H@("`N-C,U,#`P,$4K
M,#`@("`N-#$R,3`P-44K,#`@("`N.3`P,#`P,$4K,#(@("`N.3`P,#`P,$4K
M,#(*("`@+C8S-3`P,#!%*S`P("`@+C0Q,C$P,#5%*S`P("`@+C$S-3`P,#!%
M*S`S("`@+C$S-3`P,#!%*S`S"B`@("XV,S4P,#`P12LP,"`@("XT,3(Q,#`U
M12LP,"`@("XQ.#`P,#`P12LP,R`@("XQ.#`P,#`P12LP,PH@("`N-C,U,#`P
M,$4K,#`@("`N-#$R,3`P-44K,#`@("TN,3,U,#`P,$4K,#,@("TN,3,U,#`P
M,$4K,#,*("`@+C8S-3`P,#!%*S`P("`@+C0Q,C$P,#5%*S`P("`M+CDP,#`P
M,#!%*S`R("`M+CDP,#`P,#!%*S`R"B`@("XV,S4P,#`P12LP,"`@("XT,3(Q
F,#`U12LP,"`@+2XT-3`P,#`P12LP,B`@+2XT-3`P,#`P12LP,@H@
`
end
STOP_CAT
echo "  Generating =====> [ ./text2d_seterm.dat ]"
cat <<"STOP_CAT"> ././text2d_seterm.uuu
begin 660 ./text2d_seterm.dat
M)"`@("`@("`@("`@("`@("`@("`@("`@,20@("`@("`@("`@("`@("`@("`@
M("`@(#$*)"`@("`@("`@("`@("`@("`@("`@("`@-"0@("`@("`@("`@("`@
,("`@("`@("`@(#0*
`
end
STOP_CAT
echo "  Generating =====> [ ./text2d_setht.dat ]"
cat <<"STOP_CAT"> ././text2d_setht.uuu
begin 660 ./text2d_setht.dat
M("`@+C`P,#`P,#!%*S`P("`@+C(U-#`P,#!%+3`U("`@+C,U-38P,#!%*S`P
M("`@+C`P,#`P,#!%*S`P("`@+C$P,#`P,#!%+3`U"B`@("XP,#`P,#`P12LP
M,"`@("XR-3,Y.3DW12LP-2`@("XS-34V,#`P12LP,"`@("XP,#`P,#`P12LP
M,"`@("XY.3DY.3DP12LP-`H@("`N,#`P,#`P,$4K,#`@("`N,S4U-C`P,$4K
M,#`@("`N,S4U-C`P,$4K,#`@("`N,#`P,#`P,$4K,#`@("`N,30P,#`P,$4K
M,#`*("`@+CDY.3DY.3!%*S`T("`@+C(U-#`P,#!%+3`U("`@+C,U-38P,#!%
M*S`P("`@+C`P,#`P,#!%*S`P("`@+C$P,#`P,#!%+3`U"B`@("XY.3DY.3DP
M12LP-"`@("XR-3,Y.3DW12LP-2`@("XS-34V,#`P12LP,"`@("XP,#`P,#`P
M12LP,"`@("XY.3DY.3DP12LP-`H@("`N.3DY.3DY,$4K,#0@("`N,S4U-C`P
M,$4K,#`@("`N,S4U-C`P,$4K,#`@("`N,#`P,#`P,$4K,#`@("`N,30P,#`P
M,$4K,#`*("`@+C$P,#`P,#!%*S`Q("`@+C(U-#`P,#!%+3`U("`@+C,U-38P
M,#!%*S`P("`@+C`P,#`P,#!%*S`P("`@+C$P,#`P,#!%+3`U"B`@("XQ,#`P
M,#`P12LP,2`@("XR-3,Y.3DW12LP-2`@("XS-34V,#`P12LP,"`@("XP,#`P
M,#`P12LP,"`@("XY.3DY.3DP12LP-`H@("`N,3`P,#`P,$4K,#$@("`N,S4U
M-C`P,$4K,#`@("`N,S4U-C`P,$4K,#`@("`N,#`P,#`P,$4K,#`@("`N,30P
),#`P,$4K,#`*
`
end
STOP_CAT
echo "  <CR> to Continue"
read answer
cat <<STOP_CAT> ./compile
echo "
 
  Compiling and linking demo programs.
 "
echo "  Compiling ======> [ ./blnkarea1.f ]"
$LINK ./blnkarea1.f -o ./blnkarea1.x $GRAPHICS
chmod 0770 ./blnkarea1.x
echo "  Compiling ======> [ ./blnkarea2.f ]"
$LINK ./blnkarea2.f -o ./blnkarea2.x $GRAPHICS
chmod 0770 ./blnkarea2.x
echo "  Compiling ======> [ ./blnkarea3.f ]"
$LINK ./blnkarea3.f -o ./blnkarea3.x $GRAPHICS
chmod 0770 ./blnkarea3.x
echo "  Converting ======> [ ./blnkarea_def.uuu ]"
uudecode ./blnkarea_def.uuu
chmod 0660 ./blnkarea_def.dat
echo "  Converting ======> [ ./blnkarea_def1.uuu ]"
uudecode ./blnkarea_def1.uuu
chmod 0660 ./blnkarea_def1.dat
echo "  Converting ======> [ ./blnkarea_defr.uuu ]"
uudecode ./blnkarea_defr.uuu
chmod 0660 ./blnkarea_defr.dat
echo "  Compiling ======> [ ./color1.f ]"
$LINK ./color1.f -o ./color1.x $GRAPHICS
chmod 0770 ./color1.x
echo "  Compiling ======> [ ./color2.f ]"
$LINK ./color2.f -o ./color2.x $GRAPHICS
chmod 0770 ./color2.x
echo "  Compiling ======> [ ./color3.f ]"
$LINK ./color3.f -o ./color3.x $GRAPHICS
chmod 0770 ./color3.x
echo "  Converting ======> [ ./color_defhsi.uuu ]"
uudecode ./color_defhsi.uuu
chmod 0660 ./color_defhsi.dat
echo "  Converting ======> [ ./color_defrgb.uuu ]"
uudecode ./color_defrgb.uuu
chmod 0660 ./color_defrgb.dat
echo "  Converting ======> [ ./color_setnam.uuu ]"
uudecode ./color_setnam.uuu
chmod 0660 ./color_setnam.dat
echo "  Compiling ======> [ ./device1.f ]"
$LINK ./device1.f -o ./device1.x $GRAPHICS
chmod 0770 ./device1.x
echo "  Converting ======> [ ./device_select.uuu ]"
uudecode ./device_select.uuu
chmod 0660 ./device_select.dat
echo "  Compiling ======> [ ./font1.f ]"
$LINK ./font1.f -o ./font1.x $GRAPHICS
chmod 0770 ./font1.x
echo "  Compiling ======> [ ./font2.f ]"
$LINK ./font2.f -o ./font2.x $GRAPHICS
chmod 0770 ./font2.x
echo "  Converting ======> [ ./font_setpat.uuu ]"
uudecode ./font_setpat.uuu
chmod 0660 ./font_setpat.dat
echo "  Compiling ======> [ ./frame1.f ]"
$LINK ./frame1.f -o ./frame1.x $GRAPHICS
chmod 0770 ./frame1.x
echo "  Compiling ======> [ ./frame2.f ]"
$LINK ./frame2.f -o ./frame2.x $GRAPHICS
chmod 0770 ./frame2.x
echo "  Converting ======> [ ./frame_off.uuu ]"
uudecode ./frame_off.uuu
chmod 0660 ./frame_off.dat
echo "  Converting ======> [ ./frame_thick.uuu ]"
uudecode ./frame_thick.uuu
chmod 0660 ./frame_thick.dat
echo "  Compiling ======> [ ./graphics1.f ]"
$LINK ./graphics1.f -o ./graphics1.x $GRAPHICS
chmod 0770 ./graphics1.x
echo "  Compiling ======> [ ./graphics2.f ]"
$LINK ./graphics2.f -o ./graphics2.x $GRAPHICS
chmod 0770 ./graphics2.x
echo "  Converting ======> [ ./graphics_reset.uuu ]"
uudecode ./graphics_reset.uuu
chmod 0660 ./graphics_reset.dat
echo "  Compiling ======> [ ./heading1.f ]"
$LINK ./heading1.f -o ./heading1.x $GRAPHICS
chmod 0770 ./heading1.x
echo "  Compiling ======> [ ./int1.f ]"
$LINK ./int1.f -o ./int1.x $GRAPHICS
chmod 0770 ./int1.x
echo "  Compiling ======> [ ./int2.f ]"
$LINK ./int2.f -o ./int2.x $GRAPHICS
chmod 0770 ./int2.x
echo "  Converting ======> [ ./intnum_pdraw.uuu ]"
uudecode ./intnum_pdraw.uuu
chmod 0660 ./intnum_pdraw.dat
echo "  Converting ======> [ ./intnum_pdrawr.uuu ]"
uudecode ./intnum_pdrawr.uuu
chmod 0660 ./intnum_pdrawr.dat
echo "  Compiling ======> [ ./line2d1.f ]"
$LINK ./line2d1.f -o ./line2d1.x $GRAPHICS
chmod 0770 ./line2d1.x
echo "  Compiling ======> [ ./line2d2.f ]"
$LINK ./line2d2.f -o ./line2d2.x $GRAPHICS
chmod 0770 ./line2d2.x
echo "  Compiling ======> [ ./line2d3.f ]"
$LINK ./line2d3.f -o ./line2d3.x $GRAPHICS
chmod 0770 ./line2d3.x
echo "  Compiling ======> [ ./line2d4.f ]"
$LINK ./line2d4.f -o ./line2d4.x $GRAPHICS
chmod 0770 ./line2d4.x
echo "  Compiling ======> [ ./line2d5.f ]"
$LINK ./line2d5.f -o ./line2d5.x $GRAPHICS
chmod 0770 ./line2d5.x
echo "  Compiling ======> [ ./line2d6.f ]"
$LINK ./line2d6.f -o ./line2d6.x $GRAPHICS
chmod 0770 ./line2d6.x
echo "  Converting ======> [ ./line2d_chndot.uuu ]"
uudecode ./line2d_chndot.uuu
chmod 0660 ./line2d_chndot.dat
echo "  Converting ======> [ ./line2d_draw.uuu ]"
uudecode ./line2d_draw.uuu
chmod 0660 ./line2d_draw.dat
echo "  Converting ======> [ ./line2d_drawr.uuu ]"
uudecode ./line2d_drawr.uuu
chmod 0660 ./line2d_drawr.dat
echo "  Converting ======> [ ./line2d_thick.uuu ]"
uudecode ./line2d_thick.uuu
chmod 0660 ./line2d_thick.dat
echo "  Compiling ======> [ ./logpen21.f ]"
$LINK ./logpen21.f -o ./logpen21.x $GRAPHICS
chmod 0770 ./logpen21.x
echo "  Compiling ======> [ ./logpen22.f ]"
$LINK ./logpen22.f -o ./logpen22.x $GRAPHICS
chmod 0770 ./logpen22.x
echo "  Converting ======> [ ./logpen2_setp.uuu ]"
uudecode ./logpen2_setp.uuu
chmod 0660 ./logpen2_setp.dat
echo "  Converting ======> [ ./logpen2_setr.uuu ]"
uudecode ./logpen2_setr.uuu
chmod 0660 ./logpen2_setr.dat
echo "  Compiling ======> [ ./margin1.f ]"
$LINK ./margin1.f -o ./margin1.x $GRAPHICS
chmod 0770 ./margin1.x
echo "  Compiling ======> [ ./margin2.f ]"
$LINK ./margin2.f -o ./margin2.x $GRAPHICS
chmod 0770 ./margin2.x
echo "  Converting ======> [ ./margin_set.uuu ]"
uudecode ./margin_set.uuu
chmod 0660 ./margin_set.dat
echo "  Compiling ======> [ ./marker1.f ]"
$LINK ./marker1.f -o ./marker1.x $GRAPHICS
chmod 0770 ./marker1.x
echo "  Compiling ======> [ ./marker2.f ]"
$LINK ./marker2.f -o ./marker2.x $GRAPHICS
chmod 0770 ./marker2.x
echo "  Compiling ======> [ ./marker3.f ]"
$LINK ./marker3.f -o ./marker3.x $GRAPHICS
chmod 0770 ./marker3.x
echo "  Compiling ======> [ ./marker4.f ]"
$LINK ./marker4.f -o ./marker4.x $GRAPHICS
chmod 0770 ./marker4.x
echo "  Compiling ======> [ ./marker5.f ]"
$LINK ./marker5.f -o ./marker5.x $GRAPHICS
chmod 0770 ./marker5.x
echo "  Converting ======> [ ./marker_drawcust.uuu ]"
uudecode ./marker_drawcust.uuu
chmod 0660 ./marker_drawcust.dat
echo "  Converting ======> [ ./marker_get.uuu ]"
uudecode ./marker_get.uuu
chmod 0660 ./marker_get.dat
echo "  Converting ======> [ ./marker_size.uuu ]"
uudecode ./marker_size.uuu
chmod 0660 ./marker_size.dat
echo "  Compiling ======> [ ./origin1.f ]"
$LINK ./origin1.f -o ./origin1.x $GRAPHICS
chmod 0770 ./origin1.x
echo "  Compiling ======> [ ./origin2.f ]"
$LINK ./origin2.f -o ./origin2.x $GRAPHICS
chmod 0770 ./origin2.x
echo "  Converting ======> [ ./origin_move.uuu ]"
uudecode ./origin_move.uuu
chmod 0660 ./origin_move.dat
echo "  Converting ======> [ ./origin_set.uuu ]"
uudecode ./origin_set.uuu
chmod 0660 ./origin_set.dat
echo "  Compiling ======> [ ./page1.f ]"
$LINK ./page1.f -o ./page1.x $GRAPHICS
chmod 0770 ./page1.x
echo "  Compiling ======> [ ./page2.f ]"
$LINK ./page2.f -o ./page2.x $GRAPHICS
chmod 0770 ./page2.x
echo "  Compiling ======> [ ./page3.f ]"
$LINK ./page3.f -o ./page3.x $GRAPHICS
chmod 0770 ./page3.x
echo "  Compiling ======> [ ./page4.f ]"
$LINK ./page4.f -o ./page4.x $GRAPHICS
chmod 0770 ./page4.x
echo "  Compiling ======> [ ./page5.f ]"
$LINK ./page5.f -o ./page5.x $GRAPHICS
chmod 0770 ./page5.x
echo "  Compiling ======> [ ./page6.f ]"
$LINK ./page6.f -o ./page6.x $GRAPHICS
chmod 0770 ./page6.x
echo "  Converting ======> [ ./page_orient.uuu ]"
uudecode ./page_orient.uuu
chmod 0660 ./page_orient.dat
echo "  Converting ======> [ ./page_scale.uuu ]"
uudecode ./page_scale.uuu
chmod 0660 ./page_scale.dat
echo "  Converting ======> [ ./page_size.uuu ]"
uudecode ./page_size.uuu
chmod 0660 ./page_size.dat
echo "  Converting ======> [ ./page_unit.uuu ]"
uudecode ./page_unit.uuu
chmod 0660 ./page_unit.dat
echo "  Converting ======> [ ./page_unitcust.uuu ]"
uudecode ./page_unitcust.uuu
chmod 0660 ./page_unitcust.dat
echo "  Compiling ======> [ ./prl1.f ]"
$LINK ./prl1.f -o ./prl1.x $GRAPHICS
chmod 0770 ./prl1.x
echo "  Compiling ======> [ ./process1.f ]"
$LINK ./process1.f -o ./process1.x $GRAPHICS
chmod 0770 ./process1.x
echo "  Compiling ======> [ ./real1.f ]"
$LINK ./real1.f -o ./real1.x $GRAPHICS
chmod 0770 ./real1.x
echo "  Compiling ======> [ ./real2.f ]"
$LINK ./real2.f -o ./real2.x $GRAPHICS
chmod 0770 ./real2.x
echo "  Converting ======> [ ./realnum_pdraw.uuu ]"
uudecode ./realnum_pdraw.uuu
chmod 0660 ./realnum_pdraw.dat
echo "  Converting ======> [ ./realnum_pdrawr.uuu ]"
uudecode ./realnum_pdrawr.uuu
chmod 0660 ./realnum_pdrawr.dat
echo "  Compiling ======> [ ./subplot1.f ]"
$LINK ./subplot1.f -o ./subplot1.x $GRAPHICS
chmod 0770 ./subplot1.x
echo "  Compiling ======> [ ./subplot2.f ]"
$LINK ./subplot2.f -o ./subplot2.x $GRAPHICS
chmod 0770 ./subplot2.x
echo "  Compiling ======> [ ./subplot3.f ]"
$LINK ./subplot3.f -o ./subplot3.x $GRAPHICS
chmod 0770 ./subplot3.x
echo "  Compiling ======> [ ./subplot4.f ]"
$LINK ./subplot4.f -o ./subplot4.x $GRAPHICS
chmod 0770 ./subplot4.x
echo "  Compiling ======> [ ./subplot5.f ]"
$LINK ./subplot5.f -o ./subplot5.x $GRAPHICS
chmod 0770 ./subplot5.x
echo "  Compiling ======> [ ./subplot6.f ]"
$LINK ./subplot6.f -o ./subplot6.x $GRAPHICS
chmod 0770 ./subplot6.x
echo "  Converting ======> [ ./subplot_define.uuu ]"
uudecode ./subplot_define.uuu
chmod 0660 ./subplot_define.dat
echo "  Converting ======> [ ./subplot_magnify.uuu ]"
uudecode ./subplot_magnify.uuu
chmod 0660 ./subplot_magnify.dat
echo "  Converting ======> [ ./subplot_rotate.uuu ]"
uudecode ./subplot_rotate.uuu
chmod 0660 ./subplot_rotate.dat
echo "  Converting ======> [ ./subplot_scale.uuu ]"
uudecode ./subplot_scale.uuu
chmod 0660 ./subplot_scale.dat
echo "  Converting ======> [ ./subplot_shift.uuu ]"
uudecode ./subplot_shift.uuu
chmod 0660 ./subplot_shift.dat
echo "  Compiling ======> [ ./text2d1.f ]"
$LINK ./text2d1.f -o ./text2d1.x $GRAPHICS
chmod 0770 ./text2d1.x
echo "  Compiling ======> [ ./text2d2.f ]"
$LINK ./text2d2.f -o ./text2d2.x $GRAPHICS
chmod 0770 ./text2d2.x
echo "  Compiling ======> [ ./text2d3.f ]"
$LINK ./text2d3.f -o ./text2d3.x $GRAPHICS
chmod 0770 ./text2d3.x
echo "  Compiling ======> [ ./text2d4.f ]"
$LINK ./text2d4.f -o ./text2d4.x $GRAPHICS
chmod 0770 ./text2d4.x
echo "  Compiling ======> [ ./text2d5.f ]"
$LINK ./text2d5.f -o ./text2d5.x $GRAPHICS
chmod 0770 ./text2d5.x
echo "  Compiling ======> [ ./text2d6.f ]"
$LINK ./text2d6.f -o ./text2d6.x $GRAPHICS
chmod 0770 ./text2d6.x
echo "  Converting ======> [ ./text2d_pdrawr.uuu ]"
uudecode ./text2d_pdrawr.uuu
chmod 0660 ./text2d_pdrawr.dat
echo "  Converting ======> [ ./text2d_rotate.uuu ]"
uudecode ./text2d_rotate.uuu
chmod 0660 ./text2d_rotate.dat
echo "  Converting ======> [ ./text2d_seterm.uuu ]"
uudecode ./text2d_seterm.uuu
chmod 0660 ./text2d_seterm.dat
echo "  Converting ======> [ ./text2d_setht.uuu ]"
uudecode ./text2d_setht.uuu
chmod 0660 ./text2d_setht.dat
echo "
 
  All demo programs have been compiled.
 "
Proceed="No"
while [ "\$Proceed" = "No" ]
do
echo "
 
  Delete demo program source?
  ( Y or N )
 "
read answer
if [ "\$answer" = "y" ]; then
  Proceed="Yes"
  echo "
  All demo programs are being deleted"
  rm ./*.f
  rm ./*.uuu 2>/dev/null
  rm ./*.INC 2>/dev/null
else
  if [ "\$answer" = "Y" ]; then
    Proceed="Yes"
    echo "
  All demo programs are being deleted"
    rm ./*.f
    rm ./*.uuu 2>/dev/null
    rm ./*.INC 2>/dev/null
  fi
fi
if [ "\$answer" = "n" ]; then
  Proceed="Yes"
else
  if [ "\$answer" = "N" ]; then
    Proceed="Yes"
  fi
fi
echo "  <CR> to Continue"
read answer
done
STOP_CAT
chmod 770 ./compile
cat <<"STOP_CAT"> ./run_demo
(tput) 1>/dev/null 2>&1
if [ $? = 1 ]; then
  CLEAR="clear"; export CLEAR
else
  CLEAR="tput clear"; export CLEAR
fi
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

 
  PRL-GRAPHICS demonstration programs. These programs
  test and demonstrate the capabilities of the
  PRL-GRAPHICS library.
 
  <CR> to Continue"
read answer
while [ 1 -eq 1 ]; do
$CLEAR
echo "
 Select Demo Program
 ===================
   1 ./_graphics.tk         2 ./blnkarea1            3 ./blnkarea2              
   4 ./blnkarea3            5 ./color1               6 ./color2                 
   7 ./color3               8 ./device1              9 ./font1                  
  10 ./font2               11 ./frame1              12 ./frame2                 
  13 ./graphics1           14 ./graphics2           15 ./heading1               
  16 ./int1                17 ./int2                18 ./line2d1                
  19 ./line2d2             20 ./line2d3             21 ./line2d4                
  22 ./line2d5             23 ./line2d6             24 ./logpen21               
  25 ./logpen22            26 ./margin1             27 ./margin2                
  28 ./marker1             29 ./marker2             30 ./marker3                
  31 ./marker4             32 ./marker5             33 ./origin1                
  34 ./origin2             35 ./page1               36 ./page2                  
  37 ./page3               38 ./page4               39 ./page5                  
  40 ./page6               41 ./prl1                42 ./process1               
  43 ./real1               44 ./real2               45 ./subplot1               
  46 ./subplot2            47 ./subplot3            48 ./subplot4               
  49 ./subplot5            50 ./subplot6            51 ./text2d1                
  52 ./text2d2             53 ./text2d3             54 ./text2d4                
  55 ./text2d5             56 ./text2d6                                         
 
   x. Exit, delete demo executables
   s. Exit, save demo executables"
read answer
$CLEAR
case "$answer" in
  "x") rm ./*.o ./*.x ./*.tk ./*.dat ./*.inp 2>/dev/null; break;;
  "s") rm ./*.o 2>/dev/null; break;;
  1) wish -f ./_graphics.tk;;
  2) ./blnkarea1.x;;
  3) ./blnkarea2.x;;
  4) ./blnkarea3.x;;
  5) ./color1.x;;
  6) ./color2.x;;
  7) ./color3.x;;
  8) ./device1.x;;
  9) ./font1.x;;
 10) ./font2.x;;
 11) ./frame1.x;;
 12) ./frame2.x;;
 13) ./graphics1.x;;
 14) ./graphics2.x;;
 15) ./heading1.x;;
 16) ./int1.x;;
 17) ./int2.x;;
 18) ./line2d1.x;;
 19) ./line2d2.x;;
 20) ./line2d3.x;;
 21) ./line2d4.x;;
 22) ./line2d5.x;;
 23) ./line2d6.x;;
 24) ./logpen21.x;;
 25) ./logpen22.x;;
 26) ./margin1.x;;
 27) ./margin2.x;;
 28) ./marker1.x;;
 29) ./marker2.x;;
 30) ./marker3.x;;
 31) ./marker4.x;;
 32) ./marker5.x;;
 33) ./origin1.x;;
 34) ./origin2.x;;
 35) ./page1.x;;
 36) ./page2.x;;
 37) ./page3.x;;
 38) ./page4.x;;
 39) ./page5.x;;
 40) ./page6.x;;
 41) ./prl1.x;;
 42) ./process1.x;;
 43) ./real1.x;;
 44) ./real2.x;;
 45) ./subplot1.x;;
 46) ./subplot2.x;;
 47) ./subplot3.x;;
 48) ./subplot4.x;;
 49) ./subplot5.x;;
 50) ./subplot6.x;;
 51) ./text2d1.x;;
 52) ./text2d2.x;;
 53) ./text2d3.x;;
 54) ./text2d4.x;;
 55) ./text2d5.x;;
 56) ./text2d6.x;;
  *) echo "Invalid Choice
 
  <CR> to Continue"
read answer;;
esac
done
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

 
       For more information contact:
 
         Object Access
         2023 Leisure Lane
         League City, TX  77573
 
         e-mail:   oa@iah.com
         homepage: http://www.iah.com/oa
         phone:    713-332-7281, 713-554-7617
 
 "
STOP_CAT
chmod 770 ./run_demo
if [ "$SYSID" = "" ]; then
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

  If you had selected a supported system, the demos
  would be installed automatically now.  Since you
  did not, you must perform the following procedures
  to complete the demo installation:
 
  1. Compile the demo programs using the FORTRAN command
     for your system, or by executing the 'compile' 
     script by typing its name.
 
  2. Execute the demo programs by typing 'run_demo'
 
  "
else
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

  All files required to run the demo programs are
  prepared.  If you wish to continue, press ENTER.
  To stop and continue manually, type any character
  and press ENTER.
 
  <CR> to Continue"
read answer
$CLEAR
if [ "$answer" = "" ]; then
  ./compile
  rm ./compile
  ./run_demo
else
$CLEAR
echo "
                    Object Access
            Programmer's Reusable Library
                        GRAPHICS
 

  If you had elected to proceed, the demos
  would be installed automatically now.  Since you
  did not, you must perform the following procedures
  to complete the demo installation:
 
  1. Compile the demo programs using the FORTRAN command
     for your system, or by executing the 'compile' 
     script by typing its name.
 
  2. Execute the demo programs by typing 'run_demo'
 
  "
fi
fi
