ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c 26 June 1993
c this is the shell of a csv jgofs method 
c  to def format
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      program csv
      parameter(maxrow=100,maxcol=100,maxdlines=50)
      character*20 v1(maxcol,maxdlines),v0(maxrow)
      character*80 c(maxrow)
      logical t(maxcol,maxrow),g(maxcol,maxrow),sk(maxrow),l0(maxrow)
      logical la(maxrow,maxcol),ln(maxrow,maxcol)
      character*20 f
      common/method/c,v0,v1,t,g,sk,l0,la,ln,
     &   jrec,jrecd,jrecmax,irecmax,maxcomment
      character*20 names(maxrow)
      common/gf4_n/n_total,n_group,names 


      open (unit=2,file='csvgrp.dat')
      open (unit=3,file='csv3.dat')
      call readtemplate('template3.csv3')
      write(2,200) (names(j)(1:lnblnk(names(j))+1),j=1,n_group),' >'
      write(2,200) (names(j)(1:lnblnk(names(j))+1),j=n_group+1,n_total)
200   format(100a)

      
101   read(3,10,end=100) f
10    format(a20)
      call readdata(f)

      f = f(1:lnblnk(f)) // '.def'
      write(2,200) (v0(j)(1:lnblnk(v0(j))+1),j=1,n_group),f
      open(unit=4,file=f)
      do 102 i = 1,maxcomment
      write(4,200) '# ',c(i)(1:lnblnk(c(i)))
      c(i)=' '
102   continue

      write(4,200) (names(j)(1:lnblnk(names(j))+1),j=n_group+1,n_total)
      do 110 j = 1,irecmax
         do 105 i = 1,n_total-n_group
105         v1(i,j)(20:20)=' '
c            if (v1(1,j).eq.'T/STD'.or.v1(7,j).ne.'nd') then
      write(4,200) (v1(i,j)(1:lnblnk(v1(i,j))+1),i=1,n_total-n_group)
c            end if
110   continue
      close(4)
      write(*,*) '-----------'
      goto 101
100   write(*,*) ' finished'      
      end

      subroutine readdata(f)
      parameter(maxrow=100,maxcol=100,maxdlines=50)
      character*20 names(maxrow)
      character*20 v1(maxcol,maxdlines),v0(maxrow)
      character*80 c(maxrow),sc
      logical t(maxcol,maxrow),g(maxcol,maxrow),sk(maxrow),l0(maxrow)
      logical la(maxrow,maxcol),ln(maxrow,maxcol)
      character*20 f,s
      common/method/c,v0,v1,t,g,sk,l0,la,ln,
     &   jrec,jrecd,jrecmax,irecmax,maxcomment
      common/gf4_n/n_total,n_group,names  
      integer count
      character*20 extract,cvtlat,cvtlon,blank
      character*80 extractc
      character*512 buff
      jrec=0
      irec=0
      in = 0
      inlast=0
      ig = 0
  
      open (unit=1,file=f)
c
c reads in group variable names until data header name 'breakout'
c found
c
       jlevel    = nextrec(buff)
       nc        = count(buff)

       goto 110

100    jlevel= nextrec(buff)
110    do while (jlevel.eq.0)

          do i = 1,nc
            s = extract(buff)         
            if(g(i,jrec)) then
              if (la(i,jrec)) s = cvtlat(s)
              if (ln(i,jrec)) s = cvtlon(s) 
              ig = ig+1
              v0(ig)=s(1:19)
              write(*,*) ig,' 0: ',s(1:lnblnk(s))
            end if
          end do
c***
11      format(a)
12      format(100l1)
      goto 100
      end do
      goto 210
c
c read in data level 1
c

c*** fill in data fields that will be read based on column headers

200   jlevel=nextrec(buff)
210   inlast=in
      in =0 
      irec=irec+1
      do while (jlevel.eq.1)
      write(*,*) 'irec=',irec
         do i = 1,nc
            s = extract(buff)
            if(t(i,jrec)) then 
              in = in+1
              v1(in,irec)=s(1:19)
              write(*,*) in,' 1:  ',s(1:lnblnk(s))
            end if
          end do
      goto 200
      end do
      irecmax=irec-1
      write(*,*) '**** end data ****'
      goto 410

c*** look for MULVFS comm system data
 
400   jlevel=nextrec(buff)
410       do i = 1,nc
            s = extract(buff)
            if(g(i,jrec)) then 
              ig = ig+1
              s = blank(s)
              v0(ig)=s(1:19)
              write(*,*) ig,' 0:',s(1:lnblnk(s))
            end if
          end do
      if (jrec.lt.jrecmax) goto 400
c
c
      write(*,*) 'begin comments'
      ic=0
500   jlevel=nextrec(buff)
      if (jlevel.eq.-1) return
      do j = 1,2
           sc = extractc(buff)
           if (sc(1:2).ne.'nd') then 
           ic = ic + 1 
           c(ic)=sc
           write(*,*) c(ic)
           end if
      end do
      maxcomment=ic
      goto 500
   
1000   stop
      end

      subroutine readtemplate(f)
      parameter(maxrow=100,maxcol=100,maxdlines=50)
      character*20 names(maxrow),gnames(maxrow)
      common/gf4_n/n_total,n_group,names 
      character*20 v1(maxcol,maxdlines),v0(maxrow)
      character*80 c(maxrow)
      logical t(maxcol,maxrow),g(maxcol,maxrow),sk(maxrow),l0(maxrow)
      logical la(maxrow,maxcol),ln(maxrow,maxcol)
      character*20 f,s
      common/method/c,v0,v1,t,g,sk,l0,la,ln,
     &   jrec,jrecd,jrecmax,irecmax,maxcomment  
      integer count
      character*20 extract
      character*512 buff
      irec=0
      in = 0
      ig = 0

      do 5 j = 1,maxrow
      sk(j)=.true.
      l0(j)=.false.

      do 5 i = 1,maxcol
      la(i,j)=.false.
      ln(i,j)=.false.
      g(i,j)=.false.
5     t(i,j)=.false.
  
      open (unit=1,file=f)
c
c reads in group variable names until data header name 'breakout'
c found
c

10    read (1,11,end=100) buff
      jrec=jrec+1

      do while (buff(1:2).ne.'1:')

c*** first time through
        if (init.eq.0) then 
          nc = count(buff)
          init = 1
        end if 
          do i = 1,nc
            s = extract(buff)
            if(s(1:2).eq.'0:') then 
              ig = ig+1
              g(i,jrec)=.true.
              t(i,jrec)=.true.
              sk(jrec)=.false.
              l0(jrec)=.true.
              gnames(ig)=s(3:lnblnk(s))
c              write(*,*) ig,' ',s(1:lnblnk(s))
c
c figure out if name contains 'lat'
c  or 'lon' if so mark it for data conversion
c
              il = index(s,'lat')
                 if (il.gt.0) la(i,jrec)=.true.
              il = index(s,'lon')
                 if (il.gt.0) ln(i,jrec)=.true.

            end if
          end do
c***
11      format(a)
12      format(100l1)

      goto 10
      end do
c
c read in data names level 1
c
       
          do i = 1,nc
            s = extract(buff)
            if(s(1:2).eq.'1:') then 
              in = in+1
              t(i,jrec)=.true.
              sk(jrec)=.false.
              names(in)=s(3:lnblnk(s))
c             write(*,*) in,' data name ',s(3:lnblnk(s))
            end if
          end do
      jrecd = jrec

c*** fill in data fields that will be read based on column headers

200   read (1,11,end=100) buff
      jrec=jrec+1

      do while (buff(1:5).ne.'1:end')
      
          do i = 1,nc
              t(i,jrec)=t(i,jrecd)
              sk(jrec)=.false.
          end do

      goto 200
      end do
c      jrecmax=jrec-1


400   read (1,11,end=100) buff
      jrec = jrec+1
      do while (buff(1:2).ne.'c:')
          do i = 1,nc
            s = extract(buff)
            if(s(1:2).eq.'0:') then 
              ig = ig+1
              g(i,jrec)=.true.
              t(i,jrec)=.true.
              sk(jrec)=.false.
              l0(jrec)=.true.
              gnames(ig)=s(3:lnblnk(s))
c              write(*,*) ig,' ',s(1:lnblnk(s))
            end if
          end do
      goto 400
      end do

      n_total=ig+in
      n_group=ig
      do i = in,1,-1
      names(ig+i)=names(i)
      end do

      do i = 1,ig
      names(i)=gnames(i)
      end do

      jrecmax=jrec
      do j = jrecmax,maxrow
      sk(j)=.false.
      end do

      close(1)
      return
100   stop
      end

      integer function nextrec(buff)
      parameter(maxrow=100,maxcol=100,maxdlines=50)
      character*20 v1(maxcol,maxdlines),v0(maxrow)
      character*80 c(maxrow)
      logical t(maxcol,maxrow),g(maxcol,maxrow),sk(maxrow),l0(maxrow)
      logical la(maxrow,maxcol),ln(maxrow,maxcol)
      character*512 buff
      common/method/c,v0,v1,t,g,sk,l0,la,ln,
     &   jrec,jrecd,jrecmax,irecmax,maxcomment

10    read (1,11,end=100) buff
      jrec=jrec+1
      if (sk(jrec)) then 
        goto 10
      end if
      nextrec = 1
      if (l0(jrec)) nextrec=0
      return
100   close(1)
      nextrec = -1
11      format(a)
      return
      end

      integer function count(s)
      character*512 s,sav
      integer count
      count = 0
      l = lnblnk(s)
      sav=s
10      ix = index(s,',')
        if (ix.gt.0) then 
        count=count+1
        s = s(ix+1:l)
        l = l -ix
        goto 10
        end if
       s=sav
       return
       end

      character*20 function cvtlat(s)
      parameter(ideg=161)
      character*20 s
      ix = index(s,char(ideg))
      if (ix.gt.0) then 
        lb = lnblnk(s)
        read(s(1:ix-1),*) deg
        read(s(ix+1:lb-1),*) dmin
     
        deg=deg+dmin/60.
        if (index(s,'S').gt.0) deg=-deg
        s = ' '
        write(s,20) deg
20      format(f9.4)
        cvtlat=s
      else
        cvtlat='nd'
      end if
      
      end

      character*20 function cvtlon(s)
      parameter(ideg=161)

      character*20 s
      ix = index(s,char(ideg))
      if (ix.gt.0) then 
        lb = lnblnk(s)
        read(s(1:ix-1),*) deg
        read(s(ix+1:lb-1),*) dmin
     
        deg=deg+dmin/60.
        if (index(s,'W').gt.0) deg=-deg
        s = ' '
        
        write(s,20) deg
20      format(f9.4)
        cvtlon=s
      else
        cvtlon='nd'
      end if
      end

      character*20 function blank(s2)

      character*20 s2
10    ix = index(s2,' ')
        do while(ix.eq.1)
        s2=s2(2:20)
        goto 10
        end do 
       l = lnblnk(s2)

20     ix = index(s2,' ')
       do while (ix.gt.0.and.ix.lt.l)
          s2(ix:ix)='_'
       goto 20
       end do
     
       blank=s2               
       end

      character*20 function extract(s)

      character*512 s
      l = lnblnk(s)
      ix = index(s,',')
        if (ix.gt.1) then 
          extract = s(1:ix-1)
          if (lnblnk(extract).eq.0.or.extract.eq.'n.d.') extract='nd'
        else
          extract='nd'
        end if
        s = s(ix+1:l)
       end

      character*80 function extractc(s)

      character*512 s
      l = lnblnk(s)
      ix = index(s,',')
        if (ix.gt.1) then 
          extractc = s(1:ix-1)
          if (lnblnk(extractc).eq.0) extractc='nd'
        else
          extractc='nd'
        end if
        s = s(ix+1:l)
       end
