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     Postmini operating system dependent routines
c
c     Microsoft Windows (32 bit) version
c
c     Assumes that long file names (> 8.3) are available,
c     e.g. Windows95 or Windows-NT
c
c     Some of these routines emulate subroutines from in the Digital Unix
c     "3f" manual section.
c
c     Some are wrappers around the appropriate system dependent function
c
CC      Function unlink is in the PORTLIB library
CC      integer function unlink(name)
c
      integer function pm_getcwd(name)
      use dfport
      implicit none
c
      character*(*) name
c
c     Function getcwd is defined in the dfport module
c
      pm_getcwd = getcwd(name)
c
      end
c
      subroutine spawn_subprocess(parent, prompt)
      use dfport
      implicit none
c
      character*(*) parent, prompt
c
      include 'sysdep.cmn'
      include 'io.cmn'
c
      integer rc, get_logical_name
      character*32 translation
c
c     This procedure spawns a subprocess to run shell commands from
c     an application program. Setting the prompt is not supported.
c     When the user types exit, the process is terminated,
c     and control is returned to this subroutine.
c     The string 'parent' is the name of the program.
c
      write(luttyo,100) parent
100   format(' ','Enter exit to return to ',A/
     1       ' ','Creating a new process...'/
     2       ' ')
      if( get_logical_name('OS',translation) .eq. 0 ) then
         if( translation .eq. 'Windows_NT' ) then
            rc = system('C:\WINNT\system32\cmd.exe')
         else
            rc = system('C:\COMMAND.COM')
         endif
      else
         rc = system('C:\COMMAND.COM')
      endif
c
      return
      end
c
      subroutine add_extension(string, extension)
      implicit none
c
c     Adds an extension to a filename, if none is there already.
c
      character*(*) string, extension
c
c     locals
c
      integer ilen, ilen2, i, string_len
      logical no_extension, lexist
c
c     Check for file existance without adding extension
c     If file exists, return
      inquire(file=string,exist=lexist)
      if( lexist ) return
c
      no_extension = .TRUE.
c     Find length minus blanks
      ilen  = string_len(string)
      ilen2 = string_len(extension)
c     If string isn't long enough to hold name plus extension, return
      if( LEN(string) .lt. (ilen+ilen2) ) return
c
      do 100 i=ilen,1,-1
c        Look for file extension period, exit if found
         if( string(i:i) .eq. '.' ) then
            no_extension = .FALSE.
            goto 101
         endif
c        Look for directory name slash, exit if found
         if( string(i:i) .eq. '\' ) goto 101
100   continue
c
101   if( no_extension ) then
         if( ilen .ne. 0 ) then
            string = string(1:ilen) // extension(1:ilen2)
         else
c           An empty file name. Put up a safety net.
            string = extension
         endif
      endif
c
      return
      end
c
      subroutine replace_extension(string, extension)
      implicit none
c
c     Adds an extension to a filename. If one is there already, replace it.
c
      character*(*) string, extension
c
c     locals
c
      integer ilen, ilen2, i, j, string_len
      logical no_extension
c
      no_extension = .TRUE.
c     Find length minus blanks
      ilen  = string_len(string)
      ilen2 = string_len(extension)
c     If string isn't long enough to hold name plus extension, return
      if( LEN(string) .lt. (ilen+ilen2) ) return
c
      do 100 i=ilen,1,-1
c        Look for file extension period, exit loop if found
         if( string(i:i) .eq. '.' ) then
            no_extension = .FALSE.
            j = i
            goto 101
         endif
c        Look for directory name slash, exit loop if found
         if( string(i:i) .eq. '\') goto 101
100   continue
c
101   if( no_extension ) then
         if( ilen .ne. 0 ) then
            string = string(1:ilen) // extension(1:ilen2)
         else
c           An empty file name. Put up a safety net.
            string = extension
         endif
      else
         if( j .eq. 1 ) then
            string = extension(1:ilen2)
         else
            string = string(1:j-1) // extension(1:ilen2)
         endif
      endif
c
      return
      end
c
      subroutine get_filestem(filename, stem)
      implicit none
c
c     Extracts the file stem from a filespec, deleting any directory
c     or extension.
c
      character*(*) filename, stem
c
c     locals
      integer i, idot, idirend, ilen, string_len
c
      ilen = string_len(filename)
c
c     strip off preceeding directories, if any...
      idirend = ilen
      do 100 i=ilen,1,-1
         if( filename(i:i) .eq. '\' ) goto 101
         idirend = i - 1
100   continue
101   continue
c
      if( idirend .eq. ilen ) then
c        No filename or type
         stem = ' '
         return
      endif
c
      idot = ilen
      do 200 i=ilen,idirend+1,-1
         if( filename(i:i) .eq. '.' ) goto 201
         idot = i - 1
200   continue
201   continue
      if( idot .eq. idirend ) then
c        didn't find extension
         stem = filename(idirend+1:ilen)
      else if( idot .eq. idirend+1 ) then
c        Found only extension
         stem = ' '
      else
         stem = filename(idirend+1:idot-1)
      endif
c
      return
      end
c
      subroutine get_extension(filename, extension)
      implicit none
c
c     Extracts the file extension from a filespec, deleting any directory
c     or extension.
c
      character*(*) filename, extension
c
c     locals
      integer i, idot, idirend, ilen, string_len
c
      ilen = string_len(filename)
c
c     strip off preceeding directories, if any...
      idirend = ilen
      do 100 i=ilen,1,-1
         if( filename(i:i) .eq. '\' ) goto 101
         idirend = i - 1
100   continue
101   continue
c
      if( idirend .eq. ilen ) then
c        No filename or type
         extension = ' '
         return
      endif
c
      idot = ilen
      do 200 i=ilen,idirend+1,-1
         if( filename(i:i) .eq. '.' ) goto 201
         idot = i - 1
200   continue
201   continue
      if( idot .eq. idirend ) then
c        didn't find extension
         extension = ' '
      else
         extension = filename(idot:ilen)
      endif
c
      return
      end
c
      subroutine get_dirspec(filename, directory)
      implicit none
c
c     Extracts the directory information from a filespec
c
      character*(*) filename, directory
c
c     locals
      integer i, idot, idirend, ilen, string_len
c
      ilen = string_len(filename)
c
c     Look for directory marker, if any...
      idirend = ilen
      do 100 i=ilen,1,-1
         if( filename(i:i) .eq. '\' ) goto 101
         idirend = i - 1
100   continue
101   continue
c
      if( idirend .eq. 0 ) then
c        No directory
         directory = '.\'
      else
         directory = filename(1:idirend)
      endif
c
      return
      end
c
      integer function get_logical_name(logical_name,translation)
      use dfport
      implicit none
c
      include 'sysdep.cmn'
c
c     Looks up the string 'logical name' in the environment
c     and returns its value.
c
c     If translation is found, function returns zero.
c     Otherwise, it returns the getenv return code
c     and translation is set to all blanks.
c
      character*(*) logical_name,translation
c
      integer ilen, string_len
c
      ilen = string_len(logical_name)
      if( logical_name(1:ilen) .eq. PM_X_DISPLAY ) then
         translation = 'NULL'
         get_logical_name = 0
         return
      endif
      call getenv(logical_name(1:ilen),translation)
      ilen = string_len(translation)
      if( ilen .eq. 0 ) then
         get_logical_name  = 1
      else
         get_logical_name = 0
      endif
      return
      end
c
CC      get_term_display_size for Ultrix is implemented in C
CC      subroutine get_term_display_size(rows,cols)
c
      subroutine expand_filename(input_filespec,expanded_name)
      implicit none
c
      character*(*) input_filespec, expanded_name
c
c     Function takes a file specification and returns an expanded
c     file specification. The expansion follows these rules:
c
c        1) If the input file spec does not have a directory
c           specified, the current default directory is prepended.
c           Otherwise, the file spec is unchanged.
c        2) The disk name is not added.
c
c     locals
c
      integer i, ilen, idirstart, rcode, string_len, pm_getcwd
      character*256 dirspec
c
c     look for start of directory, if any...
      ilen = string_len(input_filespec) ! get length minus trailing blanks
      do 10 i=1,ilen
         idirstart = i
         if( input_filespec(i:i) .eq. '\' ) goto 11
10       continue
11    continue
      if( idirstart .eq. ilen ) then  ! no directory, prepend default
c        Get default directory
         rcode = pm_getcwd(dirspec)  ! get current directory
         if( rcode .ne. 0 ) then
            write(6,1000)
1000        format(' ','(expand_filename): Error in call to ',
     $                 'getcwd()'/
     $             ' ','Unable to obtain default directory info')
            expanded_name = input_filespec
         else
            ilen = string_len(dirspec)
            expanded_name = dirspec(1:ilen) // '\' // input_filespec
         endif
      else  ! just return string
         expanded_name = input_filespec
      endif
      return
      end
c
      subroutine make_plotfile_name(filename,stem,extension)
      use dfport
      implicit none
c
      character*(*) filename, stem, extension
c
c     Creates a filename for plot files from the file stem and
c     extension. This is mostly needed for Ultrix, which doesn't
c     support file versions.
c
c     Extension should have the dot in it (e.g. '.ps')
c
c     access() is defined in module dfport
      integer i1, i2, iver, string_len
      character*12 form
c	
      i1 = string_len(stem)
      i2 = string_len(extension)
      filename = stem(1:i1) // extension(1:i2)
c
c     A file by this name may already exist. Check for existance.
c     If so, add a "version number" to file name until we get
c     a file that doesn't exist already. Up to 9999 versions supported.
c
      iver = 1
      form = '(a,''.'',i1,a)'
c     Access with "mode" of "blank" returns 0 if file exists
100   if( access(filename,' ') .ne. 0 ) goto 1000
         if( iver .gt. 9999 ) goto 1000
         if( iver .lt. 10 ) then
            form(9:9) = '1'
         else if( iver .lt. 100 ) then
            form(9:9) = '2'
         else if( iver .lt. 1000 ) then
            form(9:9) = '3'
         else
            form(9:9) = '4'
         endif
         write(filename,form) stem(1:i1), iver, extension(1:i2)
         iver = iver + 1
      goto 100
c
1000  continue
c
      return
      end
c
CC    Functions iargc and getarg are in the native Ultrix f77 library
c
      subroutine get_parent_directory(filename,directory)
      implicit none
c
      character*(*) filename, directory
c
c
c     Return parent directory of filename into directory
c
c     Example:  /usr/users/faricell/vlsicap/l3d_files/data.l3d  ->
c               /usr/users/faricell/vlsicap
c
c     Restriction: Routine does not check to see if filename is
c                  a directory. If so, it may give the parent's parent
c                  directory.
c                  It does not handle file specs with .. in them
c                  very well either (i.e. it's broken).
c
c     locals
      integer i, j, dirend
c
      dirend = 0
      do i=LEN(filename),1,-1
         if( filename(i:i) .eq. '\' ) then
            dirend = i
            goto 100
         endif
      end do
100   continue
c
      if( dirend .eq. 0 ) then
c        No directory in file spec
         directory = '..'
      else if( dirend .eq. 1 ) then
c        Root directory
         directory = '\'
      else
         j = 0
         do i=dirend-1,1,-1
c           Look for subdirectory marker
            if( filename(i:i) .eq. '\' ) then
               j = i
               goto 200
            endif
         end do
200      continue
         if( j .eq. 0 ) then
c           Only one directory in file spec
            directory = '.'
         else
            directory = filename(1:j-1)
         endif
      endif
c
      return
      end
c
      subroutine add_subdirectory(directory,subdirectory)
      implicit none
c
      character*(*) directory, subdirectory
c
c     Appends subdirectory onto directory in a manner appropriate
c     to the operating system such that a file name can be appended.
c
c     Example:  directory = '/usr/users/faricelli', subdirectory = 'pisces' ->
c               directory = '/usr/users/faricelli/pisces/'
c
      integer ilen1, ilen2, string_len
c
      ilen1 = string_len(directory)
      ilen2 = string_len(subdirectory)
c
      if( ilen1 .eq. 0 .and. ilen2 .eq. 0 ) then
         return
      else if( ilen2 .eq. 0 ) then
         directory = directory(1:ilen1) // '\'
      else if( ilen1 .eq. 0 ) then
         directory = subdirectory(1:ilen2) // '\'
      else
         directory = directory(1:ilen1) // '\' //
     1               subdirectory(1:ilen2) // '\'
      endif
c
      return
      end
c
      subroutine get_homedir(directory)
      use dfport
      implicit none
c
c     Returns home directory in such a way that a filename can be
c     appended to it and result in a valid pathname.
c     If home directory can not be found, then directory is set
c     to all blanks.
c
      character*(*) directory
c
      integer i, string_len
c
      call getenv('HOME',directory)
      i = string_len(directory)
      if( i .ne. 0 .and. i .lt. LEN(directory) ) then
         directory(i+1:i+1) = '\'
      endif
c
      return
      end
c
      subroutine get_command_line_args(larg_err)
      use dflib
      use dfport
      implicit none
c
c     Read command line arguments. If none, return
c
c     Ultrix style options
c
c     Arguments supported:
c
c     arg1 -- data file
c     arg2 -- data file type. If not supplied, it is 'guessed' from the
c     datafile extension (or user is queried).
c
c       -batch            Batch mode processing of PMI file
c       -device name      Plot device type
c       -scale  n         Hardcopy plot scale size, 0.1 <= n <= 1.0
c       -o      filename  Hardcopy output file
c       -gray             Gray scale color
c       -inverse_gray     Inverted gray scale color
c       -portrait         Portrait orientation
c       -convert type     Conversion for binary file data (SPICE3 for now)
c     
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'plot.cmn'
      include 'user.cmn'
      include 'defaults.cmn'
      include 'analytical.cmn'
c
      logical read_error, larg_err
c     function iargc is defined in module dfport
      integer narg, type, i, optcnt, parcnt, iequal,
     1        ilen, rc, string_len
      real    scale
      character*1 ch
      character*10 file_type
      character*(PM_MAX_PATHLEN) buffer, file_name, stem
      character*60  extension
c
      optcnt = 0
      parcnt = 0
      larg_err = .FALSE.
c
      narg = iargc()
c
      if( narg .le. 0 ) then
         return
      else
c        parse arguments
         i=0
200      if( i .ge. narg ) goto 300
            i=i+1
            call getarg(i, buffer)
            if( buffer(1:1) .eq. '-' ) then
c              option
               optcnt = optcnt + 1
               if( buffer(2:6) .eq. 'batch' ) then
                  lbatch = .TRUE.
               elseif( buffer(2:5) .eq. 'gray' ) then
                  if( l_inv_gray_scale ) then
                     larg_err = .TRUE.
                     write(luttyo,1001)
1001                 format(' ','Error: -inverse_gray already set')
                  else
                     l_gray_scale = .TRUE.
                  endif
               elseif( buffer(2:13) .eq. 'inverse_gray' ) then
                  if( l_gray_scale ) then
                     larg_err = .TRUE.
                     write(luttyo,1002)
1002                 format(' ','Error: -gray already set')
                  else
                     l_inv_gray_scale = .TRUE.
                  endif
               elseif( buffer(2:9) .eq. 'portrait' ) then
                  hc_is_landscape = .FALSE.
               elseif( buffer(2:7) .eq. 'device' ) then
                  i=i+1
                  if( i .gt. narg ) then
                     write(luttyo,1003)
                     larg_err = .TRUE.
                     goto 400
                  else
                     call getarg(i,buffer)
                     call upcase(buffer)
                     if( buffer(1:1) .eq. 'P' ) then
                        hardcopy_device = GKS$K_POSTSCRIPT
                     else if( buffer(1:1) .eq. 'H' ) then
                        hardcopy_device = GKS$K_HP7550
                     else if( buffer(1:1) .eq. 'E' ) then
                        hardcopy_device = GKS$K_EPSF
                     else if( buffer(1:2) .eq. 'LN' ) then
                        hardcopy_device = GKS$K_LN03_PLUS
                     else if( buffer(1:7) .eq. 'LJ250_H' ) then
                        hardcopy_device = GKS$K_LJ250_180DPI
                     else if( buffer(1:2) .eq. 'LJ' ) then
                        hardcopy_device = GKS$K_LJ250
                     else if( buffer(1:7) .eq. 'COLOR_P' ) then
                        hardcopy_device = GKS$K_COLOR_POSTSCRIPT
                     else if( buffer(1:7) .eq. 'COLOR_E' ) then
                        hardcopy_device = GKS$K_COLOR_EPSF
                     else if( buffer(1:1) .eq. 'D' ) then
                        hardcopy_device = GKS$K_DDIF
                     else if( buffer(1:1) .eq. 'M' ) then
c                       IOR with bit mask which says "use 16 color map entries"
                        plot_device = IOR(GKS$K_MOTIF,'00100000'X)
                     else if( buffer(1:7) .eq. 'VT240BW' ) then
                        plot_device = GKS$K_VT240BW
                     else if( buffer(1:5) .eq. 'VT240' ) then
                        plot_device = GKS$K_VT240
                     else if( buffer(1:5) .eq. 'VT330' ) then
c                       Specify variant without mouse, restore colormap
                        plot_device = IOR(GKS$K_VT330,GKS$M_NOPOINTER)
                        plot_device = IOR(plot_device,'01000000'X)
                     else if( buffer(1:5) .eq. 'VT340' ) then
c                       Specify variant without mouse, restore colormap
                        plot_device = IOR(GKS$K_VT340,GKS$M_NOPOINTER)
                        plot_device = IOR(plot_device,'01000000'X)
                     else
c                       Try for numeric value
                        ilen = string_len(buffer)
                        read(buffer(1:ilen),*,end=203,err=203)
     1                     plot_device
                        goto 204
c                       Error handler for read statement above
203                     continue
                        write(luttyo,1000) buffer(1:ilen)
                        larg_err = .TRUE.
204                     continue
                     endif
                  endif
               elseif( buffer(2:6) .eq. 'scale' ) then
                  i=i+1
                  if( i .gt. narg ) then
                     write(luttyo,1003)
                     larg_err = .TRUE.
                     goto 400
                  else
                     call getarg(i,buffer)
                     ilen = LEN(buffer)
                     read(buffer(1:ilen),*,end=201,err=201) scale
                     if( scale .lt. 0.1 .or. scale .gt. 1.0 ) then
                        write(luttyo,1004) scale
1004                    format(' ','Scale factor out of range: ',f9.3)
                        larg_err = .TRUE.
                     else
                        hc_scale = scale
                     endif
                     goto 202
c                    Error handler for bad value on scale option
201                  ilen = string_len(buffer)
                     write(luttyo,1000) buffer(1:ilen)
                     larg_err = .TRUE.
202                  continue
                  endif
               elseif( buffer(2:2) .eq. 'o' ) then
                  i=i+1
                  if( i .gt. narg ) then
                     write(luttyo,1003)
                     larg_err = .TRUE.
                     goto 400
                  else
                     call getarg(i,buffer)
                     given_plotfilename = buffer
                     lplotfile = .TRUE.
                  endif
               else
                  ilen = string_len(buffer)
                  write(luttyo,1000) buffer(1:ilen)
                  larg_err = .TRUE.
               endif
            else
c              parameter
               parcnt = parcnt + 1
               if( parcnt .eq. 1 ) then
                  file_name = buffer
               elseif( parcnt .eq. 2 ) then
                  file_type = buffer
                  call upcase(file_type)
               endif
            endif
         goto 200
300      continue
      endif
c
400   continue
      if( larg_err ) return
c
      if( parcnt .eq. 0 ) then
         if( lbatch ) then
            write(luttyo,500)
500         format(' ','Error: must specify a PMI file in batch mode')
         endif
         return
      endif
c
      if( lbatch .and. .not. lplotfile ) then
         call get_filestem(file_name,stem)
         call make_plotfile_name(given_plotfilename,stem,'.plt')
         lplotfile = .TRUE.
         ilen = string_len(given_plotfilename)
         write(luttyo,301) given_plotfilename(1:ilen)
301      format(' ','Plot file will be called:'/' ',a)
      endif
c
      if ( parcnt .eq. 1 ) then
c        Attempt to guess file type from input file extension
         call get_extension(file_name,extension)
         call upcase(extension)
         if( extension(1:4) .eq. '.BIN' .or.
     1       extension(1:6) .eq. '.BIN3D' ) then
            file_type = 'MINIMOS'
         else if( extension(1:5) .eq. '.2DOP' .or.
     1            extension(1:4) .eq. '.DOP' ) then
            file_type = '2DOP'
         else if( extension(1:5) .eq. '.SAVE' ) then
            file_type = 'PROMIS'
         else if( extension(1:7) .eq. '.USEOUT' ) then
            file_type = 'USEOUT'
         else if( extension(1:4) .eq. '.PMI' ) then
            file_type = 'PMI'
         else if( extension(1:4) .eq. '.SPO' ) then
            file_type = 'ASCII'
         else if( extension(1:4) .eq. '.TIF' ) then
            file_type = 'TIF'
         else if( extension(1:4) .eq. '.GRP' ) then
            file_type = 'GRAPES'
         else if( extension(1:4) .eq. '.RAW' ) then
            file_type = 'SPICE3'
         else if( extension(1:4) .eq. '.DAT' ) then
            file_type = 'ASCII'
         else if( extension(1:4) .eq. '.CRV' ) then
            file_type = 'ASCII'
c        Suprem3 users commonly use .STR or .SAV for output files,
c        but there is no common extension for distinguishing
c        ASCII from BINARY SUPREM3 files.
         else
c           Give up and ask the user
            write(luttyo,100)
100         format(' ','Data file types:'/
     1      ' ','ASCII (also SPICE output file), PMI, ANALYTICAL,'/
     1      ' ','SPICE3,'/
     1      ' ','MINIMOS, PISCES, TIF, 2DOP, USEOUT,'/
     1      ' ','SUPREM3S, SUPREM3P, SUPREM4, PROMIS,'/
     1      ' ','FAIM, MCP2D, VLSICAP, BAMBI')
            file_type = 'MINIMOS'
            call get_str_with_default(file_type,
     1           'Enter data file type: ', 0)
            call upcase(file_type)
         endif
      endif
c
      read_error = .TRUE.
      if( file_type(1:1) .eq. 'M' .and.
     1         file_type(1:2) .ne. 'MC' ) then
         binfiletype = DT_MINIMOS
         binfilename = file_name
         call read_mini(.FALSE.,read_error)
      else if( file_type(1:2) .eq. 'PR' ) then
         binfiletype = DT_PROMIS
         binfilename = file_name
         call read_promis(.FALSE.,read_error)
      else if( file_type(1:2) .eq. 'PI' ) then
         binfiletype = DT_PISCES
         binfilename = file_name
         call read_pisces(.FALSE.,read_error)
      else if( file_type(1:2) .eq. 'PM' ) then
         savefilename = file_name
         call do_restore_plot(file_name,read_error)
      else if( file_type(1:1) .eq. 'V' ) then
         binfiletype = DT_VLSICAP
         binfilename = file_name
         call read_vlsicap(.FALSE.,read_error)
      else if( file_type(1:1) .eq. 'B' ) then
         binfiletype = DT_BAMBI
         binfilename = file_name
         call read_bambi(read_error)
      else if( file_type(1:1) .eq. 'U' ) then
         binfiletype = DT_USEOUT
         binfilename = file_name
         call read_useout(.FALSE.,read_error)
      else if( file_type(1:1) .eq. 'S' ) then
         if( file_type(2:2) .eq. 'P' ) then
            binfiletype = DT_SPICE3
            binfilename = file_name
            call read_spice3file(read_error)
         else if( file_type(7:7) .eq. '4' ) then
            binfiletype = DT_SUPREM4
            binfilename = file_name
            call read_sup4(.FALSE., read_error)
         else if( file_type(8:8) .eq. 'P' ) then
            binfiletype = DT_SUPREM3P
            binfilename = file_name
            type = 1
            call read_suprem3(type, read_error)
         else
            binfiletype = DT_SUPREM3S
            binfilename = file_name
            type = 2
            call read_suprem3(type, read_error)
         endif
      else if( file_type(1:1) .eq. '2' ) then
         binfiletype = DT_2DOP
         binfilename = file_name
         call read_2dop(.FALSE.,read_error)
      else if( file_type(1:1) .eq. 'T' ) then
         binfiletype = DT_TIF
         binfilename = file_name
         call read_tif(.FALSE.,read_error)
      else if( file_type(1:1) .eq. 'F' ) then
         binfiletype = DT_FAIM
         binfilename = file_name
         call read_faim(.FALSE.,read_error)
      else if( file_type(1:2) .eq. 'MC' ) then
         binfiletype = DT_MCP2D
         binfilename = file_name
         call read_mcp2d(.FALSE.,read_error)
      else if( file_type(1:2) .eq. 'AS' ) then
         binfiletype = DT_ASCII
         binfilename = file_name
         call read_ascii_file
         read_error = .NOT. have_user_1d_data
      else if( file_type(1:2) .eq. 'AN' ) then
         binfiletype = DT_ANALYTICAL
         binfilename = file_name
         call create_analytical
         read_error = .NOT. have_analytical_data
      else if( file_type(1:1) .eq. 'G' ) then
         binfiletype = DT_GRAPES
         binfilename = file_name
         call read_grapesfile(.FALSE.,read_error)
      else
         write(luttyo,101) file_type
101      format(' ','Unknown data file type: ',a)
      endif
      if( read_error ) then
         call get_char(ch, 'Hit return to continue... ', 0)
      else
          if( file_type(1:2) .ne. 'PM' .and.
     1        file_type(1:1) .ne. 'C' ) then
             lsavefile_read = .FALSE.
          endif
      endif
c
1000  format(' ','Unknown or malformed option: ',a)
1003  format(' ','Option requires an argument')
c
      return
      end
c
      subroutine usage
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'io.cmn'
c
      write(luttyo,1000)
1000  format(' ','Usage:'/
     1   ' ','postmini [options] [datafile] [filetype]'//
     2   ' ','Options:'/
     3   ' ','-batch         Non interactive plot mode'/
C     4   ' ','-o file        Output file for hardcopy plot'/
C     5   ' ','-device name   Plot device type:'/
C     5   ' ','               motif, vt340, vt330, vt240, vt240bw,'/
C     6   ' ','               postscript, color_postscript, hpgl, ddif'/
C     7   ' ','               epsf, color_epsf, ln03, lj250'/
C     8   ' ','-scale fac     Reduction scale factor for hardcopy plot'/
C     9   ' ','               0.1 <= fac <= 1.0'/
     A   ' ','-gray          Use gray scale on color output devices'/
     B   ' ','-inverse_gray  Use inverted gray scale on color output',
     C                     ' devices'/
C     D   ' ','-portrait      Plot in portrait mode on hardcopy devices'/
     F   ' ','-convert type  Type of binary data to be converted ',
     G       '(e.g. big_endian)')
c
      return
      end
c
      subroutine init_defaults(luttyo, linter)
      use dflib
      implicit none
c
c     Initialize default parameters from logicals/envars, default file
c     initialize FORTRAN I/O system if interactive (linter = .TRUE.)
c
      integer luttyo
      logical linter
c
      type (windowconfig) wc
      logical rc
      type (qwinfo) winfo
      integer irc, rgb, old_rgb
      integer*2 num_fonts, irc2
      integer font_size, string_len
      character*64 font_size_name
c
      logical lfirst
      data    lfirst/.TRUE./
      save    lfirst
CDEC$ alias for_set_reentrancy,"for_set_reentrancy"
c
c     Only initialize once
      if( lfirst ) then
         lfirst = .FALSE.
      else
         return
      endif
c
c     System specific to open terminal so it recognizes '+' carriage control
c     sequence. On other systems (e.g. SUN), a different call will be
c     needed, e.g.
c
c      logical l, ioinit
c      l = ioinit(.true., .false., .false., ' ',.false.)
CC       call for_set_reentrancy(0)
c
      if( linter ) then
c        Close stdout, then re-open with FORTRAN carriage control
c        so we can use '+' carriage control character
c         close(luttyo)
c         open(luttyo,status='unknown',carriagecontrol='FORTRAN')
c
c        Maximize frame window of Quickwin
         winfo.type = QWIN$MAX
         winfo.x = -1
         winfo.y = -1
         winfo.h = -1
         winfo.w = -1
         irc = setwsizeqq(QWIN$FRAMEWINDOW,winfo)
c
c        Open Postmini console window
         open(luttyo,status='unknown',file='USER')
c
         num_fonts = initializefonts()
c
c        Set size of console window to 25x80
c        We seem to need an extra line to avoid scrolling the console window.
         wc.numxpixels =  -1
         wc.numypixels =  -1
         wc.numtextcols = 80
         wc.numtextrows = 25
         wc.numcolors = -1
         font_size =  #0007000F   ! 7x15 font default
         call get_logical_name('PM_FONT_SIZE',font_size_name)
         if( string_len(font_size_name) .ne. 0 ) then
            read(font_size_name,*,end=100) font_size
100         continue
         endif
         wc.fontsize = font_size
         wc.title = 'Postmini Console'C
         rc = setwindowconfig(wc)
         irc2 = displaycursor($GCURSORON)
c        Maximize console window
         winfo.type = QWIN$SET
         winfo.x = 0
         winfo.y = 0
         winfo.h = 25
         winfo.w = 80
         irc = setwsizeqq(luttyo,winfo)
         rgb = #FFFFFF  ! White
         old_rgb = setbkcolorrgb(rgb)
         rgb = #000000  ! Black
         old_rgb = settextcolorrgb(rgb)
      endif
c
c     Direct mathmode error messages to another logical unit than luttyo
      call mathmode_set_lun(20)
c
      call read_postmini_logical_names
      call read_defaults
c
      return
      end
c
      subroutine pm_allocate_incore_arrays(ierr)
      implicit none
c
      integer ierr
c
      include 'const.h'
      include 'incore.cmn'
c
c     On OSF/1, this function must be declared integer*8
      integer*4 pm_malloc
c
      ierr = .FALSE.
c
      if( incore_allocated ) then
         call pm_free(p_incore)
         call pm_free(p_incore_2d)
         incore_allocated = .FALSE.
      endif
c     The size allocated MUST match what was specified in incore.cmn
      p_incore = pm_malloc(4*CORESIZE*CORESIZE*CORESIZE*18)
      if( p_incore .eq. 0 ) then
        ierr = .TRUE.
      endif
c     The size allocated MUST match what was specified in incore.cmn
      p_incore_2d = pm_malloc(4*CORESIZE*CORESIZE*2)
      if( p_incore_2d .eq. 0 ) then
         call pm_free(p_incore)
         ierr = .TRUE.
      endif
      incore_allocated = .TRUE.
c
      return
      end
c
      subroutine pm_free_incore_arrays
      implicit none
c
      include 'const.h'
      include 'incore.cmn'
c
      if( incore_allocated ) then
         call pm_free(p_incore)
         call pm_free(p_incore_2d)
         incore_allocated = .FALSE.
      endif
      p_incore = 0
      p_incore_2d = 0
c
      return
      end
c
      subroutine pm_make_gkserrfile(string)
      implicit none
c
      character*(*) string
c
      include 'sysdep.cmn'
c
c     Return a unique string to be used as the GKS error log file
c
      integer ilen, string_len
      character*(PM_MAX_PATHLEN) tmp, home
c
      call pm_tempnam(PM_GKS_ERR_FILE_PREFIX,tmp)
c
c     Prepend home directory, so we can run Postmini in any directory
      call get_homedir(home)
      ilen = string_len(home)
      string = home(1:ilen) // tmp
c
      return
      end
c
      subroutine pm_open_file(lu, filename, open_status, form,
     1                        action, carriage_control, shared,
     2                        nrecl, istatus, ierr)
c
      implicit none
c
      character*(*) filename, open_status, action, form,
     1              carriage_control, shared
      integer lu, nrecl, istatus, ierr
c
c     locals
      character*80 buffer
      character*20 status
c
      integer ioerr
      logical lreadonly, lshared, lrecl
c
      ierr    = 0
      istatus = 0
c
      buffer = action
      call upcase(buffer)      
      if( buffer .eq. 'READ' ) then
         lreadonly = .TRUE.
      else
         lreadonly = .FALSE.
      endif
c
      buffer = shared
      call upcase(buffer)
      if( buffer .eq. 'SHARED' ) then
         lshared = .TRUE.
      else
         lshared = .FALSE.
      endif
c
      if( nrecl .ne. 0 ) then
         lrecl = .TRUE.
      else
         lrecl = .FALSE.
      endif
c
c     Alter 'NEW' open status to 'UNKNOWN' on Win32, so open of an existing
c     file will succeed.
      status = open_status
      call upcase(status)
      if( status .eq. 'NEW' ) then
         status = 'UNKNOWN'
      endif
c
c     NOTE: Unfinished! Need to work on 'shared' specifier
c
      if( lreadonly ) then
         if( lshared ) then
            if( lrecl ) then
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              action='READ',shared,recl=nrecl)
            else
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              action='READ',shared)
            endif
         else
            if( lrecl ) then
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              action='READ',recl=nrecl)
            else
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              action='READ')
            endif
         endif
      else
         if( lshared ) then
            if( lrecl ) then
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              shared,recl=nrecl)
            else
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              shared)
            endif
         else
            if( lrecl ) then
               open(unit=lu,file=filename,status=status,form=form,
     1              carriagecontrol=carriage_control,
     1              err=10000,iostat=ioerr,
     1              recl=nrecl)
            else
               open(unit=lu,file=filename,status=status,form=form,
     1              err=10000,iostat=ioerr,
     1              carriagecontrol=carriage_control)
            endif
         endif
      endif
c
      goto 20000
c
10000 continue
c     Error on opening the file
      istatus = ioerr
      ierr = 1
c
20000 continue
c
      return
      end
c
      subroutine pm_make_tempfile(prefix, string)
      use dfport
      implicit none
c
      character*(*) prefix, string
c
      include 'sysdep.cmn'
c
c     Return a unique string to be used as a temporary file
c
c     access is defined in module dfport
      integer ilen, rc, string_len
      character*(PM_MAX_PATHLEN) tmp, home, tmpdir
c
      call pm_tempnam(prefix,tmp)
c
c     Get temporary directory
      call getenv('TMP',tmpdir)
      if( string_len(tmpdir) .ne. 0 ) then
         ilen = string_len(tmpdir)
         string = tmpdir(1:ilen) // '\' // tmp
      else
c        Temporary directory not defined, use home directory
         call get_homedir(home)
         rc = access(home,' rwx')
         if( rc .eq. 0 ) then
            ilen = string_len(home)
            string = home(1:ilen) // tmp
         else
c           If all else fails, use current directory
            string = tmp
         endif
      endif
c
      return
      end
c
      integer function pm_malloc(isize)
      implicit none
c
      integer isize
c
      pm_malloc = malloc(isize)
c
      return
      end
c
      subroutine pm_free(ptr)
      implicit none
c
      integer ptr
c
      call free(ptr)
c
      return
      end
c
      subroutine inquire_hardcopy_menu(fake_ln03, abort)
      implicit none
c
      logical fake_ln03, abort
c
c     QuickWin does not support hardcopy devices
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'io.cmn'
c
      character*1 ch
c
      call clear_screen
      write(luttyo,1000)
1000  format(' ','Sorry, the graphics library used for this port does '/
     1       ' ','not support Postmini-style hardcopy options.'//
     1       ' ','Use the File menu of the main Postmini window '/
     1       ' ','to send the screen bitmap to your printer or save'/
     1       ' ','the bitmap to a file')
      call get_char(ch,
     1     'Hit return to continue... ',0)
      abort = .TRUE.
c
      return
      end
c
      subroutine pm_qsort(base, nmemb, size, compar)
      implicit none
c
      integer base, nmemb, size, compar
      external compar
c
      call qsort(base, nmemb, size, compar)
c
      return
      end
c
      subroutine pm_username(user_string)
      use dfport
c
      implicit none
c
      character*(*) user_string
c
      call getlog(user_string)
c
      return
      end
