Coastal & Marine Geology InfoBank

Home FACS Activities Atlas Geology School Related Sites More

USGS InfoBank program -- openem

Skip navigational links
InfoBank Programs: by Name   by Topic  
Expanded Description
Topic Description
  Subroutine to prompt for file names and opens input and 

  output files.
  A negative second argument instructs OPENEM not to put a 

  DRS header in the output files.
  "a" = argument, "r" = referenced, "s" = set

  call openem                           (with the following arguments)
         NumberInput                 [variable i*4 ar]
         NumberOutput                [variable i*4 ar]
    NumberInput  = number of input files (may be 0)
    NumberOutput = number of output files (may be 0 or may be 
                   negative if no header is desired)
  changecase          (shared DRS external routine) 

  command             (shared DRS external routine) 
  starin              (external)                    
  getdevice           (internal)                    
  forerror            (shared DRS external routine) 
  starout             (external)                    
  header              (shared DRS external routine) 
  getarg              (shared DRS external routine)
  getprcnam           (shared DRS external routine)
  getfile             (internal)
  abs                 (FORTRAN intrinsic function)  

  index               (FORTRAN intrinsic function)  

  limitations:       NumberInput + NumberOutput <=

  File numbers begin with file 90 and continue through file 99.
  Input files are numbered first, then output files.
    ex: 3 input and 2 output files would be files 90, 91, and 92 
        for input, files 93 and 94 for output
  Although this program has been used by the U.S. Geological Survey,

  no warranty, expressed or implied, is made by the Survey as to the
  accuracy and functioning of the program and related program
  material nor shall the fact of distribution constitute any such
  warranty, and no responsibility is assured by the Survey in
  connection therewith.
  Wm. Clinton Steele     3/16/81

  Clint Steele    7/5/84 
    Modified for structured code and to handle fixed record format  
  Clint Steele   2/16/85    Modified for MAT          
  Ed Maple       5/12/87    Added check for existence of input files  
  Ed Maple       7/17/87    Added check for tape drive(s) as input file(s)  
  Clint Steele   9/3/87     Modified tape drive check to check index, 
                              not just name 
  Clint Steele   2/17/88    Modified for UNIX compatibility
  Clint Steele   8/15/88    Added call to STARIN
  Clint Steele   8/23/88    Added call to STAROUT
  Clint Steele   9/27/88    Changed i/o from unit * to 5 and 6
                            Removed RECL = 1024 for UNIX.
  Clint Steele   9/30/88    Changed input from unit 5 to *
  Clint Steele  11/10/88    Changed DO WHILE (.NOT. OPENED) loop to GOTO
  Clint Steele  11/15/88    Added ability to handle UNIX-type directed i/o
  Clint Steele  11/22/88    Added recognition of BACKGROUND
  Clint Steele   9/08/90    Changed H option to H and ? for i/o prompts
  Clint Steele   9/12/90    Added check for username PACIFIC to correct
                              potential security hole.
  Clint Steele   12/4/95   Removed VMS references.

                      read (*, '(a)') FileName
                      read (*, '(a)') FileName
                      read (*, '(a)') FileName
                      read (*, '(a)') FileName
                      write (6, 500) Counter (LoopCount),
     *                    Additional(1:LengthAdd)
                      write (6, 510) Additional(1:LengthAdd)
                          write (FullName, '(100x)')
                      write (6, 520) Counter (LoopCount),
     *                   Additional(1:LengthAdd)
                      write (6, 530) Additional(1:LengthAdd)
                      write (FullName, '(100x)')
                      open (unit   = UnitNumber, 
     *                      form   = 'formatted',
     *                      status = 'old', 
     *                      file   = FileName,
     *                      iostat = ErrorFlag) 
                      open (unit   = UnitNumber, 
     *                      form   = 'formatted',
     *                      status = 'old', 
     *                      file   = FileName,
     *                      iostat = ErrorFlag) 
                  open (unit = UnitNumber, 
     *                  form = 'formatted',
     *                  status = 'new', 
     *                  file = FileName, 
     *                  iostat = ErrorFlag) 
      call getprcnam (ProcessName)
      call getusrnam (UserName)
      call changecase ('CAPITALS', UserName)
      call stringlen (UserName, LengthUser)
      call stringlen (Additional, LengthAdd)
          call getarg (-2, FileName)
              call getfile (-2, NumberInput, FileName, NameLength)
                      call command
                  call getjpihed  (ProgramName)
                  call starin (FileName)
                  call getdevice (FileName, DeviceType)
                          call forerror (ErrorFlag)
                          call forerror (ErrorFlag)
                          call stringlen (FullName, FullNameLength)
          call getarg (-1, FileName)
              call getfile (-1, AbsOutput, FileName, NameLength)
                      call command 
                  call getjpihed  (ProgramName)
                  call starout (LastFile, FileName)
                      call forerror (ErrorFlag)
                      call stringlen (FullName, FullNameLength)
      call header (NumberInput, NumberOutput)

Skip footer navigational links

Coastal and Marine Science Centers:  Pacific   St. Petersburg   Woods Hole  
InfoBank   Coastal and Marine Geology Program   Geologic Information   Ask-A-Geologist   USGS Disclaimer  

Accessibility FOIA Privacy Policies and Notices

Take Pride in America logo logo U.S. Department of the Interior | U.S. Geological Survey
Page Contact Information: InfoBank staff
Page Last Modified: Mon Sep 16 03:36:54 PDT 2013  (chd)