cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cc                     Version 1.2                        cc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c  11 Jul 09  WJS  version 1.2
c	Address -9999.99 vs -9999. issues
c	Make sure that nulls don't terminate strings (well,
c    for SOME strings, anyway)
c	Not addressed - legions, leading off w/buffer
c    size checks.  Many problems that this program should
c    check for but doesn't (such as having at least 2
c    distinct points not on a horizontal or vertical line)
c    have been checked in pre-processing perl code.  At 
c    this point, might as well continue that trend for
c    THAT kind of checking
c  ???? G Flierl (?) version 1.1
c	Source file date, after several moves, was 12 Nov 98

      program niceprog

c	  There is some possibility that the code requires
c	  the missing value to be negative.  The -9999.
c	  is the "system" missing value for numbers.  There
c	  were formerly 2 different ones; namely, jdbread
c	  used -9999.99 and the rest of the system used
c	  -9999.  jdbread was modied in 2006 to return
c	  -9999., but no real idea how long it took for
c	  this mod to reach the field (still not there
c	  in data servers as of Jul 2009)
c	    Be nice to get this value from core.h, but
c	  not up to issue of getting fortran parameters from
c	  c .h files.
	parameter (jgofs_missing = -9999.)

	character*40 lstr(7),fmt(7)
	character*255 temp
	character*255 line,line2
        character*255 nam
	character*3 tag

        character*40 names(7)
        real vals(7)
        integer handle,nn,flag
	logical logvar(7),revvar(7)
        data logvar/7*.false./
        data revvar/7*.false./
        data lstr/7*' '/
	real rev,min(7),max(7),dx(7),ddx(7)

        call getarg(1,nam)
        nnc=iargc()-2
	call getarg(iargc(),temp)
c        write(*,*)temp
        nn=1
	do 10 i=1,nnc
           call getarg(1+i,names(nn))
           if(names(nn).eq.'-r')then
              revvar(nn) = .true.
           else if(names(nn).eq.'-l')then
              logvar(nn) = .true.
              lstr(i)='l'
           else
              call fixstr(names(nn))
              min(nn)=jgofs_missing
              max(nn)=jgofs_missing
              nn=nn+1
           endif
c           write(*,*)'NAMES =',names(i)
 10     continue
        nn=nn-1

cd    write(*,*)'here',nn
        line=nam
        call fixstr(nam)
       
        handle=1
        ilevel=jdbopen(handle,nam,names,40,nn)
        nam=line
        call fixstr(nam)
        if(ilevel.lt.0)then
           if (ilevel.eq.-999)then
              write(*,*)'Object not found or no permission'
           else
c		Fancy subscript essentially gets rid of c terminating \0
              write(*,*)'Variable not found - ',
     $			names(-ilevel)(1:in_lnblnk(names(-ilevel))-1)
           endif
           call exit(1)
        endif

        icount=0

 100  continue
      flag=jdbread(handle,vals)
c      write(*,*)flag,vals(1),vals(2)
      if (flag.lt.0)goto 1000
      icount=icount+1
	do 12 i=1,nn
	if (logvar(i)) then
	  if (vals(i).gt.0) then 
	     vals(i)=log10(vals(i))
	  else 
	     vals(i)=jgofs_missing
	  endif
       endif
	  if (vals(i).ne.jgofs_missing) then
	     if (vals(i).gt.max(i)) max(i)=vals(i)
	     if (vals(i).lt.min(i) .or. min(i).eq.jgofs_missing) min(i)=vals(i)
	  endif
12	continue
      goto 100

 1000 continue
	call jdbclose(handle)
        if(icount.eq.0)then
           write(*,*)
     $         'No data in specified object - check selection criteria'
           call exit(1)
        endif
	do 13 i=1,nn
cd	write(*,*)i,min(i),max(i)
           if(min(i).eq. jgofs_missing .or. min(i).eq.max(i))then
c		Fancy subscript essentially gets rid of c terminating \0
              write(*,*)'Variable ',
     $			names(i)(1:in_lnblnk(names(i))-1),
     $			' cannot be scaled'
              call exit(1)
           endif
	call nicecal(min(i),max(i),dx(i),ddx(i),fmt(i),logvar(i))
cd	write(*,*)dx(i),ddx(i)
	if (revvar(i)) then
	   rev=min(i)
	   min(i)=max(i)
	   max(i)=rev
	endif
cd	write(*,*)min(1),max(1),min(2),max(2)
 13     continue

	open(file=temp(1:in_lnblnk(temp)),unit=1,status='old')
c     $   carriagecontrol='none')
	open(file='tmp.plt',unit=2,status='unknown')
c     $    carriagecontrol='none')
101	continue
	read(1,1,end=200)line
1	format(a)
	  i=1
102	continue
	  if (line(i:i).eq.'%') then
	    if (line(i+1:i+1).ge.'a') then
	    tag=line(i+1:i+3)
	    if (tag.ne.'obj') then
	      ind=ichar(line(i+4:i+4))-ichar('0')
              line(i:255)=line(i+1:255)
	      endif
	  if (tag.eq.'min') then 
	     call str(min(ind),10,temp)
	  else if (tag.eq.'max') then 
	     call str(max(ind),10,temp)
	  else if (tag.eq.'tic') then 
	     call str(dx(ind),10,temp)
	  else if (tag.eq.'num') then 
	     call str(ddx(ind),10,temp)
	  else if (tag.eq.'log') then
	     if (logvar(ind)) then 
	        temp='-l' 
	     else 
	        temp=' '
		endif
	  else if (tag.eq.'nam') then 
	     temp=names(ind)(1:in_lnblnk(names(ind))-1)
	  else if (tag.eq.'fmt') then 
	     temp=fmt(ind)
	  else if (tag.eq.'obj') then 
	     temp=nam(1:in_lnblnk(nam)-1)
	     endif
	  if(temp.gt.' ')then
		line2=line(1:i-1)//temp(ifnblnk(temp):in_lnblnk(temp))
     $              //line(i+4:255)
                line=line2
	  else
		line=line(1:i-1)//line(i+4:255)

	  endif
c	write(*,*)temp
c	write(*,*)line
	  endif
          endif
	  i=i+1
	  if(i.le.len(line)-3) goto 102

	  write(2,1)line(ifnblnk(line):in_lnblnk(line))
	  goto 101
200	  close(1)
	  close(2)
          call exit(0)
	  end

	  subroutine nicecal(u1,u2,duu,du1,fmt,logflg)
	  character*40 fmt,line2
	  character*20 pounds
	  data pounds/'xxxxxxxxxxxxxxxxxx'/
	  logical logflg
	  u1s=u1
	  u2s=u2
	  du=u2-u1
	  duu=log10(du)
	  if (duu.ge.0) then 
	    iduu=int(duu) 
	  else 
	    iduu=int(duu-1.0)
	    endif
cd	write(*,*)duu,iduu
	  duu=10.0**iduu
cd	write(*,*)duu	  
	  if (.not. logflg) then
	    if ((du/duu .lt. 2)) duu=duu/5
	    if ((du/duu .lt. 4)) duu=duu/2.0
	  endif
cd	write(*,*)duu
	  if (u1.lt.0) then 
	    u1=-duu*int(abs(u1)/duu) 
	  else 
	    u1=duu*int(u1/duu)
	    endif
	  if ((u1 .gt. u1s+0.001*duu)) u1=u1-duu
	  if (u2.lt.0) then 
	    u2=-duu*int(abs(u2)/duu) 
	  else 
	    u2=duu*int(u2/duu)
	    endif
	  if ((u2 .lt. u2s-0.001*duu)) u2=u2+duu
	  if (logflg) then
	    duu=1
	    nt=int((u2-u1)/duu)
	    if (nt.le.5) then 
	      du1=1 
	    else 
	      du1=2
	      endif
	    if ((u1 .lt. -3) .or. (u2.gt.3)) then 
	      fmt='exx' 
	    else
	      fmt=pounds(1:int(u2)+1)//'.'//pounds(1:int(-u1))
	      endif
	  else
	    nt=int((u2-u1)/duu)
	    if(nt.ge.6 .and. nt.le.7)then
	      du1=duu*2
	    else if (nt.eq.8) then
	      du1=duu*4
	    else if (nt.eq.9) then
	      du1=duu*3
	    else if (nt.ge.10 .and. nt.le.20) then
	      du1=duu*5
	    else
	      du1=duu
	    endif
	    du=log10(duu)
	    if (du.lt.0) then 
	      fmt='.'//pounds(1:int(1.0-du))
	    else 
	      fmt=' '
	      endif
	    du=abs(u2)
	    if (abs(u1).gt.du) du=abs(u1)
	    du=log10(du)
	    if (du.ge.0) then 
	      line2=pounds(1:int(du)+1)//fmt
	    else 
	      line2='x'//fmt
	    endif
            fmt=line2
          endif
	  end

          subroutine str(v,n,st)
          character*80 st,st1
          if(v.eq.0)then
             st='0'
             return
          endif
	st1=' '
          write(st1,*)v
	i=in_lnblnk(st1)
          if(index(st1,'E').gt.0)goto 20
	do 10 i=20,2,-1
	if(st1(i:i).gt.'0' .or. st1(i:i).eq.'.')goto 20
10	continue
20	continue
	st=' '
c	write(*,*)'1>',st
cd	write(*,*)'2>',st1
	j=ifnblnk(st1)
cd	write(*,*)'2.5>',j,i
	if(i.lt.j)i=j
          st(1:i-j+1)=st1(j:i)
cd	write(*,*)'3>',st
          return
          end

        function ifnblnk(s)
        character*(*) s
        do 10 i=1,len(s)
           if(s(i:i).ne. ' ')goto 11
 10        continue
        i=0
 11     ifnblnk=i
        return
        end
