Coastal & Marine Geology InfoBank

Home FACS Activities Atlas Geology School Related Sites More

USGS InfoBank program -- obrien

Skip navigational links
Loading
InfoBank Programs: by Name   by Topic  
Expanded Description
Topic Description
Name
obrien
Synopsis
/infobank/programs/dbase/obrien/obrien.for
Description
  Program to reformat O'Brien Rock Warehouse data table 

  into .item files.
       
AUTHOR
  Clint Steele     11/19/2002

    
MODIFIED
  B.F.  12/06/02

     line 150 changed Pallet to LastPallet to fix bug where wrong
   number of boxes was printed

    
Reads
          read (89, '(i4,1x,q,a)', end = 98)
     *        LocationNumber, LocationLength,
     *        Location(LocationNumber)(1:LocationLength)
          read (91, '(q,a)', end=96) ALineLength, ALine(1:ALineLength)
          read (ALine(Tab(2)+1:Tab(3)-1), '(i)') 
     *         CollectionPallet(CollectionCount)
          read (90, '(q,a)', end=196) ALineLength, ALine(1:ALineLength)
          read (ALine(Tab(2)+1:Tab(3)-1), '(i)') Pallet
          read (90, '(q,a)', end=99) ALineLength, ALine(1:ALineLength)
          read (ALine(Tab(2)+1:Tab(3)-1), '(i)') Pallet
                  read (88, '(q,a)') BLineLength, BLine(1:BLineLength)
                  read (88, '(q,a)') BLineLength, BLine(1:BLineLength)
                      read (88, '(q,a)', end=97) 
     *                    BLineLength, BLine(1:BLineLength)
Writes
                  write (92, '(a,i3.3,a,i3.3)') 
     *                '  # Boxes     --- ',CostBoxCount,
     *                ' of ',BoxCount(LastPallet)
                  write (92, '(a)') BLine(1:BLineLength)
                  write (92, '(a)') BLine(1:BLineLength)
                      write (92, '(a)') BLine(1:BLineLength)
                      write (92, '(1x)')
                      write (92, '(a)') 
     *   '!  *** MAKE MODIFICATIONS ONLY BELOW THIS LINE ***'
                  write (92, '(a,i4.4)') 'Pallet ID --- ',Pallet
                  write (92, '(a)') '  Location    --- '//
     *                Location(Pallet)(1:LocationLength)
                  write (92, '(1x)')
                  write (92, '(a)') 
     *   '!  *** MAKE MODIFICATIONS ONLY BELOW THIS LINE ***'
          write (Accession, '(1024x)')
                  write (92, '(a,i3.3,a,i3.3)')
     *                '  # Boxes     --- ',CostBoxCount,
     *                ' of ',BoxCount(Pallet)
              write (92, '(1x)')
              write (92, '(a)') '  Activity ID --- UNSPECIFIED'
              write (92, '(a)') '  Accession # --- '//
     *            Accession(1:AccessionLength)
          write (Scientist, '(1024x)')
              write (92, '(a)') '  Scientist   --- '//
     *            TitleScientist(1:ScientistLength)
                          write (92, '(a)') '  Cost Center --- '//
     *         CollectionTeam(CollectionLoop)(1:CollectionTeamLength)
                          write (92, '(a)') '  Notes       --- '//
     *          CollectionNotes(CollectionLoop)(1:CollectionNotesLength)
                  write (92, '(a)') '  Cost Center --- '//
     *            'UNSP'
          write (92, '(a)') '    Box       --- '//
     *        ALine(Tab(3)+1:ALineLength)
      write (92, '(a,i3.3,a,i3.3)') '  # Boxes     --- ',CostBoxCount,
     *      ' of ',BoxCount(Pallet)
Opens
      open (unit = 89,
     *      access = 'sequential',
     *      status = 'old',
     *      form = 'formatted',
     *      name = '/infobank/programs/dbase/obrien/locations.keep')
      open (unit = 91,
     *      access = 'sequential',
     *      form = 'formatted',
     *      status = 'old',
     *      name = '/infobank/programs/dbase/obrien/collection.keep')
      open (unit = 90,
     *      access = 'sequential',
     *      form = 'formatted',
     *      status = 'old',
     *      name = '/infobank/programs/dbase/obrien/rock.keep')
              open (unit = 92,
     *              access = 'sequential',
     *              form = 'formatted',
     *              status = 'unknown',
     *              name = '/infobank/programs/dbase/obrien/0'//
     *                  ALine(Tab(2)+1:Tab(3)-1)//'.item')
                  open (unit = 88,
     *                  access = 'sequential',
     *                  form = 'formatted',
     *                  status = 'old',
     *                  name =  '/infobank/items/0'//
     *                ALine(Tab(2)+1:Tab(2)+2)//'00s/0'//
     *                ALine(Tab(2)+1:Tab(3)-1)//'.item')
Calls
          call changecase ('SMALL', CollectionNotes(CollectionCount))
                  call stringlen (Location(Pallet), LocationLength)
          call stringlen (Accession, AccessionLength)
          call stringlen (Scientist, ScientistLength)
              call changecase ('SMALL',
     *            TitleScientist(1:ScientistLength))
              call changecase ('TITLE', 
     *            TitleScientist(1:ScientistLength))
                         call stringlen (CollectionTeam(CollectionLoop),
     *                        CollectionTeamLength)
                        call stringlen (CollectionNotes(CollectionLoop),
     *                        CollectionNotesLength)

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/dbase/obrien/obrien.doc.html
Page Contact Information: InfoBank staff
Page Last Modified: Mon Sep 16 03:37:48 PDT 2013  (chd)