Coastal & Marine Geology InfoBank

Home FACS Activities Atlas Geology School Related Sites More

USGS InfoBank program -- fixpoly

Skip navigational links
Loading
InfoBank Programs: by Name   by Topic  
Expanded Description
Topic Description
Name
fixpoly
Synopsis
/infobank/programs/poly/fixpoly/fixpoly.for
Description
  Program to correct area and group header information in polygon

  files.
       
BACKGROUND
  This is a complete re-write (VMS) of CLMXMN by 

     Jon Childs (Multics) and Graig McHendrie (UNIX).
    
AUTHOR
  Clint Steele    12/10/92

  Clint Steele     4/03/93    Added ability to add AREA if missing
  Michael Hamer   12/06/93    Write to temp file instead of memory for large files.
  Michael Hamer    2/2/95     Restructured program to be more module.
                              Wrote subroutine to determine limits
                              Wrote polyerror subroutine 
  Clint Steele     8/10/95    Extended output record beyond col. 80
    
SUBROUTINES
  openem              (shared DAPS external routine)

  polyerror           (internal)                    
  changecase          (shared DAPS external routine)
  limits              (external)                    
  stringlen           (shared DAPS external routine)
    
FUNCTIONS
  index               (FORTRAN intrinsic function)  

    
FILES_USED
  unit=90(read,inqre,close)

  unit=*(write)
  unit=91(open,write,close)
  unit=92(open,read,write,close)

    
Reads
      read (90, '(q,a)', iostat = Readstat, err = 30)
     *            Length, Aline(1:Length)
            read (Aline(1:19) , '(f9.5, f10.5)') 
     *            Lat(GroupCount), Lon(GroupCount)
         read (90, '(q,a)', iostat = Readstat, err = 30)
     *            Length, Aline(1:Length)
      read (92, '(q,a)', end = 99999, err = 70 ) Length, Aline(1:Length)
Writes
      write (Comment, '(255x)')
      write (Aline, '(255x)')
                     write (92, 100, err = 40) GroupID, GroupSouth,
     *                  GroupNorth, GroupEast, GroupWest,
     *                  GroupCount, Comment(81:CommentLength)
                        write (92, '(f9.5,f10.5)', err = 40) 
     *                      Lat(Loop), Lon(Loop)
               write (GroupID, '(17x)')
               write (Comment, '(255x)')
                     write (92, 100, err = 40) GroupID, GroupSouth,
     *                  GroupNorth, GroupEast, GroupWest,
     *                  GroupCount, Comment(81:CommentLength)
                  write (92, '(f9.5,f10.5)', err = 40) 
     *                 Lat(Loop), Lon(Loop)
         write (Aline, '(255x)')
             write (92, 100, err = 40) GroupID, GroupSouth,
     *          GroupNorth, GroupEast, GroupWest,
     *          GroupCount, Comment(81:CommentLength)
         write (92, '(f9.5,f10.5)', err = 40) 
     *        Lat(Loop), Lon(Loop)
      write (91, 10, err = 80) AreaID, AreaSouth,
     *                  AreaNorth, AreaEast, AreaWest,
     *                  RecNum
      write (Aline, '(255x)')
      write (91, '(a)', err = 80) Aline(1:Length)
Opens
      open (unit = 91,
     *      file = OutputFileName(1:Semicolon),
     *      form   = 'formatted',
     *      iostat = OpenErrorFlag,
     *      status = 'new')
      open (unit = 92,
     *      file = 'scratch.junk',
     *      form   = 'formatted',
     *      iostat = OpenErrorFlag,
     *      status = 'new')
      open (unit = 92,
     *      file = 'scratch.junk',
     *      form   = 'formatted',
     *      iostat = OpenErrorFlag,
     *      status = 'old')
Calls
      call openem (1,0)
          call polyerror (ErrorCode, WhatToDoFlag, RecNum)
          call polyerror (ErrorCode, WhatToDoFlag, RecNum)
      call polyerror (ErrorCode, WhatToDoFlag, RecNum)
            call changecase ('SMALL', Aline(20:23))
                  call polyerror (ErrorCode, WhatToDoFlag, RecNum)
                  call polyerror (ErrorCode, WhatToDoFlag, RecNum)
                  call polyerror (ErrorCode, WhatToDoFlag, RecNum)
                  call polyerror (ErrorCode, WhatToDoFlag, RecNum)
                     call stringlen (Comment, CommentLength)
      call polyerror (ErrorCode, WhatToDoFlag, RecNum)
               call polyerror (ErrorCode, WhatToDoFlag, RecNum)
               call polyerror (ErrorCode, WhatToDoFlag, RecNum)
                     call stringlen (Comment, CommentLength)
            call limits (Lon(GroupCount), Lat(GroupCount),
     *                   GroupWest, GroupSouth,
     *                   GroupEast, GroupNorth)
            call limits (Lon(GroupCount), Lat(GroupCount),
     *                   AreaWest, AreaSouth,
     *                   AreaEast, AreaNorth)
             call stringlen (Comment, CommentLength)
      call polyerror (ErrorCode, WhatToDoFlag, RecNum)
          call polyerror (ErrorCode, WhatToDoFlag, RecNum)
      call polyerror (ErrorCode, WhatToDoFlag, RecNum)
      call polyerror (ErrorCode, WhatToDoFlag, RecNum)
      call stringlen (Aline, Length)
      call stringlen (OutputFileName, Length)

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 USA.gov logo U.S. Department of the Interior | U.S. Geological Survey
URL: http://walrus.wr.usgs.gov/infobank/programs/poly/fixpoly/fixpoly.doc.html
Page Contact Information: InfoBank staff
Page Last Modified: Mon Sep 16 03:38:26 PDT 2013  (chd)