Coastal & Marine Geology InfoBank

Home FACS Activities Atlas Geology School Related Sites More

USGS InfoBank program -- specialdates2html

Skip navigational links
Loading
InfoBank Programs: by Name   by Topic  
Expanded Description
Topic Description
Name
specialdates2html
Synopsis
/infobank/programs/html/dates2html/special/specialdates2html.for
Description
  Program to generate list of days for an activity.

       
AUTHOR
  Clint Steele        7/26/01


    
Reads
          read (90, '(a7,t10,i2,1x,i2,1x,i2,
     *                t23,i3,
     *                t32,i2,1x,i2,1x,i2,
     *                t45,i3)', end = 99)
     *        ID, 
     *        StartMonth, StartDay, StartYear,
     *        StartJDay, 
     *        EndMonth, EndDay, EndYear,
     *        EndJDay
          read (92, '(i4.4,1x,i2.2,1x,i2.2,1x,i3.3,1x,
     *                i4.4,1x,i2.2,1x,i2.2,1x,i3.3,1x,q,a)',
     *                end = 999)
     *                StartYear,
     *                StartMonth, 
     *                StartDay,
     *                StartJDay,
     *                EndYear,
     *                EndMonth, 
     *                EndDay,
     *                EndJDay,
     *                IDLength,
     *                ID(1:IDLength)
      read (90, '(t36,i4)', end = 99) FirstYear
          read (90, '(t36,i4)', end = 99) LastYear
Writes
              write (91, '(i4.4,1x,i2.2,a,i2.2,1x,i3.3,1x,
     *                     i4.4,1x,i2.2,a,i2.2,1x,i3.3,1x,a)')
     *                StartYear+StartCentury,  
     *                StartMonth, '/', 
     *                StartDay, 
     *                StartJDay,
     *                EndYear+EndCentury,
     *                EndMonth, '/',
     *                EndDay,
     *                EndJDay,
     *                ID(1:IDLength)
              write (91, '(i4.4,1x,a,1x,
     *                     i4.4,1x,i2.2,a,i2.2,1x,i3.3,1x,a)')
     *                EndYear+EndCentury,
     *                '01/01 001', 
     *                EndYear+EndCentury,
     *                EndMonth, '/',
     *                EndDay,
     *                EndJDay,
     *                ID(1:IDLength)
              write (91, '(i4.4,1x,i2.2,a,i2.2,1x,i3.3,1x,
     *                     i4.4,1x,a,1x,i3.3,1x,a)')
     *                StartYear+StartCentury,  
     *                StartMonth, '/', 
     *                StartDay, 
     *                StartJDay,
     *                StartYear+StartCentury,  
     *                '12/31',
     *                YearLength,
     *                ID(1:IDLength)
                  write (95, '(a)')
     *                '      </TABL
                  write (95, '(a)')
     *                '    </T
                  write (96, '(a)')
     *                '      </TABL
                  write (96, '(a)')
     *                '    </T
                  write (97, '(a)')
     *                '      </TABL
              write (OutDate, '(i4.4)') CurrentYear
              write (95, '(a)')
     *        '    <T
              write (95, '(a)') 
     *        '      <TABLE BORDER="0" WIDTH="80
              write (96, '(a)')
     *        '    <T
              write (96, '(a,i3.3,a)') 
     *        '      <TABLE BORDER="0" WIDTH=',YearLength,
              write (97, '(a)')
     *        '    <T
              write (97, '(a)') 
     *        '      <TABLE BORDER="0" WIDTH="90
          write (HyphenID, '(10x)')
          write (Link, '(512x)')
          write (Link, '(a)')
     *        '<A HREF="http://walrus.wr.usgs.gov
     *        '/infobank/'//
     *        ID(1:1)//
     *        '/'//
     *        ID(1:IDLength)//
     *        '/html/'//
     *        HyphenID(1:IDLength+3)//
     *        '.meta.html"&g
          write (95, '(a)')
     *        '        <T
          write (95, '(a)')
     *        '          <T
          write (95, '(a)')
     *        '            <TABLE BORDER="1
          write (95, '(a)')
     *        '              <T
          write (95, '(a)')
     *        '                <TD WIDTH="80" ALIGN="CENTER"&
     *        Link(1:LinkLength)//
     *        HyphenID(1:IDLength+3)//'</A>
          write (95, '(a)')
     *        '              </T
          write (95, '(a)')
     *        '            </TABL
          write (95, '(a)')
     *        '          </T
          write (95, '(a)')
     *        '        </T
          write (96, '(a)')
     *        '        <T
          write (96, '(a)')
     *        '          <T
          write (96, '(a,i3.3,a)')
     *        '            <TABLE BORDER="1" WIDTH=',YearLength,
          write (96, '(a)')
     *        '              <T
              write (96, '(a,i,a)')
     *            '                <TD WIDTH=
     *            int(Percent1+0.5),
     *           '%"> <
          write (96, '(a,i,a)')
     *        '                <TD WIDTH=
     *        int(Percent2+0.5),
     *        '%" BGCOLOR="00FFFF">
     *        ' </T
              write (96, '(a,i,a)')
     *            '                <TD WIDTH=
     *            int(Percent3+0.5),
     *            '%"> <
          write (96, '(a)')
     *        '              </T
          write (96, '(a)')
     *        '            </TABL
          write (96, '(a)')
     *        '          </T
          write (96, '(a)')
     *        '        </T
          write (97, '(a)')
     *        '        <T
          write (97, '(a)')
     *        '          <T
          write (97, '(a)')
     *        '            <TABLE BORDER="1
          write (97, '(a)')
     *        '              <T
          write (97, '(a,i2.2,a,i2.2,a,i2.2,a,i2.2,a)')
     *        '                <TD WIDTH="90" 
     *        'BGCOLOR="CCFFFF" ALIGN="CENTER">
     *        StartMonth,'/',StartDay,'-',
     *        EndMonth,'/',EndDay,
     *        '</T
          write (97, '(a)')
     *        '              </T
          write (97, '(a)')
     *        '            </TABL
          write (97, '(a)')
     *        '          </T
          write (97, '(a)')
     *        '        </T
      write (95, '(a)')
     *                '</TABL
      write (96, '(a)')
     *                '</TABL
      write (97, '(a)')
     *                '</TABL
      write (98, '(a)')
     *                '  </T
      write (98, '(a)')
     *                '</TABL
      write (95, '(a)')
     *           '        <T
      write (95, '(a)')
     *           '          <T
      write (95, '(a)')
     *           '            <TABLE BORDER="1
      write (95, '(a)')
     *           '              <T
      write (95, '(a,i4.4,a)')
     *           '                <TD WIDTH="80" 
     *           'BGCOLOR="CCFFFF" ALIGN="CENTER">
     *           CurrentYear,
     *           '</T
      write (95, '(a)')
     *           '              </T
      write (95, '(a)')
     *           '            </TABL
      write (95, '(a)')
     *           '          </T
      write (95, '(a)')
     *           '        </T
      write (96, '(a)')
     *           '        <TR BGCOLOR="CCFFFF
      write (96, '(a)')
     *           '          <T
      write (96, '(a)')
     *           '            <TABLE BORDER="1
      write (96, '(a)')
     *           '              <T
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">J<
      write (96, '(a,i2.2,a)')
     *           '                <TD WIDTH=
     *           YearLength - 337,
     *           '" ALIGN="CENTER">F<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">M<
      write (96, '(a)')
     *           '                <TD WIDTH="30" 
     *           'ALIGN="CENTER">A<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">M<
      write (96, '(a)')
     *           '                <TD WIDTH="30" 
     *           'ALIGN="CENTER">J<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">J<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">A<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">S<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">O<
      write (96, '(a)')
     *           '                <TD WIDTH="30" 
     *           'ALIGN="CENTER">N<
      write (96, '(a)')
     *           '                <TD WIDTH="31" 
     *           'ALIGN="CENTER">D<
      write (96, '(a)')
     *           '              </T
      write (96, '(a)')
     *           '            </TABL
      write (96, '(a)')
     *           '          </T
      write (96, '(a)')
     *           '        </T
      write (97, '(a)')
     *           '        <T
      write (97, '(a)')
     *           '          <T
      write (97, '(a)')
     *           '            <TABLE BORDER="1
      write (97, '(a)')
     *           '              <TR BGCOLOR="CCFFFF
      write (97, '(a)')
     *           '                <TD WIDTH="90" ALIGN="CENTER"&
     *           '<A HREF="http://walrus.wr.usgs.gov/infobank/
     *           'programs/html/dates2html/dates.html">
     *           'Dates</A>
      write (97, '(a)')
     *           '              </T
      write (97, '(a)')
     *           '            </TABL
      write (97, '(a)')
     *           '          </T
      write (97, '(a)')
     *           '        </T
      write (91, '(a)')
     *    '<CENTER><A HREF="http://walrus.wr.usg
     *    'infobank/programs/html/audience/'//
     *    'dates_audience.html">
     *    'Intended Audience</A><
      write (91, '(a)')
     *    '<TABLE WIDTH="500" BORDER="3
                  write (91, '(a)')
     *                '  </T
              write (91, '(a)')
     *            '  <T
          write (AYear, '(i4.4)') Year
              write (91, '(a)')
     *            '    <TD&
     *            '<A HREF="http://walrus.wr.usgs.gov
     *            '/infobank/programs/html/dates2html'//
     *            '/'//AYear//'.html">'//AYear//'</A&
              write (91, '(a)')
     *            '    <TD>'//AYear//'
      write (91, '(a)')
     *    '  </T
      write (91, '(a)')
     *    '</TABL
      write (91, '(a,/,a,/,a,/,a)')
     *    '<P
     *    '<FONT COLOR="GREEN"
     *    'Time is nature''s way of making sure that '//
     *    'everything doesn''t happen at once.',
     *    '</FON
Opens
      open (unit = 91,
     *      access = 'sequential',
     *      form = 'formatted',
     *      status = 'unknown',
     *      file = '/tmp/dates2html_days.temp')
      open (unit = 92,
     *      access = 'sequential',
     *      form = 'formatted',
     *      status = 'old',
     *      file = '/tmp/dates2html_sorted.temp')
              open (unit = 94,             ! header
     *            access = 'sequential',
     *              form = 'formatted',
     *            status = 'unknown',
     *              file = '/tmp/dates2html.part1.temp')
              open (unit = 95,             ! left column table
     *            access = 'sequential',
     *              form = 'formatted',
     *            status = 'unknown',
     *              file = '/tmp/dates2html.part2.temp')
              open (unit = 96,             ! middle column table
     *            access = 'sequential',
     *              form = 'formatted',
     *            status = 'unknown',
     *              file = '/tmp/dates2html.part3.temp')
              open (unit = 97,              ! right column table
     *            access = 'sequential',
     *              form = 'formatted',
     *            status = 'unknown',
     *              file = '/tmp/dates2html.part4.temp')
              open (unit = 98,              ! footer
     *            access = 'sequential',
     *              form = 'formatted',
     *            status = 'unknown',
     *              file = '/tmp/dates2html.part5.temp')
      open (unit = 90,
     *      status = 'old',
     *      access = 'sequential',
     *      form = 'formatted',
     *      name = '/tmp/dates2html_htmllist.temp')
      open (unit = 91,
     *      status = 'unknown',
     *      access = 'sequential',
     *      form = 'formatted',
     *      name = 
     *  '/infobank/programs/html/dates2html/dates.html')
Calls
          call system ('/bin/cat /infobank/'//
     *         Alpha(Loop:Loop)//
     *         '/*/meta/*.dates > 
     *         '/tmp/dates2html_dates.temp') 
              call system ('/bin/cat /infobank/'//
     *         Alpha(Loop:Loop)//
     *         '/*/meta/*.dates >&g
     *         '/tmp/dates2html_dates.temp')
       call openem (1,0)
          call stringlen (ID, IDLength)
          call getcentury (StartYear, StartCentury)
          call getcentury (EndYear, EndCentury)
      call system ('/bin/sort '//
     *     '/tmp/dates2html_days.temp > 
     *     '/tmp/dates2html_sorted.temp')
      call system ('/bin/rm /tmp/dates2html_days.temp')
                  call htmlfoot (98,
     *                'http://walrus.wr.usgs.gov/'//
     *                'infobank/programs/html/'//
     *                'dates2html/'//
     *                OutDate//'.html')
                  call system ('/bin/cat '//
     *                '/tmp/dates2html.part1.temp '//
     *                '/tmp/dates2html.part2.temp '//
     *                '/tmp/dates2html.part3.temp '//
     *                '/tmp/dates2html.part4.temp '//
     *                '/tmp/dates2html.part5.temp '//
     *                '> /infobank/programs/html/
     *                'dates2html/'//OutDate//'.html')
                  call system ('/bin/rm '//
     *                '/tmp/dates2html.part*.temp')
              call htmlhead (94, 'CMG '//OutDate//
     *            ' Field Activities')
              call datebar (YearLength, CurrentYear)
          call stringlen (Link, LinkLength)
          call changecase ('SMALLS', Link(1:LinkLength))
      call htmlfoot (98,
     *                'http://walrus.wr.usgs.gov/'//
     *                'infobank/programs/html/'//
     *                'dates2html/'//
     *                OutDate//'.html')
      call system ('/bin/cat '//
     *                '/tmp/dates2html.part1.temp '//
     *                '/tmp/dates2html.part2.temp '//
     *                '/tmp/dates2html.part3.temp '//
     *                '/tmp/dates2html.part4.temp '//
     *                '/tmp/dates2html.part5.temp '//
     *                '> /infobank/programs/html/
     *                'dates2html/'//OutDate//'.html')
      call system ('/bin/rm '//
     *                '/tmp/dates2html.part*.temp')
      call system ('/bin/rm '//
     *                '/tmp/dates2html_*.temp')
      call datecontrol
      call system ('/bin/ls -1 '//
     *    '/infobank/programs/html/dates2html/????.html > 
     *    '/tmp/dates2html_htmllist.temp')
      call htmlhead (91, 'CMG Field Activities keyed on Year')
      call htmlfoot (91, 
     *    'http://walrus.wr.usgs.gov/infobank/programs/'//
     *    'dates2html/dates.html')

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/html/dates2html/special/specialdates2html.doc.html
Page Contact Information: InfoBank staff
Page Last Modified: Thu Nov 14 03:04:09 PST 2013  (chd)