cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cc                     Version 1.1                        cc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      program axis
      include '../libsrc/penplot.com'
      real dis,dtic,apos,apos2,xa0,xa1,ya0,ya1,temp
      real labsiz
      character*40 form,labl
      character*10 typ
       integer r1,r2
      real dl,du
            common/axiscom/xa0,ya0,xa1,ya1

      character*40 s
      character*20 names(10),vals(10)
      data names/
     $   'xamin','xamax','ypos','xatype','xasize',
     $   'yamin','yamax','xpos','yatype','yasize'/

      call scale
      call readvara('plot.var',names,vals,10)
c      call tmode
c      write(*,*)xasize,yasize
c      call gmode
      xa0=default(vals(1),x0)
      xa1=default(vals(2),x1)
      apos=default(vals(3),y0)
      typ=vals(4)
      labsiz=default(vals(5),2.0)
      ya0=default(vals(6),y0)
      ya1=default(vals(7),y1)
      apos2=ya1
      r1=0
      r2=180
      call getarg(1,s)
      if (s(1:1).eq.'y') then
        apos=default(vals(8),x0)
        apos2=xa1
	typ=vals(9)
        labsiz=default(vals(10),2.0)
        r1=90
        r2=270
        endif

         if (xa0.gt.xa1) then
            temp=xa0
            xa0=xa1
            xa1=temp
         endif
         if (ya0.gt.ya1) then
            temp=ya0
            ya0=ya1
            ya1=temp
         endif
         call getarg(2,s)
         if(s.gt.' ') then
            read(s,*)dtic
         else
            if(r1.eq.0)then
               dtic=(xa1-xa0)/10.0
            else
               dtic=(ya1-ya0)/10.0
            endif
         endif
         call getarg(3,labl)
         if(labl.eq.'_')labl=' '
         call getarg(4,s)
         if(s.gt.' ') then
c	write(*,*)s
            read(s,*)dis
         else
            if(r1.eq.0)then
               dis=(xa1-xa0)/5.0
            else
               dis=(ya1-ya0)/5.0
            endif
         endif
         if (iargc().gt.4) then
            call getarg(5,form)
         else
            form='xx.xx'
         endif

c         call tmode
c         write(*,*)apos,dtic,dis,labl,typ,labsiz
c         call gmode
         du=0
         dl=0
         if (index(typ,'rt').eq.0) then
            call axtic(apos,dtic,r1,dl)
            if (index(typ,'d').gt.0) call axtic(apos2,dtic,r2,du)
         else
            call axtic(apos,dtic,r2,du)
            if (index(typ,'d').gt.0) then 
               call axtic(apos2,dtic,r1,du)
               du=0
            endif
         endif

         if (dis.gt.0) then
            if (index(typ,'rn').eq.0) then
               call axnum(apos,dis,r1,form,dl,labsiz)
            else
               if (index(typ,'d').gt.0) then 
                  call axnum(apos2,dis,r2,form,du,labsiz)
               else 
                  call axnum(apos,dis,r2,form,du,labsiz)
               endif
            endif
         endif

         if (labl.gt.' ') then
            if (index(typ,'rl').eq.0) then
               call axtag(apos,r1,labl,dl,labsiz)
            else
               if (index(typ,'d').gt.0) then 
                  call axtag(apos2,r2,labl,du,labsiz)
               else
                  call axtag(apos,r2,labl,du,labsiz)
               endif
            endif
         endif

            call endplt
            end

c            character*40 function default(t)
c            character*40 t
cvar
cit:integer
cbegin
c  it=pos('&',t)
c  if t='&' then default=''
c  else if it=0 then default=t
c  else if it=1 then
c    default=copy(t,2,length(t)-1)
c  else
c    default=copy(t,1,it-1)
cend

      real function default(t,rdef)
      character*20 t
      do 10 i=1,20
         if(t(i:i).ne.' ')goto 11
 10      continue
         default=rdef
         return
 11   continue
      t=t(i:20)
      if(t.eq. 'default') then
         default=rdef
      else
         read(t,*)default
      endif
      return
      end

      character*40 function conv(y,form)
            character*40 form,temp,temp1
            integer i,j
            i=index(form,'.')
            j=lnblnk(form)
            if (i.gt.0) i=j-i
            write(temp,*)'(F',j+3,'.',i,')'
            write(temp1,temp)y
            if(i.eq.0)then
               j=index(temp1,'.')
               temp1(j:40)=' '
            endif
            do 10 i=1,40
               if(temp1(i:i).ne.' ')goto 20
 10            continue
 20         continue
            conv=temp1(i:40)
            return
            end
            
            subroutine tic(x,y,dx,dy)
            include '../libsrc/penplot.com'
            xn=ax*x+bx
            yn=ay*y+by
            if(xn.ge.xv0-0.001 .and. xn.le.xv1+0.001 .and. 
     $         yn.ge.yv0-0.001 .and. yn.le.yv1+0.001) then
               call plota(xn,yn)
               call plota(xn+dx,yn+dy)
               call penup
            endif
            return 
            end

            subroutine axtic(org,dt,rot,del)
            integer rot
            common/axiscom/xa0,ya0,xa1,ya1
            real xb,yb,xe,ye,tb,te,dx,dy
            if (rot.eq.0 .or. rot.eq.180) then
               tb=xa0
               te=xa1
               xb=xa0
               yb=org
               xe=xa1
               ye=org
               dx=dt
               dy=0
            else
               tb=ya0
               te=ya1
               xb=org
               yb=ya0
               xe=org
               ye=ya1
               dx=0
               dy=dt
            endif
            goto(10,11,12,13)rot/90+1
 10         del=-2
            goto 14
 11         del=-1.5
            goto 14
 12         del=2
            goto 14
 13         del=1.5
 14         continue

            call penup
            call plot(xb,yb)
            call plot(xe,ye)
            call penup

      if(dt.le.0.0)return

 100  continue
      goto (20,21,22,23),rot/90+1
 20   call tic(xb,yb,0.0,-2.0)
      goto 24
 21   call tic(xb,yb,-1.5,0.0)
      goto 24
 22   call tic(xb,yb,0.0,2.0)
      goto 24
 23   call tic(xb,yb,1.5,0.0)
 24   continue

      tb=tb+dt
      xb=xb+dx
      yb=yb+dy
      if(tb .lt.(te+dt/2))goto 100
      return
      end

      subroutine axnum(org,dt,rotv,form,del,labsiz)
            common/axiscom/xa0,ya0,xa1,ya1
      real org,dt,del,labsiz
      integer rotv
      character*40 form,conv
      real xb,yb,tb,te,dx,dy
      real idx,idy
      call textsize(form,0,labsiz,chrdelx,chrdely,0)
      goto (10,11,12,13),rotv/90+1
 10   continue
      xb=xa0
      yb=org
      tb=xa0
      te=xa1
      dx=dt
      dy=0.0
      idx=0
      del=-3.0+del-chrdely
      idy=del+chrdely/2
      goto 14
 11   continue
      xb=org
      yb=ya0
      tb=ya0
      te=ya1
      dx=0.0
      dy=dt
      del=-2.0+del-chrdelx
      idx=del+chrdelx/2
      idy=0
      goto 14
 12   continue
      xb=xa0
      yb=org
      tb=xa0
      te=xa1
      dx=dt
      dy=0.0
      idx=0
      idy=3.0+del+chrdely/2
      del=3.0+del+chrdely
      goto 14
 13   continue
      xb=org
      yb=ya0
      tb=ya0
      te=ya1
      dx=0.0
      dy=dt
      idx=2.0+del+chrdelx/2
      del=del+2.0+chrdelx
      idy=0
 14   continue

 100  continue
      call text(conv(tb,form),xb,yb,idx,idy,0,labsiz,1)
      xb=xb+dx
      yb=yb+dy
      tb=tb+dt
      if(tb.lt. te+dt/2) goto 100
      
      return
      end

      subroutine axtag(org,rotv,axlabl,del,labsiz)
            common/axiscom/xa0,ya0,xa1,ya1
      real org,del,labsiz
      integer rotv
      character*(*)axlabl
      if (axlabl.gt.' ') then
         call textsize(axlabl,rotv,labsiz,chrdelx,chrdely,0)
         goto (10,11,12,13),rotv/90+1
 10      call text(axlabl,(xa0+xa1)/2,org,
     $     0,del-3.0-chrdely/2,0,labsiz,1)
         goto 14
 11      call text(axlabl,org,(ya0+ya1)/2,
     $     del-chrdelx/2-1.0,0,90,labsiz,1)
         goto 14
 12      call text(axlabl,(xa0+xa1)/2,org,
     $      0,del+3.0+chrdely/2,0,labsiz,1)
         goto 14
 13      call text(axlabl,org,(ya0+ya1)/2,
     $      del+chrdelx/2+1.0,0,90,labsiz,1)
 14      continue
         endif
         return
         end

