USGS InfoBank program -- makesamp

makesamp

  Subroutine to make specific samp.htmls for an Activity ID.

       

  Clint Steele   10/16/97

  Joan Paz       02/02/09  Added code to include the Index Map
                           .gif file if it exists
  Clint Steele   6/2/2010   Added link info handling
  Sumy Tom       10/25/2010 calls addmaps to add indexmap

    

              read (FileUnit, '(q,a)', end = 9523)
     *              PathLength, Path(1:PathLength)
              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 = 923)
     *              PathLength, Path(1:PathLength)
                      read (ItemUnit, '(q,a)', end = 1206)
     *                      ItemLength, Item(1:ItemLength)
                  read (LinkUnit, '(q,a)') 
     *                  LinkLength, Link(1:LinkLength)
                      read (ItemUnit, '(q,a)', end = 206)
     *                      ItemLength, Item(1:ItemLength)
              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)

      write (SpecificHtml, '(255x)')
      write (SpecificHtml, 3) 
     *                    ShortID(1:1), 
     *                    ShortID(1:IDLength),
     *                    LongID(1:IDLength+3),
     *                    ShortName
      write (SpecificUnit, '(a,/)')
     *  '<!-- ====== LINKS TO DATA FILES: ====== -->'
      write (SpecificUnit, '(2x,a)') '<table class="noborder" '
     *                              ' width = "100%"&g
      write (SpecificUnit, '(4x,a)') '<t
      write (SpecificUnit, '(6x,a)') '<td valign = "top
      write (SpecificUnit, '(6x,a)') '<table class="border" 
     *                               'rules="all" width = "100%"&g
      write (SpecificUnit, '(8x,a)') '<t
      write (SpecificUnit, '(10x,a)') '<td class="dark" valign="top
      write (SpecificUnit, '(a,/)')
     *  '<!-- ====== LINKS TO: ====== -
      write (SpecificUnit, '(12x,a)')
     *  '<a href="http://walrus.wr.usgs.gov/infobank/
     *  'programs/html/definition/arc.html"&g
      write (SpecificUnit, '(14x,a)') '<b>Arc Files:  
      write (SpecificUnit, '(12x,a)') '</
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(10x,a)') '<t
      write (SpecificUnit, '(10x,a)')
     *   '<table class="border" rules="all" width="100%
              write (Path, '(255x)')
                      write (SpecificUnit, '(2x,a)') '<t
                      write (SpecificUnit, '(4x,a)')
     *                        '<td class="dark" align="center"&
     *                     '<b>Best file with 
     *                     ' in ArcInfo E00 format</b>
                      write (SpecificUnit, '(4x,a)')
     *                        '<td class="light" align="center"&
     *                        '<b&
     *                        LongID(1:IDLength+3)//'.zip</b>
                      write (SpecificUnit, '(6x,a,f8.1,a)')
     *                        '<td class="light"><c
     *                        '<a href="http://walrus.wr.usgs.gov
     *                        '/infobank/'//
     *                        ShortID(1:1)//'/'//
     *                        ShortID(1:IDLength)//
     *                        '/arc/'//ShortName//'/'//
     *                        LongID(1:IDLength+3)//'.zip">',si
     *                        ' Mb</a></cent
                      write (SpecificUnit, '(2x,a)') '</t
                   write (SpecificUnit, '(a,/,a)')
     *                '  <tr
     *             '    <td class="dark" align="center
                       write (SpecificUnit, '(a)')
     *                    'Line Events'
                       write (SpecificUnit, '(a)')
     *                    'Line Events time gap'
                   write (SpecificUnit, '(a,/,a)')
     *                '    </td
     *           '    <td class="light" align="center" COLSPAN="2
                   write (SpecificUnit, '(a)')
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'">
     *                Path(Dot+1:Underscore-1)//
     *                '</
                   write (SpecificUnit, '(a)')
     *                '  </t
          write (SpecificUnit, '(a,/,a,/,a)')
     *       '  <tr
     *       '    <td class="light" align="center"&
     *       'none</td
     *       '  </t
          write (SpecificUnit, '(a,/,a,/,a)')
     *       '  <tr
     *       '    <td class="light" align="center"&
     *       'none</td
     *       '  </t
      write (SpecificUnit, '(a,/,a,/)')
     *     '</TABL
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(8x,a)') '</t
      write (SpecificUnit, '(8x,a)') '<t
      write (SpecificUnit, '(10x,a)') '<td class="dark" valign="top
      write (SpecificUnit, '(12x,a)')
     *  '<a href="http://walrus.wr.usgs.gov/infobank/
     *  'programs/html/definition/meta.html"&g
      write (SpecificUnit, '(14x,a)') '<b>Digital Data
      write (SpecificUnit, '(12x,a)') '</
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(10x,a)') '<t
      write (SpecificUnit, '(a)')
     *  '<table class="border" rules="all" 
     *  'width="100%" class="light"&g
                  write (CurrentType, '(255x)')
                           write (SpecificUnit, '(10x,a)') '</t
                           write (SpecificUnit, '(8x,a)') '</t
                           write (SpecificUnit, '(6x,a)') '</tabl
                           write (SpecificUnit, '(4x,a)') '</t
                           write (SpecificUnit, '(2x,a)') '</t
                      write (SpecificUnit, '(2x,a)') '<t
                      write (SpecificUnit, '(4x,a)') 
     *                 '<td class="dark
                      write (SpecificUnit, '(6x,a)') 
     *                CurrentType(1:CurrentTypeLength)
                      write (SpecificUnit, '(4x,a)') '</t
                      write (SpecificUnit, '(4x,a)') 
     *                '<td class="light
                      write (SpecificUnit, '(6x,a)') 
     *                '<table class="noborder
                      write (SpecificUnit, '(8x,a)') '<t
                      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 class="light" align="center"&
     *       'none</td
     *       '  </t
          write (SpecificUnit, '(a,/,a,/,a)')
     *       '  <tr
     *       '    <td class="light" align="center"&
     *       'none</td
     *       '  </t
          write (SpecificUnit, '(10x,a)') '</t
          write (SpecificUnit, '(8x,a)') '</t
          write (SpecificUnit, '(6x,a)') '</tabl
          write (SpecificUnit, '(4x,a)') '</t
          write (SpecificUnit, '(2x,a)') '</t
      write (SpecificUnit, '(a)') '</tabl
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(8x,a)') '</t
      write (SpecificUnit, '(8x,a)') '<t
      write (SpecificUnit, '(10x,a)') '<td class="dark" valign="top"
      write (SpecificUnit, '(12x,a)')
     *  '<a href="http://walrus.wr.usgs.gov/infobank/
     *  'programs/html/definition/meta.html"&g
      write (SpecificUnit, '(14x,a)') '<b>Metadata:   
      write (SpecificUnit, '(12x,a)') '</
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(10x,a)') '<t
      write (SpecificUnit, '(10x,a)')
     *   '<table class="border" rules="all" width="100%
              write (Path, '(255x)')
                          write (SpecificUnit, '(a)') '</td
     *                         '</tr
     *                       '</table
     *                     '</td
     *                    '</t
                          write (SpecificUnit, '(a,/,a,/,a,/,a)')
     *                      '<td class="dark" align="center"
     *                      Item(Tab+1:ItemLength)//
     *                      '<br> 
                          write (SpecificUnit, '(a,/,a,/,a,/,a)')
     *                      '<a href="http://www.ngdc.noaa.go
     *                      '/mgg/curator/curator.html"'//
     *                      '>NGDC:<
     *                      '<br> &
     *                      Item(Tab+1:ItemLength)//
     *                      '<br> 
                          write (SpecificUnit, '(a,/,a,/,a,/,a)')
     *                      '<a href="http://www.geosamples.org"
     *                      '>SESAR:<
     *                      '<br> &
     *                      Item(Tab+1:ItemLength),
     *                      '    </td
     *                      '    <td class="light" align="left"
     *                      '    <table class="noborder"
     *                      '    <tr
     *                      '    <t
                          write (SpecificUnit, '(a)')
     *                     ' '//Item(Tab+1:ItemLength)//'<b
                  write (SpecificUnit, '(a,/,a)')
     *                '          </td
     *                '        </tr
     *                '      </table
     *                '    </td
     *                '  </t
                   write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'">
     *                'Formal metadata for the samples'//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Link(1:LinkLength)//'">
     *                Path((index(Path, '.')+1):
     *                     (index(Path, '.path')-1))//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'">
     *                Path(LastDot+1:PathLength)//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'" target="new">
     *                Path(LastSlash+1:PathLength)//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'" target="new">
     *                Path(LastSlash+1:PathLength)//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit, '(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'"target="new">
     *                Path(LastSlash+1:PathLength)//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit,'(a,/,a,/,a,/,a,/,a,/)')
     *                '  <tr
     *                '    <td class="light" align="center"
     *             '      <A HREF="http://walrus.wr.usgs.gov
     *                Path(1:PathLength)//'" target="new">
     *                Path(LastSlash+1:PathLength)//
     *                '</A
     *                '    </td
     *                '  </t
                  write (SpecificUnit, '(a,/,a)')
     *                '  <tr
     *                '    <td class="dark" align="center
                          write (SpecificUnit, '(a,/,a,/,a,/,a)')
     *                      'Notes',
     *                      '    </td
     *                      '    <td class="light" align="left"
     *                      '      <font size="-1">
                      write (SpecificUnit, '(a)')
     *                    ' '//Item(1:ItemLength)
                  write (SpecificUnit, '(a,/,a)')
     *                '      </pre><
     *                '    </td
     *                '  </t
          write (SpecificUnit, '(a,/,a,/,a)')
     *       '  <tr
     *       '    <td class="light" align="center"&
     *       'none</td
     *       '  </t
          write (SpecificUnit, '(a,/,a,/,a)')
     *       '  <tr
     *       '    <td class="light" align="center"&
     *       'none</td
     *       '  </t
      write (SpecificUnit, '(a,/,a,/)')
     *     '</tabl
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(8x,a)') '</t
         write (SpecificUnit, '(8x,a)') '<t
         write (SpecificUnit, '(10x,a)') '<td valign="top
          write (SpecificUnit, '(12x,a)') '<b>Other
          write (SpecificUnit, '(10x,a)') '</t
          write (SpecificUnit, '(10x,a)') '<t
          write (SpecificUnit, '(a)')
     *      '<table class="border" rules="all" 
     *      'width="100%" class="light"&g
          write (SpecificUnit, '(2x,a)') '<t
          write (SpecificUnit, '(4x,a)') '<th align="center
          write (SpecificUnit, '(8x,a)') 'Description'
          write (SpecificUnit, '(4x,a)') '</t
          write (SpecificUnit, '(4x,a)') '<th align="center
          write (SpecificUnit, '(8x,a)') 'Thumbnail<br>
          write (SpecificUnit, '(4x,a)') '</t
          write (SpecificUnit, '(4x,a)') '<th align="center
          write (SpecificUnit, '(8x,a)') 'Intermediate<br>
          write (SpecificUnit, '(4x,a)') '</t
          write (SpecificUnit, '(4x,a)') '<th align="center
          write (SpecificUnit, '(8x,a)') 'Full<br>
          write (SpecificUnit, '(4x,a)') '</t
          write (SpecificUnit, '(2x,a)') '</t
              write (SpecificUnit, '(2x,a)') '<t
              write (SpecificUnit, '(4x,a)') '<td align="center
              write (SpecificUnit, '(8x,a)')
     *               Path(1:PathLength)
              write (SpecificUnit, '(4x,a)') '</t
              write (SpecificUnit, '(4x,a)') '<td align="center
                  write (SpecificUnit, '(8x,a,f8.1,a)')
     *               '<a href="http://walrus.wr.usgs.gov
     *               DiskName//
     *               '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
     *               '/'//ShortName//'/'//Path(1:PathLength)//
     *               '">',size,' Mb&l
              write (SpecificUnit, '(4x,a)') '</t
              write (SpecificUnit, '(4x,a)') '<td align="center
                  write (SpecificUnit, '(8x,a,f8.1,a)')
     *               '<a href="http://walrus.wr.usgs.gov
     *               DiskName//
     *               '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
     *               '/'//ShortName//'/'//Path(1:PathLength)//
     *               '">',size,' Mb&l
              write (SpecificUnit, '(4x,a)') '</t
              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&l
              write (SpecificUnit, '(4x,a)') '</t
              write (SpecificUnit, '(2x,a)') '</t
          write (SpecificUnit, '(a,/,a,/)')
     *     '</tabl
          write (SpecificUnit, '(10x,a)') '</t
          write (SpecificUnit, '(8x,a)') '</tr>
          write (SpecificUnit, '(8x,a)') '<t
          write (SpecificUnit, '(10x,a)') 
     *                         '<td colspan="2" class="dark
          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
          write (SpecificUnit, '(a)')
     *        'No analog holdings.<
      write (SpecificUnit, '(10x,a)') '</t
      write (SpecificUnit, '(8x,a)') '</t
      write (SpecificUnit, '(4x,a)') '</tabl
      write (SpecificUnit, '(6x,a)') '</td>
      write (SpecificUnit, '(4x,a)')'<tabl
      write (SpecificUnit, '(6x,a)')'<t
      write (SpecificUnit, '(8x,a)')'<td> 
      write (SpecificUnit, '(8x,a)')'<td> 
      write (SpecificUnit, '(6x,a)')'</t
      write (SpecificUnit, '(4x,a)')'</table>'
      write (SpecificUnit, '(6x,a)') '</td><td valign 
      write (SpecificUnit, '(4x,a)')'<tabl
      write (SpecificUnit, '(6x,a)')'<t
      write (SpecificUnit, '(8x,a)')'<td>'
      write (SpecificUnit, '(8x,a)')'</t
      write (SpecificUnit, '(6x,a)')'</t
      write (SpecificUnit, '(6x,a)')'<t
      write (SpecificUnit, '(8x,a)')'<td>'
      write (SpecificUnit, '(8x,a)')'</t
      write (SpecificUnit, '(6x,a)')'</t
      write (SpecificUnit, '(4x,a)') '</tabl
      write (SpecificUnit, '(6x,a)') '</t
      write (SpecificUnit, '(4x,a)') '</t
      write (SpecificUnit, '(2x,a)') '</tabl

      open (name   = SpecificHtml(1:SpecificHtmlLength),
     *      access = 'sequential',
     *      status = 'unknown',
     *      form   = 'formatted',
     *      unit   = SpecificUnit)
          open (unit = FileUnit,
     *          access = 'sequential',
     *          form = 'formatted',
     *          status = 'unknown',
     *          name = DiskName//'/'//
     *                 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)//'/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)//'/samp/'//
     *                 LongID(1:IDLength+3)//'.metafiles.keep')
                  open (unit = ItemUnit,
     *                  access = 'sequential',
     *                  form = 'formatted',
     *                  status = 'unknown',
     *                  name = Path(1:PathLength))
                  open (unit = LinkUnit,
     *                  access = 'sequential',
     *                  form = 'formatted',
     *                  status = 'unknown',
     *                  name = Path(1:PathLength))
                  open (unit = ItemUnit,
     *                  access = 'sequential',
     *                  form = 'formatted',
     *                  status = 'unknown',
     *                  name = Path(1:PathLength))
          open (unit = FileUnit,
     *          access = 'sequential',
     *          form = 'formatted',
     *          status = 'unknown',
     *          name = DiskName//'/'//
     *                 ShortID(1:1)//'/'//
     *                 ShortID(1:IDLength)//'/'//ShortName//'/'//
     *                 LongID(1:IDLength+3)//'.other.keep')

      call stringlen (SpecificHtml, SpecificHtmlLength)
      call htmlhead (SpecificUnit, 
     *    'CMG '//CapID//' '//LongName )
      call controlbar 
     *   (DiskName,SpecificUnit, ShortID, IDLength, LongID, CapID,
     *    ShortName, LongName, Existance)
                      call getsize ('/infobank/'//
     *                        ShortID(1:1)//'/'//
     *                        ShortID(1:IDLength)//
     *                        '/arc/'//ShortName//'/'//
     *                        LongID(1:IDLength+3)//'.zip', size)
                  call stringlen (CurrentType, CurrentTypeLength)
              call getsize ( DiskName//
     *         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
     *               '/'//ShortName//'/'//Path(1:PathLength), size)
              call getsize ( DiskName//
     *         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
     *               '/'//ShortName//'/'//Path(1:PathLength), size)
              call getsize ( DiskName//
     *         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
     *               '/'//ShortName//'/'//Path(1:PathLength), size)
      call datatable (SpecificUnit, ShortID, IDLength, 
     *     LongID, Existance)
      call changecase ('SMALLS', LongNameLC)
      call stringlen (LongNameLC, LongNameLCLength)
      call addmaps(DiskName,Existance, LongNameLC, LongNameLCLength,
     *              ShortName, ShortID, 
     *              IDLength, LongID, SpecificUnit)
      call htmlfoot (SpecificUnit, 
     *               'http://walrus.wr.usgs.gov'//
     *               '/infobank'//
     *         '/'//ShortID(1:1)//'/'//ShortID(1:IDLength)//
     *               '/html/'//LongID(1:IDLength+3)//'.'//
     *               ShortName//'.html' )