program jslapd

*

c    *Purpose: convert "archive" to "processing" format for daily data.

*

c    *Declare Variables

      character dstn*3, ver*1

      character afile*9, pfile*9

      character head*19, hbuf*4, hrec*9

*

      dimension idar1(12,31), idar2(372)

      equivalence ( idar2, idar1 )

*

      data afile / 'dsssv.dat' /      

      data pfile / 'dvsss.dat' /            

*      

      call userin( dstn, ver )

*

c    *build filenames and open.

      afile(2:4) = dstn

      afile(5:5) = ver

      pfile(2:2) = ver

      pfile(3:5) = dstn

      open(unit=10,file=afile,status='old')

      open(unit=12,file=pfile,status='new')

*

c    *read in and write out header

      read(10,100) hbuf, head, istart, iend

  100 format(a4,1x,a19,20x,i4,1x,i4)      

      hrec(1:3) = hbuf

      hrec(4:9) = head(1:6)

      write(12,200) head

  200 format(1x,a19,'   Daily Values from 119-point Filter')

*      

c    *read in one year at a time                 

      do 5 iy = istart, iend

         do 10 j = 1, 31

            read(10,300) (idar1(i,j), i=1,12)

   10    continue

  300    format(20x,12i5)

*

c       *write out in "proc" format    

	 ie = 0

         do 30 im = 1, 12

            do 50 ir = 1, 2

	       is = ie + 1

	       ie = ie + 11

	       write(12,500) hrec, iy, im, ir, (idar2(iv), iv=is,ie)

   50       continue

            ir = 3

            if( im .eq. 2 ) then

               if( mod(iy,4) .eq. 0 ) then

                  is = ie + 1

		  ie = ie + 7

	          write(12,700) hrec, iy, im, ir, (idar2(iv), iv=is,ie)

	       else

                  is = ie + 1

		  ie = ie + 6

	          write(12,600) hrec, iy, im, ir, (idar2(iv), iv=is,ie)	       

	       endif

	    elseif( im .eq. 1 .or. im .eq. 3 .or. im .eq. 5 .or.

     +              im .eq. 7 .or. im .eq. 8 .or. im .eq. 10 .or.

     +              im .eq. 12 ) then

              is = ie + 1

              ie = ie + 9

	      write(12,800) hrec, iy, im, ir, (idar2(iv), iv=is,ie)

	    else

              is = ie + 1

              ie = ie + 8

	      write(12,900) hrec, iy, im, ir, (idar2(iv), iv=is,ie)

	    endif

   30    continue

    5 continue

*    

  500 format(a9,2x,i4,i2,i1,1x,11i5)

  600 format(a9,2x,i4,i2,i1,1x,6i5)  

  700 format(a9,2x,i4,i2,i1,1x,7i5)  

  800 format(a9,2x,i4,i2,i1,1x,9i5)  

  900 format(a9,2x,i4,i2,i1,1x,8i5)  

*

      close(10)

      close(12)

      stop 'cowabunga'

      end

*      

      subroutine userin( dstn, ver )

*      

      character dstn*3, ver*1

*

      write(6,100)

  100 format(///////'   Convert JASL archiving to processing format',/,

     +              '                 for daily data         ',//)

*

      write(6,300)

  300 format(/,' Enter station #                          : ',\)

      read(5,'(a)') dstn

*

      write(6,500)

  500 format(/,' Enter series version                     : ',\)

      read(5,'(a)') ver

*

      return

      end