c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c     Specific routines for callable interface to Postmini
c
      subroutine store_callable_data(fw,fposy,fposx,inym,inxm,
     1                               inpty,inptx,
     2                               llinear,ctext,cunits,read_error)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'plot.cmn'
      include 'callable.cmn'
c
      integer inym, inxm, inpty, inptx
      character*(*) ctext, cunits
      real fw(inym,inxm), fposy(inym), fposx(inxm)
      logical llinear, read_error
c
      integer i,j
c
      read_error = .FALSE.
c     Is array storage large enough?
      if( MAX(inpty,inptx) .gt. COMP_ARRAYSIZE .or.
     1    (inpty*inptx) .gt. ARR2DSIZE ) then
         write(luttyo,10050) COMP_ARRAYSIZE, ARR2DSIZE
10050    format(' ','Caution: Data too large for POSTMINI arrays'/
     1          ' ','         Each dimension will be limited to no',
     1              ' more than ',i5/
     1          ' ','         Total number of data points will be ',
     2              ' limited to no more than',i5)
         read_error = .TRUE.
      endif
c
c     Copy data to callable storage
      call_nx = MIN(inpty,COMP_ARRAYSIZE)
      call_ny = MIN(inptx,COMP_ARRAYSIZE)
      do while( call_nx*call_ny .gt. ARR2DSIZE )
c        Reduce each dimension by 1
         call_nx = call_nx - 1
         call_ny = call_ny - 1
      end do
c
      do 100 i=1,call_nx
         call_x(i) = fposy(i)
100   continue
      do 110 i=1,call_ny
         call_y(i) = fposx(i)
110   continue
      do 120 j=1,call_ny
         do 120 i=1,call_nx
            call_2d(i+(j-1)*call_nx) = fw(i,j)
120   continue
c
      call_linear = llinear
      call_text   = ctext
      call_units  = cunits
c
      callable_loaded = .TRUE.
c
      return
      end
c
      subroutine load_callable_data(batchmode, read_error)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'plot.cmn'
      include 'callable.cmn'
c
      logical batchmode, read_error
c
      integer i,j, ierr
c
c     Note: routine is same for batchmode/no batchmode
c
      if( .NOT. callable_loaded ) then
         write(luttyo,10000)
10000    format(' ','Error: callable data has not been loaded ',
     1              'into memory')
         read_error = .TRUE.
         return
      endif
c
      max_menu_num = 1
c
c     get stem of binary file name
      prev_binfiletype = binfiletype
      binfiletype = DT_CALLABLE
      prev_binfilename = binfilename
      binfilename = 'callable.dat' ! for now
      call get_filestem(binfilename, binfilestem)
c
c     clear out arrays
      do 10 j=1,3
         do 10 i=1,COMP_ARRAYSIZE
            xyz(i,j) = 0.0
            edxyz(i,j) = 0.0
            dxyzm(i,j) = 0.0
10    continue
      do 20 i=1,MENUSIZE
         in_binary_file(i) = .FALSE.
20    continue
c
      nx = call_nx
      nytot = call_ny
      nz = 1
      plane_index = 1
      plane_type = XY_PLANE
      ny = nytot
      nt    = ny
c     No "oxide"
      nyoxm = 0
c     These values for nxsp and nxsoxm are innocuous (used by
c     POSTMINI to draw in source/drain contacts)
      nxsp = 2
      nxsoxm = 1
      nxy=nx*ny
      nxytot=nx*nytot
c
c     Is array storage large enough?
      if( MAX(nx,nytot) .gt. COMP_ARRAYSIZE .or.
     1    (nx*nytot) .gt. ARR2DSIZE ) then
         write(luttyo,10050)
10050    format(' ','Error: data too large for POSTMINI arrays')
         read_error = .TRUE.  ! go back
         return
      endif
c
      call zero_real_array(arrdat,ARR2DSIZE,1)
c
c     Copy data to postmini storage
      do 100 i=1,nx
         xyz(i,1) = MU2CM*call_x(i)
100   continue
      do 110 i=1,nytot
         xyz(i,2) = MU2CM*call_y(i)
110   continue
      do 120 j=1,nytot
         do 120 i=1,nx
            arrdat(i+(j-1)*nx) = call_2d(i+(j-1)*nx)
120   continue
c
      in_binary_file(1) = .TRUE.
c
c     set up boundary limits information
      call coord_limits
c
c     Load generic mesh pointers, depending on plane type
c
      call set_3d_index_limits
      cut_plane_axis = charb
      call allocate_rect_arrays(ni,nj,1,ierr)
c
c     compute some stuff related to mesh...
c
      nxm = nx - 1
      nym = ny - 1
      nytotm = nytot - 1
c
c     inverse mesh spacing...
c
      do 210 i=1,nxm
210      edxyz(i,1) = 1.0/(xyz(i+1,1) - xyz(i,1))
      do 211 i=1,nytotm
211      edxyz(i,2) = 1.0/(xyz(i+1,2) - xyz(i,2))
      do 212 i=1,nz-1
212      edxyz(i,3) = 1.0/(xyz(i+1,3) - xyz(i,3))
c
c     average mesh spacing...
c
      dxyzm(1,1)  = (xyz(2,1)  - xyz(1,1))/2.0
      dxyzm(nx,1) = (xyz(nx,1) - xyz(nx-1,1))/2.0
      do 220 i=2,nxm
220      dxyzm(i,1) = (xyz(i+1,1) - xyz(i-1,1))/2.0
c
      dxyzm(1,2)     = (xyz(2,2)  - xyz(1,2))/2.0
      dxyzm(nytot,2) = (xyz(nytot,2) - xyz(nytot-1,2))/2.0
      do 221 i=2,nytotm
221      dxyzm(i,2) = (xyz(i+1,2) - xyz(i-1,2))/2.0
c
      dxyzm(1,3)     = (xyz(2,3)  - xyz(1,3))/2.0
      dxyzm(nz,3) = (xyz(nz,3) - xyz(nz-1,3))/2.0
      do 222 i=2,nz-1
222      dxyzm(i,3) = (xyz(i+1,3) - xyz(i-1,3))/2.0
c
      call load_callable_specific(call_text,call_linear,call_units)
c
      datafile_loaded = .TRUE.
      prev_binfilename = binfilename
      prev_binfiletype = binfiletype
c
      if( lfirst_read .eq. .TRUE. ) then
         lfirst_read = .FALSE.
         prev_plane_type = plane_type
      endif
c
      return
      end
c
      subroutine load_callable_specific(ctext,llinear,cunits)
      implicit none
c
c     Load descriptive arrays with "general data" specific data
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'data.cmn'
c
      logical llinear
      character*(*) ctext, cunits
c
c     Data varies linear or logarithmic
      integer LOG, LIN
      parameter (LOG = .TRUE., LIN = .FALSE.)
c     Data has value in oxide, or not
      integer OX, NO_OX
      parameter (OX = .TRUE., NO_OX = .FALSE.)
c     Data jumps at oxide interfaces
      integer JUMP, NO_JUMP
      parameter (JUMP = .TRUE., NO_JUMP = .FALSE.)
c     Data is 1D or 2D
      integer ONED, TWOD
      parameter (ONED = .TRUE., TWOD = .FALSE.)
c
c     Locals
      character*20 nickname, units_1dint, units_2dint
      character*10 ext
      integer ilen, string_len
c
c     File has 2d data
      three_d = .FALSE.
c
      ext = '.dat'
      nickname = ctext
      call upcase(nickname)
      ilen = string_len(cunits)
      units_1dint = cunits(1:ilen) // ' cm'
      units_2dint = cunits(1:ilen) // ' ^{cm}'
c
      if( llinear ) then
         call load_desc_arr(1, ctext, nickname,
     1                      cunits,units_1dint,units_2dint,ext,
     2                      LIN,OX,NO_JUMP,TWOD,1)
      else
         call load_desc_arr(1, ctext, nickname,
     1                      cunits,units_1dint,units_2dint,ext,
     2                      LOG,OX,NO_JUMP,TWOD,1)
      endif
c
c     Array index of net doping
      net_dop_array_index = 0
c
c
      return
      end
c
      subroutine load_callable_xy_data(batchmode, err)
      implicit none
c
c     DUMMY SUBROUTINE FOR TESTING
c
      logical batchmode, err
c
      err = .FALSE.
c
      return
      end
c
      subroutine pmclxy
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare.cmn'
      include 'callable.cmn'
c
      integer i
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
c     Mark all data as erased
      do 10 i=1,MULTI_SIZE
         in_use(i) = .FALSE.
         slot_index(i) = -1
10       continue
      n_cuts = 0
c
c     Tell compare menu routines that things have been reset
      comp_lfirst = .TRUE.
c
c     Initialize side label counter
      callable_num_sidelabels = 0
c
c     Clear title(s)
      callable_num_titles = 0
c
      return
      end
c
      subroutine pmadxy(xd, yd, nd,
     1                  rreal, iint, llog, cchar,
     1                  nreal, nint, nlog, nchar,
     2                  ierr, icode1, icode2)
      implicit none
c
c     Callable interface to the compare plot subsystem of Postmini
c
c     Programmer: John Faricelli
c     Date:    12-May-92
c
c     Input arguments:
c
c     XD     (real)     Real    X coordinates
c     YD     (real)     Real    Y coordinates
c     ND     (integer)  Size of XD, YD <= COMP_ARRAYSIZE
c     RREAL  (real)     Real    information array
c     IINT   (integer)  Integer information array
c     LLOG   (logical)  Logical information array
c     CCHAR  (char*(*)) Character information array
c     NREAL  (integer)  Size of RREAL
c     NINT   (integer)  Size of IINT
c     NLOG   (integer)  Size of LLOG
c     NCHAR  (integer)  Size of CCHAR
c     IERR   (integer)  Error flag
c     ICODE1 (integer)  Error code1
c     ICODE2 (integer)  Error code2
c
c     Note: we declare the one dimensional info arrays as (*), so that
c     we don't crash if the corresponding size is input as zero.
c
      integer nd, nreal, nint, nlog, nchar
      real    xd(nd), yd(nd)
c     Actual: nreal
      real    rreal(*)
c     Actual: nint
      integer iint(*)
      integer ierr, icode1, icode2
c     Actual: nlog
      logical llog(*)
c     Actual: nchar
      character*(*) cchar(*)
c
c     For this prototype, the following information array data is
c     required.
c
c     rreal( 1) -- Marker size    (> 0.0)
c
c     iint ( 1) -- Color of curve     (>= 0, 0 = invisible)
c     iint ( 2) -- Linetype of curve  (>= 1)
c     iint ( 3) -- Marker color       (>= 0, 0 = invisible)
c     iint ( 4) -- Marker type        (>= 1)
c
c     cchar( 1) -- ID string to identify curve
c
c     The following information is optional
c
c     llog ( 1) -- Data is assumed to consist of several curves
c                  in one dataset. If .TRUE. (non-zero),
c                  suppress 'retraces' when plotting.
c
c     llog ( 2) -- Data varies on a logarithmic scale.
c                  If all datasets loaded are log scale,
c                  then a log scale will be used when plotting.
c
c     This subroutine makes only basic checks for validity
c
c     On return:
c
c     IERR (integer) -- Error return code
c                       0 = No error
c                       1 = Too many X-Y curves
c                       2 = X-Y data too large
c                       3 = Invalid number of info arguments
c                       4 = Invalid info argument
c     ICODE1 (integer) -- If IERR=3,4 then gives which info array was invalid
c                         1 = RREAL
c                         2 = IINT
c                         3 = LLOG
c                         4 = CCHAR
c
c     ICODE2 (integer) -- If IERR=4, then gives index of particular info
c                         array which was invalid.
c
c     In the case of multiple invalid info arrays, the first error
c     is reported. This facility is provided mainly as a debugging tool
c     for the developer.
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare.cmn'
      include 'user.cmn'
      include 'units.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'callable.cmn'
c
      integer entry, find_new_entry, i, xtag, ytag
      real    dummy(2), mx, my, ax, ay, linewidth
      logical do_log, lsuppress, xabs, yabs
      character*(PM_MAX_EXPRLEN) x_expression, y_expression
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
      ierr = 0
      icode1 = 0
      icode2 = 0
c
c     First, validity checks:
      if( nreal .lt. 1 ) then
         ierr = 3
         icode1 = 1
         return
      endif
      if( rreal(1) .le. 0.0 ) then
         ierr = 4
         icode1 = 1
         icode2 = 1
         return
      endif
c
      if( nint .lt. 4 ) then
         ierr = 4
         icode1 = 2
         return
      endif
c     Color
      if( iint(1) .lt. 0 ) then
         ierr = 4
         icode1 = 2
         icode2 = 1
      endif
c     Linetype
      if( iint(2) .lt. 1 .and. iint(1) .ne. 0 ) then
         ierr = 4
         icode1 = 2
         icode2 = 2
      endif
c     Marker color
      if( iint(3) .lt. 0 ) then
         ierr = 4
         icode1 = 2
         icode2 = 3
      endif
c     Marker type
      if( iint(4) .lt. 1 .and. iint(3) .ne. 0 ) then
         ierr = 4
         icode1 = 2
         icode2 = 4
      endif
c
      if( nchar .lt. 1 ) then
         ierr = 3
         icode1 = 4
         return
      endif
c
c     Check for invalid size of X-Y array
      if( nd .le. 0 .or. nd .gt. COMP_ARRAYSIZE) then
         ierr = 2
         return
      endif
c
c     PROTOTYPE CODE: load data directy into PM storage
c                     rather than a temporary store
c
c     Check for too many curves
      entry = find_new_entry()
      if( entry .eq. -1 ) then
         ierr = 1
         return
      endif
c
      user_1d_n_ycols = 1
      if( user_1d_array_size .eq. 0 ) then
         user_1d_array_size = COMP_ARRAYSIZE
         user_1d_data_ptr   = pm_malloc(4*user_1d_array_size)
         user_1d_coord_ptr  = pm_malloc(4*user_1d_array_size)
         user_1d_zval_ptr   = pm_malloc(4*user_1d_array_size)
      endif
c
      do 100 i=1,nd
         user_1d_coord(i) = pm_scale_plot2cm*xd(i)
100   continue
c
      binfiletype = DT_CALLABLE_XY
      binfilename = ' '
c     Add dummy values for axis tags for now
      xtag = 1
      ytag = 1
      lsuppress = .FALSE.
c
      if( nlog .ge. 1 ) then
         user_1d_sweep = llog(1)
      else
         user_1d_sweep = .FALSE.
      endif
c
      if( nlog .ge. 2 ) then
         do_log = llog(2)
      else
         do_log = .FALSE.
      endif
c
c     Add dummy values for scale factors for now
      ax = 0.0
      mx = 1.0
      ay = 0.0
      my = 1.0
      linewidth = 1.0
      xabs = .FALSE.
      yabs = .FALSE.
      x_expression = ' '
      y_expression = ' '
c
      call copy_data_to_slot(entry, yd, nd,
     1     user_1d_coord, 0.0, '?',
     3     ' ', 'ASCII', ' ', COMP_USER_TYPE, dummy,
     4     cchar(1), iint(1), iint(2), linewidth, iint(4), iint(3),
     5     rreal(1), xtag, ytag, lsuppress, mx, ax, my, ay,
     6     xabs, yabs, do_log, x_expression, y_expression)
c
      return
      end
c
      subroutine set_axis_callable(rreal, iint, llog, cchar,
     1     nreal, nint, nlog, nchar)
      implicit none
c
c     Note: we declare the one dimensional arrays as (*), so that
c     we don't crash if the corresponding size is input as zero.
c
      integer nreal, nint, nlog, nchar
c     Actual: nreal
      real rreal(*)
c     Actual: nint
      integer iint(*)
c     Actual: nlog
      logical llog(*)
c     Actual: nchar
      character*(*) cchar(*)
c
      include 'const.h'
      include 'callable.cmn'
c
c     Set axis parameter flag
      callable_axis_is_set = .TRUE.
c
c     For now, we just support setting the axis labels and units
      if( nchar .ge. 1 ) then
         callable_hlabel = cchar(1)
      else
         callable_hlabel = ' '
      endif
      if( nchar .ge. 2 ) then
         callable_vlabel = cchar(2)
      else
         callable_vlabel = ' '
      endif
      if( nchar .ge. 3 ) then
         callable_hunits = cchar(3)
      else
         callable_hunits = ' '
      endif
      if( nchar .ge. 4 ) then
         callable_vunits = cchar(4)
      else
         callable_vunits = ' '
      endif
c
      if( nlog .ge. 2 ) then
         callable_xlog = llog(2)
      else
         callable_xlog = .FALSE.
      endif
      if( nlog .ge. 3 ) then
         callable_ylog = llog(3)
      else
         callable_ylog = .FALSE.
      endif
c
      return
      end
c
      subroutine get_axis_callable(
     1      comp_h_min, comp_h_max,
     2      comp_h_exponent, comp_h_tic_major,
     3      comp_h_minor_tic_freq,
     4      comp_hunits,
     5      comp_horiz_label, do_hlog, do_habs,
     6      vmin_plot, vmax_plot,
     7      v_exponent, v_tic_major, v_minor_tic_freq, comp_vunits,
     8      comp_vert_label, do_vlog, do_vabs)
      implicit none
c
      real comp_h_min, comp_h_max, comp_h_tic_major
      integer comp_h_exponent, comp_h_minor_tic_freq
      character*(*) comp_hunits, comp_horiz_label
      logical do_hlog, do_habs
c
      real vmin_plot, vmax_plot, v_tic_major
      integer v_exponent, v_minor_tic_freq
      character*(*) comp_vunits, comp_vert_label
      logical do_vlog, do_vabs
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'data.cmn'
      include 'callable.cmn'
c
      integer idum, plot_mode
      real rdum1, rdum2
      logical do_huscale, do_vuscale
c
c     Check to see if we have set axis parameters from the callable
c     interface or not
      if( .NOT. callable_axis_is_set ) return
c
c     Reset flag, so that on next plot, we don't override anything that
c     the user has changed
      callable_axis_is_set = .FALSE.
c
c     For now, we just support setting the axis labels and units
      comp_horiz_label = callable_hlabel
      comp_hunits      = callable_hunits
c
      comp_vert_label = callable_vlabel
      comp_vunits     = callable_vunits
c
      if( callable_xlog ) then
         do_hlog = .TRUE.
         do_habs = .TRUE.
         idum = 0
         do_huscale = .FALSE.
         call recompute_minmax_coords(rdum1, rdum2,
     1           comp_h_min, comp_h_max, comp_h_tic_major,
     2           comp_h_minor_tic_freq,
     3           idum, comp_h_exponent,
     4           do_habs, do_hlog, do_huscale, 1,
     5           work_vec(1,1))
      endif
c
      if( callable_ylog ) then
         do_vlog = .TRUE.
         do_vabs = .TRUE.
         idum = 0
         do_vuscale = .FALSE.
         plot_mode = 1
         call recompute_minmax_comp(
     1           rdum1, rdum2,
     2           vmin_plot, vmax_plot,
     3           v_tic_major, v_minor_tic_freq,
     4           idum, v_exponent,
     5           do_vabs, do_vlog, do_vuscale,
     6           1, work_vec(1,1), plot_mode)
      endif
c
      return
      end
c
      subroutine pmlab(label,ierr)
      implicit none
c
c     Callable interface to the compare plot subsystem of Postmini
c     Function: Add a label on the right side of the comparison plot
c
c     Programmer: John Faricelli
c     Date:    22-Feb-93
c
c     Input arguments:
c
c     LABEL  (char*(*)) Label to be plotted
c     IERR   (integer)  Error flag
c
      integer ierr
      character*(*) label
c
c     On return:
c
c     IERR (integer) -- Error return code
c                       0 = No error
c                       1 = Too many labels (max: CALLABLE_MAX_LABELS)
c
      include 'const.h'
      include 'callable.cmn'
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
c     Check for overflow of internal storage
      if( callable_num_sidelabels + 1 .gt. CALLABLE_MAX_LABELS ) then
         ierr = 1
      else
c        Else squirrel away the label in private callable storage
         callable_num_sidelabels = callable_num_sidelabels + 1
         callable_sidelabels(callable_num_sidelabels) = label
         ierr = 0
      endif
c
      return
      end
c
      subroutine callable_draw_sidelabels
      implicit none
c
c     Draw labels at side of "compare" graph
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'plot.cmn'
      include 'compare.cmn'
      include 'callable.cmn'
c
      integer i
      real    offset, xndc0, yndc0, xndc1, yndc1, h1, h2,
     1        xextent, yextent, xoffset, yoffset
c
      call pm_get_compare_plot_ndc_space(xndc0, yndc0, xndc1, yndc1)
      xextent = (xndc1 - xndc0)
      yextent = (yndc1 - yndc0)
      xoffset = 0.5*(1.0 - xextent)
      yoffset = 0.5*(1.0 - yextent)
c
c     Magic constants are amount window must be expanded on each side
c     to keep in proportion with compare plot window,
c     but with full viewport in y. They scale with the ratio EXTENT/100
c     for the plot window size used. EXTENT depends if we are using the
c     POSTMINI or CURV window extents
c        The lower y window:  (0.0 - yndc0)/x
c        The upper y window:  (1.0 - (yndc0 + EXTENT))/x
      h1 = -yndc0/yextent
      h2 = 1.0 + (1.0 - (yndc0 + yextent))/yextent
      call GKS$SET_WINDOW  (1, 0.0, 0.15, h1, h2)
      call GKS$SET_VIEWPORT(1, (xndc1)*ratio_x,
     1                         (xndc1+0.175)*ratio_x,
     2                         0.0*ratio_y, ratio_y)
      call GKS$SET_CLIPPING(GKS$K_NOCLIP)
      call GKS$SELECT_XFORM(1)
c
c     Character sizes tuned for approx. 15-18 characters width
c     (depends on particular text used)
      call tune_charsize(0.010, 0.04, -0.2, 0.010, 0.028, 0.0)
c
c     Maximum number of labels is 30, the following offset should
c     allow this: 1.0 - 0.04*(30-1) = -0.2, which is less than
c     the minimum Y window (-0.3846)
      do 100 i=1,callable_num_sidelabels
         offset = 1.0 - 0.04*FLOAT(i-1)
         call gks$text(0.01,offset,callable_sidelabels(i))
100   continue
c
      return
      end
c
      subroutine pmdef(inum,rreal,iint,llog,cchar,ierr)
      implicit none
c
c     Callable interface to set a default value in callable Postmini
c
c     Programmer: John Faricelli
c     Date:    8-Mar-93
c
c     Input arguments:
c
c     INUM   (integer)  ID of value to be set
c     RREAL  (real)     Input value (may be a dummy)
c     IINT   (integer)  Input value (may be a dummy)
c     LLOG   (logical)  Input value (may be a dummy)
c     CCHAR  (character)Input value (may be a dummy)
c     IERR   (integer)  Error flag
c
c     Valid ID codes
c
c     INUM = 1    Set default hardcopy device name from cchar
c                 'postscript','color_postscript','hp7550','eps',
c                 'color_eps','ddif','lj250','lj250hires','ln03plus'
c
c     INUM = 2    Set default plot device from cchar
c                 'motif','vt240','vt240bw','vt330','vt340'
c
      real    rreal
      integer inum, iint, ierr
      character*(*) cchar
      logical llog
c
c     On return:
c
c     IERR (integer) -- Error return code
c                       0 = No error
c                       1 = ID (inum) out of range
c                       2 = Invalid value
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'plot.cmn'
      include 'callable.cmn'
c
      character*10 device
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
      ierr = 0
      if( inum .eq. 1 ) then
c        Set default hardcopy name
         default_hc_name = cchar
         if( default_hc_name .eq. 'postscript' ) then
            hardcopy_device = GKS$K_POSTSCRIPT
            hardcopy_colormap = COLORMAP_NONE
         elseif( default_hc_name .eq. 'color_postscript' ) then
            hardcopy_device = GKS$K_COLOR_POSTSCRIPT
            hardcopy_colormap = COLORMAP_COLOR
         else if( default_hc_name .eq. 'eps' ) then
            hardcopy_device = GKS$K_EPSF
            hardcopy_colormap = COLORMAP_NONE
         else if( default_hc_name .eq. 'color_eps' ) then
            hardcopy_device = GKS$K_COLOR_EPSF
            hardcopy_colormap = COLORMAP_COLOR
         else if( default_hc_name .eq. 'lj250' ) then
            hardcopy_device = GKS$K_LJ250
            hardcopy_colormap = COLORMAP_COLOR
         else if( default_hc_name .eq. 'lj250hires' ) then
            hardcopy_device = GKS$K_LJ250_180DPI
            hardcopy_colormap = COLORMAP_COLOR
         else if( default_hc_name .eq. 'ddif' ) then
            hardcopy_device = GKS$K_DDIF
            hardcopy_colormap = COLORMAP_COLOR
         else if( default_hc_name .eq. 'hp7550' ) then
            hardcopy_device = GKS$K_HP7550
            hardcopy_colormap = COLORMAP_COLOR
         else if( default_hc_name .eq. 'ln03plus' ) then
            hardcopy_device = GKS$K_LN03_PLUS
            hardcopy_colormap = COLORMAP_NONE
         else
c           Invalid hardcopy name
            ierr = 2
         endif
      elseif( inum .eq. 2 ) then
c        Set default plot name
         device = cchar
         call upcase(device)
         if( device .eq. 'MOTIF' ) then
c           Motif with 16 entry colormap
            plot_device = IOR(GKS$K_MOTIF,'00100000'X)
         elseif( device.eq. 'VT240BW' ) then
            plot_device = GKS$K_VT240BW
         elseif( device.eq. 'VT240' ) then
            plot_device = GKS$K_VT240
         elseif( device.eq. 'VT330' ) then
c           VT330 with no mouse, restore colormap on exit
            plot_device = IOR(GKS$K_VT330,GKS$M_NOPOINTER)
            plot_device = IOR(plot_device,'01000000'X)
         elseif( device.eq. 'VT340' ) then
c           VT340 with no mouse, restore colormap on exit
            plot_device = IOR(GKS$K_VT340,GKS$M_NOPOINTER)
            plot_device = IOR(plot_device,'01000000'X)
         else
c           Invalid device name
            ierr = 2
         endif
      else
         ierr = 1
      endif
c
      return
      end
c
      subroutine pmtitl(label,ierr)
      implicit none
c
c     Callable interface to the compare plot subsystem of Postmini
c     Function: Add a title line on the top of the comparison plot
c
c     Programmer: John Faricelli
c     Date:    11-Mar-93
c
c     Input arguments:
c
c     LABEL  (char*(*)) Title to be plotted
c     IERR   (integer)  Error flag
c
      integer ierr
      character*(*) label
c
c     On return:
c
c     IERR (integer) -- Error return code
c                       0 = No error
c                       1 = Too many labels (max: CALLABLE_MAX_TITLES)
c
      include 'const.h'
      include 'callable.cmn'
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
c     Check for overflow of internal storage
      if( callable_num_titles + 1 .gt. CALLABLE_MAX_TITLES ) then
         ierr = 1
      else
c        Else squirrel away the label in private callable storage
         callable_num_titles = callable_num_titles + 1
         callable_titles(callable_num_titles) = label
         ierr = 0
      endif
c
      return
      end
c
      subroutine pmcltl
      implicit none
c
c     Callable interface to the compare plot subsystem of Postmini
c     Function: Clear title lines on the top of the comparison plot
c
c     Programmer: John Faricelli
c     Date:    11-Mar-93
c
c     Input arguments:
c
c     None
c
      include 'const.h'
      include 'callable.cmn'
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
      callable_num_titles = 0
c
      return
      end
c
      subroutine pmcllb
      implicit none
c
c     Callable interface to the compare plot subsystem of Postmini
c     Function: Clear side label strings for comparison plot
c
c     Programmer: John Faricelli
c     Date:    11-Mar-93
c
c     Input arguments:
c
c     None
c
      include 'const.h'
      include 'callable.cmn'
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
      callable_num_sidelabels = 0
c
      return
      end
c
      subroutine pmclos
      implicit none
c
c     Closes GKS graphics cleanly
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'plot.cmn'
      include 'callable.cmn'
c
c     init_common will only allow one intialization, so it's safe to
c     call anywhere.
      call init_common
c
      if( gks_is_open ) call close_gks
c
      return
      end
