ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c Jun 04 fix rosette type identification 
c Oct 22 converted to new outer minor changes to code as well
c Oct 06 modified to write /tmp/pid.junk as list of files
c the method will read
c jul 22 version from server software
c 08-July-1992 19:30 program for JGOFS DBMS (Bishop)
c
c Method for UW/ ctd data
c
c if the method receives a wildcard file name
c     /data/ftp/thompson/TT007/ctd/tt007*.log
c     
c     then, it writes a file to /tmp/junk
c     which contains the expanded list of 
c     file names matching the file name specification
c     this file is deleted after method is finished
c
c     files with the extension of 'log' are scanned for group variables
c     files with the extension of 'prc' for data
c       if trans data are present then 'beamc' is computed
c
c     the method tolerates 'dos' formatted files
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   ioopen  Open data file
c     Input: character mc*(*), nparams
c         params(i = 1 .. nparams) corresponds to 80 character
c         data blocks contained in mc. The method must extract
c         the file path and name from the first 80 chars of mc.
c
c     Output: The following items in the common blocks
c       must be set by ioopen
c         n_total: total number of variables (up to 150)
c         n_group: number of group variables (these must
c                  appear first in the list of names and
c                  values
c         names:   character*40 (1..n_total) variable names 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      integer function ioopen(mc, nparams, ntotal)
      parameter(n_max=150,max_com=25)
      character mc*(*)
      character*40  names(n_max)
      integer       n_total,n_group,ntotal

      parameter(max_data=12,max_group=15)
      character*80  fi_scr,filnam

      character*80  comments(25)
      character*20  groupd(max_group)
      character*20  v(150)

	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
	character*80 params(20)
	integer paramcnt,nparams
        common/gf4_p/paramcnt,params
        integer ifirst
        character*1 c
        character*3 sta
        integer mult_flag,igrp_flag
        logical f_is_there,g_is_there
        character*80 dir, fi_nam, sat_file
        character*40 dfile
        integer*2 verify

        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

	data dir /' '/,mult_flag /0/, g_is_there/.false./
        data sta/' '/,igrp_flag /0/, minstn /-9999/, maxstn /9999/

        data n_group/0/,n_total/0/
        data comments /25*' '/

	    do 5 i=1,n_max
5           v(i) = '-999'
         paramcnt=nparams
c
c load params array user must set mc(ioff+1:ioff+1) = '\0'
c if method acts on that parameter. e.g. could make selection
c more efficient. This method extracts the file name.
c
        do 10 i = 1,nparams
         ioff = (i-1)*80
         params(i) = mc(ioff+1:ioff+80)
         inul = index(params(i),char(0))
           if (inul.gt.0) params(i)=params(i)(1:inul-1)
10      continue
        mc(1:1) = '\0'
c
c find directory name
c
        filnam=params(1)
        lb = lnblnk(filnam) 

         do 100, l = lb,1,-1
           c = filnam(l:l)
           if (c.eq.'/'.or. c.eq.'\\' .or. c.eq.']') then 
	     dir   = filnam(1:l)
             dfile = filnam(l+1:lb)
	     goto 110
	   endif
100	 continue
	 dir   = ' '
	 dfile = filnam(1:lb)


110     continue
ccccccccccc        satish's code starts    ccccccccccccccccc
c        dir = unfixstr(dir)
        sat_file = dir(1:lnblnk(dir))//'uwctdn.ver'
        call fixstr(sat_file)
        i= verify(sat_file)
        if (i.ne.0)then
           if(i.eq.2) call parentwrite('&error--Could not open file\0')
           call parentwrite('&error--Invalid Passwd Error\0')
           call parentclose
        endif

ccccccccccc        satish's code ends      ccccccccccccccccc

        fi_nam=filnam
        inquire(file=fi_nam,exist=f_is_there)
c
c check for * at end of file name
c to indicate a group
c
	lb = lnblnk(dfile)
        if (dfile(lb-4:lb-4).eq.'*') g_is_there=.true.

c	write(7,*) dir,   ' directory '
c       write(7,*) dfile, ' data file '
c       write(7,*) f_is_there,g_is_there


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c groups of files exist ?
c
c      c routine 'get_file' executes ls fi_nam > /tmp/junk
c
c the header info is in ttxxxccc.log file, where xxx = cruise #
c   ccc = ctd cast no.
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

        if (g_is_there) then
          mult_flag = 1
          fi_nam = dir(1:lnblnk(dir))//dfile(1:lnblnk(dfile))

          call get_file(fi_nam,lnblnk(fi_nam),fi_scr)
          iii = index(fi_scr,char(0))
          open(unit=4,file=fi_scr(1:iii-1),status='SCRATCH')
          call nextfi
        endif

119     call uwctd_read_header(iskip)
        if (iskip.eq.1) then 
         close (unit=1)
         goto 119
        end if
c
c  initiallize 
c
           nlevels=1
           eofflag=.false.
           group_changed = .true.
           ioopen=nlevels
           ntotal=n_total
c
c send comments out
c
          call parentwrite('&c\0')
	  do 810 i = 1,max_com 
          if (comments(i)(1:1) .ne. ' ') then 
	   call fixstr(comments(i))
           call parentwrite(comments(i))
          end if
810       continue

      	return
        end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   int ioreadrec(level) Get next record of data in a particular level
c     Input:  level integer indicating which level in hierarchy
c             to be read.
c     Output: ioreadrec=1 ok, 0=eof at this level
c             if ioreadrec=0 at level 0 then method exits
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   In addition, for internal uses, this routine would
c     usually fill out the internal representations of
c     the values of each variable in the record. In this
c     case the info is held in the /method/ common
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      integer function ioreadrec(level)
      parameter(max_data=12,max_group=15)
      integer level
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag

      character*80  comments(25)
      character*20  groupd(max_group)
      character*20  v(150)
        character*80 dir, fi_nam
        character*40 dfile
        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

      ifirst = ifirst+1
      eofflag=.false.
      ioreadrec=1
      call readrec(level)
        if(eofflag)then
          ioreadrec=0
        endif
      return
    
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c   uwctd_read_header returns group data called by 
c    io_open and io_get
c
c   iskip = 1 means skip this file because group station 
c   not in range preselected
c
c   this code is specific to UW's ctd data structure
c   returns n_group, n_total, names()    , v(), and comments()
c                             ^all headers ^group data
c
c   returns ic_stn = 4: which is column no containg station id
c                       and is used in preselection
c   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine uwctd_read_header(iskip)
      parameter(max_data=12,max_group=15)
        parameter(n_max=150, max_hrecs=21)
        character*40  names(n_max)
        integer n_total,n_group
        integer ifirst

      character*20 header(max_hrecs)
      character*20  new_g_names(max_group)
      character*20  new_d_names(max_data)
      character*20  new_d_attributes(max_data)
     
      integer       ig,ic,id

        character*80  comments(25)
        character*20  groupd(max_group)
        character*20  v(150)

	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
	character*80 params(20)
	integer paramcnt
        common/gf4_p/paramcnt,params

        integer mult_flag
        character*80 dir, fi_nam
        character*40 dfile

        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

        data ig/0/,id/0/,ic/0/,ifirst/0/

c method specific definitions

      data new_g_names /
     & 'type','cruise','event','station','cast',
     & 'lat','lon','year','month','day','jday','hours',
     & 'program','ros','bottom_depth'/


      data new_d_names /
     & 'depth','press','temp','cond','sal',
     & 'theta','sigma','sigmat','fluor','trans',
     & 'par','beamc'/
      data new_d_attributes /
     & 'meters','db','deg C','mmohs','psu',
     & 'deg C','kg/m^3','kg/m^3','mg/m^3','%',
     & 'E/m^2','m^-1'/

c note there are 12 columns of data but depth is repeated
c instead we will replace that column with beamc computed 
c from trans.

      open(unit=1,file=fi_nam(1:lnblnk(fi_nam))
     $  ,err=2000,status='old',readonly)

c      write(7,*) 'read_hdr:',fi_nam(1:lnblnk(fi_nam)), ' was opened'

      id=max_data-1
      ic=0
      ig = max_group

cccc header recs in log file
c 01   Ship name
c 02   english station title
c 03   CTD sensor id
c 04   program id
c 05   station no
c 06   sensor list e.g. C,T,D,Tr,Fl,24btl
c 07   cruise id
c 08   english local datetime stnno ctdno
c 09   depth
c 10   operator
c 11   date mm/dd/yy gmt format
c 12   raw data file
c 13   time start gmt
c 14   time finish gmt
c 15   data tape id
c 16   start pos lat
c 17   end pos lat
c 18   tape start reading
c 19   start pos long
c 20   end pos long
c 21   tape end reading
cccc

      ic_stn = 4
c      ifirst=ifirst+1

       do 415 i = 1 , max_hrecs
       read(1,410) header(i)
      ix = lnblnk(header(i))
      if (ix.eq.0) header(i)='nd'
      call stripbl(header(i))
410   format(a20)
415   continue
      close(unit = 1)
C
C  fill in comments
c
      comments(1) = 'start positions and times only'
      comments(2) = '**** data are preliminary ****'
      ic = 2
cccc
c
c  fill in values for group variables, total no = ig
c
c  read log file and extract group information
c
c  1 data type 
c  2 cruise id
c  3 event 
c  4 station no
c  5 cast no
c  6 decimal latitude
c  7 decimal longitude
c  8 yy
c  9 mm
c 10 dd 
c 11 julian day (computed)
c 12 hours from hh:mm:ss
c 13 program id
c 14 rosette id
c 15 bottom depth
c
cccc

      iskip = 0
      if (ichar(dfile(6:6)).gt.ichar('9')) then
       iskip = 1
      return
      end if

      groupd(1)  = header(3)
      groupd(2)  = header(7)
      groupd(3)  = header(8)(1:8)
      groupd(4)  = header(5)
      read(header(5),419) ista
419   format(i5)

c
c  is this the right data file based on station criteria
c
      iskip = 0
      if (ista.lt.minstn.or.ista.gt.maxstn) then 
        iskip = 1
        return
      end if
      groupd(5)  = dfile(6:8)
c
c compute decimal latitude and longitudes
c
      if (header(16)(1:2).eq.'nd') then 
        groupd(6)='nd'
        groupd(7)='nd'
      else
        read(header(16)(2:4),420) ilat
	read(header(16)(6:12),421) amin
        if (header(16)(1:1).eq.'S') then
          alat = -(ilat + amin/60.)
        else 
          alat = ilat + amin/60.
        end if
        write(groupd(6),422) alat
          
c
        read(header(19)(2:4),420) iln
	read(header(19)(6:12),421) amin
        if (header(19)(1:1).eq.'W') then
          aln = -(iln + amin/60.)
        else 
          aln = iln + amin/60.
        end if
        write(groupd(7),423) aln
      end if

420   format(i3)
421   format(f7.4)
422   format(f8.4)
423   format(f9.4)

      if (header(11)(1:2).eq.'nd') then 
        groupd(8)='nd'
        groupd(9)='nd'
        groupd(10)='nd'
        groupd(11)='nd'
      else
        groupd(8)  = header(11)(7:8) 
        groupd(9)  = header(11)(1:2) 
        groupd(10) = header(11)(4:5)
c
c create julian day
c
        read(groupd(8),430) iy
        read(groupd(9),430) im
        read(groupd(10),430) iday
430     format(i2)
431     format(i3)
        jd = julian(iy,im,iday)
        write(groupd(11),431) jd
       end if
c
        ix = index(header(13),':')
        if (ix.gt.0) then 
           read(header(13)(ix-2:ix-1),430) ihr
           read(header(13)(ix+1:ix+2),430) imin
           read(header(13)(ix+4:ix+5),430) isec
         hours = ihr+float(imin)/60.+float(isec)/3600.
         write(groupd(12),432) hours
432      format(f7.4)
        else
         groupd(12)='nd'
        end if
      groupd(13) = header(04)
c
c get rosette type
c we assume the last record is kind of rosette 
c
      lb = lnblnk(header(6))
        do 449 i = lb, 1, -1
        if (header(6)(i:i).eq.',') then
         groupd(14) = header(6)(i+1:lb)
         ix = index(groupd(14),'12')
          if (ix.gt.0) then 
             groupd(14)='12btl'
          else 
             groupd(14)='24btl'
          end if
         goto 450
        end if
449   continue
      groupd(14) = 'nd'
450   continue
      groupd(15) = header(9)(1:index(header(9),' '))
c
c **** done with header and data for groups
c
      n_group = max_group
      n_total = n_group+max_data

c ****
      do 850 i = 1,n_group
      call stripbl(groupd(i))
      call masklower(groupd(i))
      if (v(i).ne.groupd(i)) then
       group_changed=.true.
       v(i)=groupd(i)
      end if
850   continue
 
      do 950 i = 1,n_group
       names(i)=new_g_names(i)
950   continue

      do 1000 i = 1,max_data
1020  names(ig+i) = new_d_names(i)

c      write(7,898) i+ig,v(ig+i)(1:lnblnk(v(ig+i)))
c     & ,names(ig+i)(1:lnblnk(names(ig+i)))
c898   format(i5,a20,a20)

1000  continue
c
c set file name to data and open it
c
      ix = index(fi_nam,'.')
      fi_nam = fi_nam(1:ix)//'prc'  
      open(unit=1,file=fi_nam,err=2100,status='old',readonly)

      eofflag = .false.
      return

2000    call parentwrite('&error uwctd:bad ".log" filename\0')
		call parentclose
                goto 2200
2100    call parentwrite('&error uwctd:bad ".prc" filename\0')
		call parentclose
2200   end	
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       integer function julian(iy,im,id)
       dimension nd(12)
       data nd/31,28,31,30,31,30,31,31,30,31,30,31/
       jday = 0
       do 10 i = 1,im-1
          jday = jday + nd(i)
10     continue
       if (im .gt. 2) then 
          if ((iy/4)*4.eq.iy) jday = jday + 1
       end if
       julian = jday + id
       return
       end

ccccccccccccccccccccccccccccccccccccccccc
c 
c   subroutine ioname(vn,tmp)  Return name of vn'th variable
c   Input:
c	integer vn: variable (0..ntotal-1)
c   Output:
c	character*40 tmp: name (0 terminated)
cccccccccccccccccccccccccccccccccccccccccc
      subroutine ioname(vn,tmp)
      integer vn
      character*40 tmp
	character*40 names(150)
	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
	character*80 params(20)
	integer paramcnt
        common/gf4_p/paramcnt,params

      tmp=names(vn+1)
      call fixstr(tmp)
      return
      end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   int iovarlevel(varnum)  level for a variable
c
c     Input:  varnum   index of variable
c     Output: integer  level
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      integer function iovarlevel(vn)
      integer vn
	character*40 names(150)
	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag

      if(vn.lt.n_group) then
        iovarlevel=0
      else
        iovarlevel=1
      endif
      return
      end

ccccccccccccccccccccccccccccccccccccccc
c     subroutine ioattrout(vn)   Put out attributes for vn'th variable
c     Input:
c	integer vn: variable number (0..ntotal-1)
c     Output:
c	calls to parentwrite to send out
c	-- number of attributes
c	-- attribute strings (attr=values)
cccccccccccccccccccccccccccccccccccccccc
      subroutine ioattrout(vn)
      integer vn
      call parentwrite('0\0')
      return
      end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   readrec   Get record of data
c
c   read routine (level =0 => group data
c                       =1 => data
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine readrec(level) 

        parameter(max_data=12,max_group=15)
	character*40 names(150)
        character*80 comments(25)
        character*2 nd
	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
        integer level	
	character*20 v(150)
        character*20 groupd(max_group)
        character*80 dir, fi_nam
        character*40 dfile

        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

	data nd/'nd'/

         if (level.eq.0) then
          if (ifirst.gt.1) then 
100        call nextfi
           if (eofflag) return
           call uwctd_read_header(iskip)
           if (iskip.eq.1) goto 100
          end if
          return
         end if

cccccccccccccccccccccccccccccccccccc
c the data are in numeric format 
c format (f8.2,x,f8.2,6f9.4,f8.3,f7.2,f9.2)
c but we'll read them as ascii
c format(a8,x,a8,6a9,a8,a7,a9)
c note ... depth column is repeated again as the 12th variable
c it will be replaced by computed beamc
c  in uw ctd data
c  missing data are 0.00 
cccccccccccccccccccccccccccccccccccccccc

200     read (1,251,end=1000,err=1000) (v(i),i=n_group+1,n_total)
251 	format(a8,x,a8,6a9,a8,a7,a9,a9)

        do 260 i = n_group+1,n_total
        if (index(v(i),' 0.00').gt.0) then 
        v(i) ='nd'
        else
         if (index(v(i),'%').eq.0) then
         call stripbl(v(i))
         else
         v(i) ='nd'
         end if
        end if
260     continue

c
c compute beamc data
c
        if (v(n_group+10).ne.'nd') then 
        read(v(n_group+10),261,err=1000) trans
261	format(f9.2)

          if (trans.gt.50.) then
          beamc = log(trans/100.)*-4. 
          write(v(n_group+12),262) beamc
262       format(f7.4)
          call stripbl(v(n_group+12))
          end if
        else
          v(n_group+12)='nd'
        end if
c
ccccccccccccccccccccccccccccccccccc
       return

1000   continue
       close(unit=1)
       eofflag=.true.
       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccc
c NEXTFI
c here is where we the get name of header file
c and the directory path
c      
cccccccccccccccccccccccccccccccccccccccccccccccccc
       subroutine nextfi
       parameter(max_data=12,max_group=15)
        parameter(n_max=150)
        character*40  names(n_max)
        integer n_total,n_group
        integer ifirst
        character*1  c
        character*80  comments(25)
        character*20  groupd(max_group)
        character*20  v(150)

	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
	character*80 params(20)
	integer paramcnt
        common/gf4_p/paramcnt,params

        integer mult_flag
        character*80 dir, fi_nam
        character*40 dfile

        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

        if (mult_flag.eq.0) then
           eofflag=.true.
           return
        end if

1090    read(4,1100,end=1900) fi_nam
1100    format(a)
         lb = lnblnk(fi_nam) 

         do 1130, l = lb,1,-1
           c = fi_nam(l:l)
             if (c.eq.'/'.or. c.eq.'\\' .or. c.eq.']') then 
	       dir   = fi_nam(1:l)
               dfile = fi_nam(l+1:lb)
               ix = index(dfile,'.')
c
c find header info in log file
c
               if (dfile(ix+1:lnblnk(dfile)).ne.'log') goto 1090
	       goto 1140
	     endif
1130	   continue

	   dir   = ' '
	   dfile = fi_nam(1:lb)
1140      continue

c	write(7,*) 'nextfi: dir=',dir(1:lnblnk(dir))
c       write(7,*) 'nextfi: fin=',dfile(1:lnblnk(dfile))
          return
          

1900    continue    
        close(unit=4,status='delete')


2000   	call parentwrite('&end\0')
      	call parentclose
      	end

ccccccccccccccccccccccccccccccccccccc
c     subroutine iovalreal(vn,f)  Return value as real number
c     Input:
c	integer vn: variable number (0..ntotal-1)
c     Output:
c	real f: value (-9999 for nd or bad data)
cccccccccccccccccccccccccccccccccccccc
      subroutine iovalreal(vn,f)
      integer vn
      real f
        parameter(j_max=200)
	character*40 names(150)
	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
	character*80 params(20)
	integer paramcnt
        common/gf4_p/paramcnt,params

        f=conv(vn+1)
      return
      end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   conv: local internal function to produce real value
c         given variable index_v
c     Input: index_v: variable for which we want the values
c     Output: conv:real, value of given variable.
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        real function conv(index_v)
	character*40 names(150)
        character*80 comments(25)
        parameter(max_data=12,max_group=15)
        real vv
	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
		
	character*20 v(150)
        character*20 groupd(max_group)
        character*80 dir, fi_nam
        character*40 dfile

        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

        vv=stor(v(index_v))
20      conv=vv
      	return
      	end

ccccccccccccccccccccccccccccccccccccc
c     subroutine iovalstr(vn,tmp) Return value as string
c     Input:
c	integer vn: variable number (0..ntotal-1)
c     Output:
c	character*40 tmp: value
cccccccccccccccccccccccccccccccccccccc
      subroutine iovalstr(vn,tmp)
      integer vn
      character*40 tmp
        parameter(max_data=12,max_group=15)
	character*40 names(150)
	common/gf4_n/n_total,n_group,names
	logical group_changed,eofflag
	common/gf4_f/group_changed,eofflag
	
        character*80 dir, fi_nam
        character*40 dfile
        character*80 comments(25)
        character*20 v(150)
        character*20 groupd(max_group)

        common/method/minstn,maxstn,v,comments,groupd,
     $  ic_stn,mult_flag,dir,dfile,fi_nam,ifirst

            tmp=v(vn+1)

20      do 21 i=1,19
		if(tmp(i:i).ne.' ') goto 22
21		continue
22		tmp=tmp(i:20)

                call fixstr(tmp)

      	return
      	end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   int ioclose()   Close all files
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine ioclose()
      close(1)
      return
      end

      real function stor(st)
c
c     Convert from character to real
c
c     st (character*40): string to convert. Typically, one of
c         the vals(i) from the dbget call. May be modified.
c     dbconv (real): real number equivalent. If string starts with
c         a non-numeric [or + - .] character, this routine gives
c         dbconv =  -9999. Quality flags at the end of st are ignored.
c         (returned)
c
        character*(*) st
        character*14 temp
        character*1 c
	ib=1
5	if(st(ib:ib).eq.' ') then
	  ib=ib+1
	  goto 5
	endif	
        c=st(ib:ib)
        if( (c.ge.'0' .and. c.le.'9') .or. c.eq.'.'
     $      .or. c.eq.'-' .or. c.eq.'+')then
           i=len(st)
 10        if(st(i:i).eq.' ')then
              i=i-1
              goto 10
           endif
           c=st(i:i)
           if((c.ge.'0' .and. c.le. '9') .or. c.eq.'.')goto 20
           st(i:i)=' '
           i=i-1
           goto 10
 20        continue
c write(*,*)'in ',st(ib:i)
           temp='              '
           temp(14+ib-i:14)=st(ib:i)
c           write(*,*)'in1 ',temp
           read(temp,1)v
c           write(*,*)'out ',v
1          format(g14.0)
           stor=v
        else
           stor= -9999
        endif
        return
        end

        subroutine stripexp(string)
c**** 921020 bishop
c****  purpose to remove excess '0' before E in exponental number
c**** 
	character*(*) string
        character*20 strtmp
10	ix = index(string,'0E')
	if (ix.eq.0) goto 20
	strtmp = string(1:ix-1)//string(ix+1:lnblnk(string))
        string =strtmp
        goto 10
	
20	return	
	end
	
      subroutine stripbl(s)
      character*(*) s

10    if (s(1:1).eq.' ') then
        s = s(2:len(s))
        goto 10
      end if
      return     
      end
      
      subroutine masklower(string)
c**** 
c**** 891219  Bishop/L-DGO  JGOFS.DBMS
c****     purpose: to mask a string from upper case to lower case
c****              
		character*(*) string

40      lenstr=lnblnk(string)

	  do 100 i = 1,lenstr
	    n = ichar(string(i:i))
	    m = n
            if (n.ge.65.and.n.le.90) then 
	     m=m+32
	     string(i:i)=char(m)
	    end if
100	continue
        return
	end

ccccccccccccccccccccccccccccccc addn from out10.f cccccccc


        subroutine fixstr(s)
        character*(*) s
        l=len(s)
        i=lnblnk(s)
        if (i.lt.l) i=i+1
        s(i:i)=char(0)
        return
        end

        character*80 function unfixstr(s)
        character*(*) s
        i=lnblnk(s)
        if(s(i:i).eq.char(0)) s(i:i)=' '
        unfixstr=s
        return
        end