module graphics
!
!     (c) Copyright 1991 to 1998 by Michael A. Beer, William D. Dorland, 
!     P. B. Snyder, Q. P. Liu, and Gregory W. Hammett. ALL RIGHTS RESERVED.
!     

! front ends for NCAR calls.

use ncar_mod, plchlq => plchlq8, curved => curved8, curve => curve8, &
             set => set8, line => line8, lined => lined8, &
             cpsetr => cpsetr8, cprect => cprect8, cpcldr => cpcldr8, &
             gridal => gridal8

contains
  subroutine maps(xmin, xmax, ymin, ymax)
!
!       set x y limits  
!
    integer nx,ny,nxdiv,nydiv,nox,noxm,noy,noym
    character*10  fx,fy
    real  xxmin,xxmax,yymin,yymax
    real, intent(in) ::  xmin,xmax,ymin,ymax
    xxmin=xmin
    xxmax=xmax
    yymin=ymin
    yymax=ymax

    if (yymin.eq.yymax) yymax=yymax+1.0
    nxdiv=2
    nydiv=2
    call nicer(xxmin,xxmax,nox,noxm,fx,nx)
    call nicer(yymin,yymax,noy,noym,fy,ny)
    call set(0.1,0.9,0.15,0.9,xxmin,xxmax,yymin,yymax,1)
    call labmod(fx,fy,nx,ny,12,12,0,0,0)
    call gridal(nox,noxm,noy,noym,1,1,5,xxmin,yymin)

  end subroutine maps

  subroutine mapsm(xmin, xmax, ymin, ymax)
!
!       set x y limits  
!
    integer nx,ny,nxdiv,nydiv,nox,noxm,noy,noym
    character*10  fx,fy
    real  xxmin,xxmax,yymin,yymax
    real, intent(in) ::  xmin,xmax,ymin,ymax

    xxmin=xmin
    xxmax=xmax
    yymin=ymin
    yymax=ymax

    if (yymin.eq.yymax) yymax=yymax+1.0
    nxdiv=2
    nydiv=2
    call nicer(xxmin,xxmax,nox,noxm,fx,nx)
    call nicer(yymin,yymax,noy,noym,fy,ny)
    call set(0.2,0.9,0.15,0.9,xxmin,xxmax,yymin,yymax,1)
    call labmod(fx,fy,nx,ny,12,12,0,0,0)
    call gridal(nox,noxm,noy,noym,1,1,5,xxmin,yymin)

  end subroutine mapsm

  subroutine nicer(xmin,xmax,nomaj,nomin,fmt,nfmt)
    character*10 fmt
    real xmin,xmax,dx,scale,floor
    integer iscale,nomin,nomaj,nfmt,il,ir
    
    if(xmax.eq.xmin)xmax=xmin+1.0e-8
    dx=(xmax-xmin)/10
    iscale=-floor(alog10(dx))
    scale=10.0**(iscale)
    dx=ceil(dx*scale)
    if(dx >= 3.and.dx <= 5) dx=5
    if(dx >= 6.and.dx <= 9) dx=10
    nomin=dx
    if(nomin.gt.5) nomin=1
    dx=dx/scale
    xmin=floor(xmin/dx)*dx
    xmax=ceil(xmax/dx)*dx
    nomaj=nint((xmax-xmin)/dx)
    il=ceil(alog10(max(abs(xmin),abs(xmax))))
    ir=iscale
    if(abs(il) <= 3) then
!	nfmt=max(1,il)+2+max(0,ir)
       nfmt=max(1,il)+3+max(0,ir)
       write(fmt,'(a,i2,a,i2,a)')'(f',nfmt,'.',max(0,ir),')'
    else
       nfmt=il+8+ir
       write(fmt,'(a,i2,a,i2,a)')'(1pe',nfmt,'.',il+ir,')'
    endif

  end subroutine nicer

  subroutine setzer
    
!    write(*,*) 'ok in graphics'
    call set(0.0,1.0,0.0,1.0,0.0,1.0,0.0,1.0,1)
    
  end subroutine setzer

  real function ceil(x)
    
    real onemeps,x
    parameter (onemeps=1-1e-5)
    if(x >= 0) then
       ceil=int(x+onemeps)
    else
       ceil=int(x)
    endif

  end function ceil

  real function floor(x)
    
    parameter (onemeps=1-1e-5)
       
    if(x >= 0) then
       floor=int(x)
    else
       floor=int(x-onemeps)
    endif

  end function floor
  
  subroutine finish(ipage, date)
!
! Routine to draw the plotter-frame edge, add time and date,
! and call frame.
!
    implicit none 
    character(*) :: date
    
    character*39 str
    integer ipage
    
    call setzer
    call plotit (    0,    0,0)
    call plotit (32767,    0,1)
    call plotit (32767,32767,1)
    call plotit (    0,32767,1)
    call plotit (    0,    0,1)
    
    write(str,102) date,ipage
102 format(a30,'     ',i2)
    call plchlq(.99,.02,str,10.,0.,1.)
    
    call frame
    ipage=ipage+1
    
  end subroutine finish

end module graphics