Link to USGS home page
USGS Home
Contact USGS
Search USGS
Coastal & Marine Geology InfoBank

USGS InfoBank program -- makesamp

Skip navigational links
Search InfoBank
Home tab Atlas tab Activities tab FACS tab Geology School tab More tab Activities tabs
   
InfoBank Programs: by Name   by Topic  
   
Expanded description
Topic Description
Name 
makesamp
Synopsis 
/infobank/programs/html/info2html/makesamp.for
Description 
  Subroutine to make specific samp.htmls for an Activity ID.
Author 
  Clint Steele   10/16/97
Opens 
 open (name   = SpecificHtml(1:SpecificHtmlLength),
*      access = 'sequential',
*      status = 'unknown',
*      form   = 'formatted',
*      unit   = SpecificUnit)

     open (unit = FileUnit,
*          access = 'sequential',
*          form = 'formatted',
*          status = 'unknown',
*          name = '/infobank/'//
*                 ShortID(1:1)//'/'//
*                 ShortID(1:IDLength)//'/samp/'//
*                 LongID(1:IDLength+3)//'.metafiles.keep')

             open (unit = LinkUnit,
*                  access = 'sequential',
*                  form = 'formatted',
*                  status = 'unknown',
*                  name = Path(1:PathLength))

     open (unit = FileUnit,
*          access = 'sequential',
*          form = 'formatted',
*          status = 'unknown',
*          name = '/infobank/'//
*                 ShortID(1:1)//'/'//
*                 ShortID(1:IDLength)//'/samp/'//
*                 LongID(1:IDLength+3)//'.datafiles.keep')

             open (unit = 47,
*                  access = 'sequential',
*                  form = 'formatted',
*                  status = 'unknown',
*                  name = Path(1:PathLength))

     open (unit = FileUnit,
*          access = 'sequential',
*          form = 'formatted',
*          status = 'unknown',
*          name = '/infobank/'//
*                 ShortID(1:1)//'/'//
*                 ShortID(1:IDLength)//'/'//ShortName//'/'//
*                 LongID(1:IDLength+3)//'.arcfiles.keep')


     open (unit = FileUnit,
*          access = 'sequential',
*          form = 'formatted',
*          status = 'unknown',
*          name = '/infobank/'//
*                 ShortID(1:1)//'/'//
*                 ShortID(1:IDLength)//'/'//ShortName//'/'//
*                 LongID(1:IDLength+3)//'.other.keep')
Reads 
         read (FileUnit, '(q,a)', end = 923)
*              PathLength, Path(1:PathLength)
             read (LinkUnit, '(q,a)') 
*                  LinkLength, Link(1:LinkLength)

         read (FileUnit, '(q,a)', end = 926)
*              PathLength, Path(1:PathLength)
             read (47, '(q,a)', end = 479)
*                    ALineLength, ALine(1:ALineLength)

         read (FileUnit, '(q,a)', end = 9523)
*              PathLength, Path(1:PathLength)
         read (FileUnit, '(t10,q,a)', end = 599)
*              PathLength, Path(1:PathLength)
         read (FileUnit, '(t10,q,a)', end = 599)
*              PathLength, Path(1:PathLength)
         read (FileUnit, '(t10,q,a)', end = 599)
*              PathLength, Path(1:PathLength)
         read (FileUnit, '(t10,q,a)', end = 599)
*              PathLength, Path(1:PathLength)
Writes 
 write (SpecificHtml, '(255x)')
 write (SpecificHtml, 3) 
*                    ShortID(1:1), 
*                    ShortID(1:IDLength),
*                    LongID(1:IDLength+3),
*                    ShortName
 write (SpecificUnit, '(a,/)')
*  '<!-- ====== MAP: ====== -->'
 write (SpecificUnit, '(6x,a)')
*  '<table border="0" width="100%" bgcolor="#ffffff">'
 write (SpecificUnit, '(8x,a)') '<tr>'
 write (SpecificUnit, '(10x,a)')
*  '<td align="right" valign="top">'
 write (SpecificUnit, '(12x,a)') '<b>Location map:</b>'
 write (SpecificUnit, '(10x,a,/)') '</td>'
 write (SpecificUnit, '(10x,a)') '<td>'
     write (SpecificUnit, 20) ShortID(1:1),
*                            ShortID(1:IDLength), 
*                            LongID(1:IDLength+3),
*                            ShortName,
*                            CapID
 write (SpecificUnit, '(10x,a)') '</td>'
 write (SpecificUnit, '(8x,a)') '</tr>'
 write (SpecificUnit, '(6x,a,/)') '</table>'
 write (SpecificUnit, '(6x,a,/)') '<p>'
 write (SpecificUnit, '(a,/)')
*  '<!-- ====== LINKS TO DATA FILES: ====== -->'

 write (SpecificUnit, '(6x,a)') '<table border="0" align="left">'
 write (SpecificUnit, '(8x,a)') '<tr>'
 write (SpecificUnit, '(10x,a)') '<td>'
 write (SpecificUnit, '(12x,a)')
*  '<a href="http://walrus.wr.usgs.gov/infobank/'//
*  'programs/html/definition/meta.html">'
 write (SpecificUnit, '(14x,a)') '<b>Metadata:</b>'
 write (SpecificUnit, '(12x,a)') '</a>'
 write (SpecificUnit, '(10x,a)') '</td>'
 write (SpecificUnit, '(8x,a)') '</tr>'
 write (SpecificUnit, '(6x,a)') '</table>'
 write (SpecificUnit, '(6x,a)')
*   '<table BORDER="1" WIDTH="80%">'

         write (Path, '(255x)')
              write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
*                '  <tr>',
*                '    <td bgcolor="#ccffff" align="center">',
*             '      <A HREF="http://walrus.wr.usgs.gov'//
*                Path(1:PathLength)//'">'//
*                'Formal metadata for the samples'//
*                '</A>',
*                '    </td>',
*                '  </tr>'

             write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
*                '  <tr>',
*                '    <td bgcolor="#ccffff" align="center">',
*             '      <A HREF="http://walrus.wr.usgs.gov'//
*                Link(1:LinkLength)//'">'//
*                Path((index(Path, '.')+1):
*                     (index(Path, '.path')-1))//
*                '</A>',
*                '    </td>',
*                '  </tr>'

             write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
*                '  <tr>',
*                '    <td bgcolor="#ccffff" align="center">',
*             '      <A HREF="http://walrus.wr.usgs.gov'//
*                Path(1:PathLength)//'">'//
*                Path(LastDot+1:PathLength)//
*                '</A>',
*                '    </td>',
*                '  </tr>'

             write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
*                '  <tr>',
*                '    <td bgcolor="#ccffff" align="center">',
*             '      <A HREF="http://walrus.wr.usgs.gov'//
*                Path(1:PathLength)//'" target="new">'//
*                Path(LastSlash+1:PathLength)//
*                '</A>',
*                '    </td>',
*                '  </tr>'

             write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
*                '  <tr>',
*                '    <td bgcolor="#ccffff" align="center">',
*             '      <A HREF="http://walrus.wr.usgs.gov'//
*                Path(1:PathLength)//'" target="new">'//
*                Path(LastSlash+1:PathLength)//
*                '</A>',
*                '    </td>',
*                '  </tr>'

     write (SpecificUnit, '(a,/,a,/,a)')
*       '  <tr>',
*       '    <td bgcolor="#ccffff" align="center">'//
*       'none</td>',
*       '  </tr>'
     write (SpecificUnit, '(a,/,a,/,a)')
*       '  <tr>',
*       '    <td bgcolor="#ccffff" align="center">'//
*       'none</td>',
*       '  </tr>'
 write (SpecificUnit, '(a,/,a,/)')
*     '</table>','<P>'

 write (SpecificUnit, '(a)')
*  '<table border="0" align="left" bgcolor="#ffffff">'
 write (SpecificUnit, '(2x,a)') '<tr>'
 write (SpecificUnit, '(4x,a)') '<td>'
 write (SpecificUnit, '(6x,a)')
*  '<a href="http://walrus.wr.usgs.gov/infobank/'//
*  'programs/html/definition/meta.html">'
 write (SpecificUnit, '(8x,a)') '<b>Digital Data:</b>'
 write (SpecificUnit, '(6x,a)') '</a>'
 write (SpecificUnit, '(4x,a)') '</td>'
 write (SpecificUnit, '(2x,a)') '</tr>'
 write (SpecificUnit, '(a,/)') '</table>'
 write (SpecificUnit, '(a)')
*  '<table border="1" width="80%" bgcolor="#ccffff">'

             write (CurrentType, '(255x)')
                      write (SpecificUnit, '(10x,a)') '</td>'
                      write (SpecificUnit, '(8x,a)') '</tr>'
                      write (SpecificUnit, '(6x,a)') '</table>'
                      write (SpecificUnit, '(4x,a)') '</td>'
                      write (SpecificUnit, '(2x,a)') '</tr>'
                 write (SpecificUnit, '(2x,a)') '<tr>'
                 write (SpecificUnit, '(4x,a)') 
*                 '<td bgcolor="#00ffff" valign="top">'
                 write (SpecificUnit, '(6x,a)') 
*                CurrentType(1:CurrentTypeLength)
                 write (SpecificUnit, '(4x,a)') '</td>'
                 write (SpecificUnit, '(4x,a)') 
*                '<td bgcolor="#ccffff">'
                 write (SpecificUnit, '(6x,a)') 
*                '<table border="0">'
                 write (SpecificUnit, '(8x,a)') '<tr>'
                 write (SpecificUnit, '(10x,a)') 
*                '<td align="left">'
                write (SpecificUnit, '(12x,a)')
*                '<a href="http://walrus.wr.usgs.gov'//
*                Path(1:PathLength)//
*                '">'//
*                Path(LastDot+1:PathLength)//
*                '</a>  '
                 write (SpecificUnit, '(12x,a)') 
*                ALine(1:Brace)//
*                Path(LastDot+1:PathLength)//
*                '</a>  '
         write (LastType, '(255x)')
     write (SpecificUnit, '(a,/,a,/,a)')
*       '  <tr>',
*       '    <td bgcolor="#ccffff" align="center">'//
*       'none</td>',
*       '  </tr>'
     write (SpecificUnit, '(a,/,a,/,a)')
*       '  <tr>',
*       '    <td bgcolor="#ccffff" align="center">'//
*       'none</td>',
*       '  </tr>'


     write (SpecificUnit, '(10x,a)') '</td>'
     write (SpecificUnit, '(8x,a)') '</tr>'
     write (SpecificUnit, '(6x,a)') '</table>'
     write (SpecificUnit, '(4x,a)') '</td>'
     write (SpecificUnit, '(2x,a)') '</tr>'
 write (SpecificUnit, '(a)') '</table><p>'
 write (SpecificUnit, '(a,/)')
*  '<!-- ====== LINKS TO ARC FILES: ====== -->'

 write (SpecificUnit, '(6x,a)') '<table border="0" align="left">'
 write (SpecificUnit, '(8x,a)') '<tr>'
 write (SpecificUnit, '(10x,a)') '<td>'
 write (SpecificUnit, '(12x,a)')
*  '<a href="http://walrus.wr.usgs.gov/infobank/'//
*  'programs/html/definition/arc.html">'
 write (SpecificUnit, '(14x,a)') '<b>Arc Files:</b>'
 write (SpecificUnit, '(12x,a)') '</a>'
 write (SpecificUnit, '(10x,a)') '</td>'
 write (SpecificUnit, '(8x,a)') '</tr>'
 write (SpecificUnit, '(6x,a)') '</table>'
 write (SpecificUnit, '(6x,a)')
*   '<TABLE BORDER="1" WIDTH="80%">'

         write (Path, '(255x)')
                 write (SpecificUnit, '(2x,a,/)') '</tr>'
                 write (SpecificUnit, '(2x,a)') '<tr>'
                 write (SpecificUnit, '(4x,a)')
*                        '<td bgcolor="#00FFFF" align="center">'//
*                     '<b>Best file with nav'//
*                     ' in ArcInfo E00 format</b></td>'
                 write (SpecificUnit, '(4x,a)')
*                        '<td bgcolor="#CCFFFF" align="center">'//
*                        '<b>'//
*                        LongID(1:IDLength+3)//'.zip</b></td>'
                 write (SpecificUnit, '(6x,a,f8.1,a)')
*                        '<td bgcolor="#CCFFFF"><center>'//
*                        '<a href="http://walrus.wr.usgs.gov'//
*                        '/infobank/'//
*                        ShortID(1:1)//'/'//
*                        ShortID(1:IDLength)//
*                        '/arc/'//ShortName//'/'//
*                        LongID(1:IDLength+3)//'.zip">',Size,
*                        ' Mb</a></center></td>'

     write (SpecificUnit, '(a,/,a,/,a)')
*       '  <TR>',
*       '    <TD bgcolor="#CCFFFF" ALIGN="CENTER">'//
*       'none</TD>',
*       '  </TR>'
     write (SpecificUnit, '(a,/,a,/,a)')
*       '  <TR>',
*       '    <TD bgcolor="#CCFFFF" ALIGN="CENTER">'//
*       'none</TD>',
*       '  </TR>'
 write (SpecificUnit, '(a,/,a,/)')
*     '</TABLE>','<P>'


     write (SpecificUnit, '(a)')
*      '<table border="0" align="left" bgcolor="#ffffff">'
     write (SpecificUnit, '(2x,a)') '<tr>'
     write (SpecificUnit, '(4x,a)') '<td>'
     write (SpecificUnit, '(8x,a)') '<b>Other:</b>'
     write (SpecificUnit, '(4x,a)') '</td>'
     write (SpecificUnit, '(2x,a)') '</tr>'
     write (SpecificUnit, '(a,/)') '</table>'
     write (SpecificUnit, '(a)')
*      '<table border="1" width="80%" bgcolor="#ccffff">'

     write (SpecificUnit, '(2x,a)') '<tr>'
     write (SpecificUnit, '(4x,a)') '<th align="center">'
     write (SpecificUnit, '(8x,a)') 'Description'
     write (SpecificUnit, '(4x,a)') '</th>'
     write (SpecificUnit, '(4x,a)') '<th align="center">'
     write (SpecificUnit, '(8x,a)') 'Thumbnail<br>Size'
     write (SpecificUnit, '(4x,a)') '</th>'
     write (SpecificUnit, '(4x,a)') '<th align="center">'
     write (SpecificUnit, '(8x,a)') 'Intermediate<br>Size'
     write (SpecificUnit, '(4x,a)') '</th>'
     write (SpecificUnit, '(4x,a)') '<th align="center">'
     write (SpecificUnit, '(8x,a)') 'Full<br>Size'
     write (SpecificUnit, '(4x,a)') '</th>'
     write (SpecificUnit, '(2x,a)') '</tr>'
         write (SpecificUnit, '(2x,a)') '<tr>'
         write (SpecificUnit, '(4x,a)') '<td align="center">'
         write (SpecificUnit, '(8x,a)')
*               Path(1:PathLength)
         write (SpecificUnit, '(4x,a)') '</td>'
         write (SpecificUnit, '(4x,a)') '<td align="center">'
             write (SpecificUnit, '(8x,a,f8.1,a)')
*               '<a href="http://walrus.wr.usgs.gov'//
*               '/infobank'//
*               '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/'//ShortName//'/'//Path(1:PathLength)//
*               '">',Size,' Mb</a>'
         write (SpecificUnit, '(4x,a)') '</td>'
         write (SpecificUnit, '(4x,a)') '<td align="center">'
             write (SpecificUnit, '(8x,a,f8.1,a)')
*               '<a href="http://walrus.wr.usgs.gov'//
*               '/infobank'//
*               '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/'//ShortName//'/'//Path(1:PathLength)//
*               '">',Size,' Mb</a>'
         write (SpecificUnit, '(4x,a)') '</td>'
         write (SpecificUnit, '(4x,a)') '<td align="center">'
             write (SpecificUnit, '(8x,a,f8.1,a)')
*               '<a href="http://walrus.wr.usgs.gov'//
*               '/infobank'//
*               '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/'//ShortName//'/'//Path(1:PathLength)//
*               '">',Size,' Mb</a>'
         write (SpecificUnit, '(4x,a)') '</td>'
         write (SpecificUnit, '(2x,a)') '</tr>'
     write (SpecificUnit, '(a,/,a,/)')
*     '</table>','<p>'

     write (SpecificUnit, '(a)')
*        '<a href="http://walrus.wr.usgs.gov'//
*        '/infobank/'//ShortID(1:1)//'/'//
*        ShortID(1:IDLength)//'/html/'//
*        LongID(1:IDLength+3)//'.container.html">'//
*        '<b>Check the analog holdings.</b></a><p>'
     write (SpecificUnit, '(a)')
*        'No analog holdings.<p>'
Calls 
 call stringlen (SpecificHtml, SpecificHtmlLength)
 call htmlhead (SpecificUnit, 
*    'CMG '//CapID//' '//LongName )

 call controlbar 
*   (SpecificUnit, ShortID, IDLength, LongID, CapID,
*    ShortName, LongName, Existance)

             call stringlen (CurrentType, CurrentTypeLength)
                 call getsize ('/infobank/'//
*                        ShortID(1:1)//'/'//
*                        ShortID(1:IDLength)//
*                        '/arc/'//ShortName//'/'//
*                        LongID(1:IDLength+3)//'.zip', Size)
         call getsize ( '/infobank'//
*         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/'//ShortName//'/'//Path(1:PathLength), Size)

         call getsize ( '/infobank'//
*         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/'//ShortName//'/'//Path(1:PathLength), Size)

         call getsize ( '/infobank'//
*         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/'//ShortName//'/'//Path(1:PathLength), Size)

 call htmlfoot (SpecificUnit, 
*               'http://walrus.wr.usgs.gov'//
*               '/infobank'//
*         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
*               '/html/'//LongID(1:IDLength+3)//'.'//
*               ShortName//'.html' )

Skip footer navigational links

InfoBank   Menlo Park Center   Santa Cruz Center   St. Petersburg Center   Woods Hole Center   Coastal and Marine Geology Program   Geologic Information   Ask-A-Geologist   USGS Disclaimer  

Accessibility FOIA Privacy Policies and Notices

U.S. Department of the Interior | U.S. Geological Survey
URL: http://walrus.wr.usgs.gov/infobank/programs/html/info2html/makesamp.doc.html
Page Contact: InfoBank staff
Page Last Modified: Tue Feb 12 03:44:29 PST 2008  (wcs)

FirstGov button   Take Pride in America button