ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                    tv80_wrappers
c                  =================
c S.ETHIER  03/03/2000
c
c This file contains replacement routines for the tv80 library calls.
c We now use only NCAR Graphics and GKS calls (NCAR uses level 0A of
c the standard GKS library for its lowest level calls).
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine ncarcgm (iwk,connam)
        implicit none
        integer iwk,iopstate
        character*(*) connam

        character*80 filnam,cdum

c Open gks if it was not done already

        call gqops (iopstate)
        if (iopstate .eq. 0) call gopks (6,0)

c Open the workstation.  The second parameter is the connection identifier.
c In NCAR GKS, this is actually the number that will be used as the unit
c number for the output file when the OPEN statement is performed.  Use
c the same number for the connection identifier as for the workstation
c identifier.  Note that on many systems, unit 5 and 6 are reserved for
c output and input.

cccc        filnam = 'NCARG_GKS_OUTPUT=' // connam
cccc        call putenv (filnam)
        filnam = connam
        call gesc(-1391,1,filnam,1,1,cdum)

        call gopwk (iwk,iwk,1)
        call gacwk (iwk)

        return
        end
ccccccccccccccccccccccccccccccccccccccccccc
        subroutine frame2

c  Executes an update on each opened workstation followed by a
c  clear workstation.

        CALL NGPICT (1, 1)
        CALL NGPICT (2, 1)

        return
        end
        
ccccccccccccccccccccccccccccccccccccccccccc
c*************************************************************************
c
c  plote  -  end plotting
c
c  synopsis     call plote
c
c  description  Flush the line buffer, deactivate all workstations that
c               are currently active, close all that are open and then
c               close gks.
c
c*************************************************************************

        subroutine plote

c Deactivate the CGM workstation and close gks:
        call gdawk(1)
        call gclwk(1)

        call gclks

        return
        end
ccccccccccccccccccccccccccccccccccccccccccc
c*************************************************************************
c
c  dders  -  Set clipping on or off
c
c  synopsis     call dders (iflag)
c
c               integer iflag                   Clip indicator
c
c  description  If iflag is -1, the clipping to the view port is turned on.
c               If iflag is 0 (default), the clipping is turned off.  The
c               original version of tv80lib had +1 which indicated no
c               clipping at all.
c
c*************************************************************************

        subroutine dders (iflag)
        implicit none

        integer iflag,iclip

c Flush the polyline buffer with call to plotif
        call plotif (0., 0., 2)

c If -1 or 0 then turn clipping on, if 1 then turn clipping off.

        if (iflag .eq. -1 .or. iflag .eq. 0) then
          iclip = 1
          call gsclip (iclip)
        else if (iflag .eq. 1) then
          iclip = 0
          call gsclip (iclip)
        else
          write(*,*) 'INVALID INPUT VALUE IN DDERS!'
          write(*,*) '--- TURNING OFF CLIPPING ---'
          iclip = 0
          call gsclip (iclip)
        endif

        return
        end
ccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c
c  "map" is a wrapper routine to replace tv80 plotting routine
c  MAP by NCAR Graphics Autograph calls.
c  "map" is used to define the viewport and set the user coordinates
c  with linear scaling.
c
c**************************************************************
      subroutine map(xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax)
      implicit none
      real*8  xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax
      real    vleft,vright,vbot,vtop
      real    x(2),y(2)
      integer ipolarc
      common /polcoord/ ipolarc

c -- We work in cartesian coordinates so set ipolarc = 0
      ipolarc = 0

      x(1) = real(xmin)
      x(2) = real(xmax)
      y(1) = real(ymin)
      y(2) = real(ymax)

      vleft = real(vxmin)
      vright = real(vxmax)
      vbot = real(vymin)
      vtop = real(vymax)

      if (vleft .lt. 0.) vleft = 0.
      if (vright .lt. 0.) vright = 1.0
      if (vbot .lt. 0.) vbot = 0.
      if (vtop .lt. 0.) vtop = 1.0

c Set viewport and user coordinates with linear scaling...
      call set(vleft,vright,vbot,vtop,x(1),x(2),y(1),y(2),1)

      return
      end
ccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c
c  "maps" is a wrapper routine to replace tv80 plotting routine
c  MAPS by NCAR Graphics Autograph calls.
c  "maps" is used to define the viewport, set the user coordinates
c  and draw axes with tick marks and numbers.
c  (The MAPG routine does the same thing but does not draw the
c  tick marks on the axes.)
c
c**************************************************************
      subroutine maps(xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax)
      implicit none
      real*8  xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax
      real    vleft,vright,vbot,vtop,charsize
      real    x(2),y(2)
      integer ipolarc
      common /polcoord/ ipolarc

c -- We work in cartesian coordinates so set ipolarc = 0
      ipolarc = 0

      x(1) = real(xmin)
      x(2) = real(xmax)
      y(1) = real(ymin)
      y(2) = real(ymax)

      vleft = real(vxmin)
      vright = real(vxmax)
      vbot = real(vymin)
      vtop = real(vymax)

      if (vleft .lt. 0.) then
         vleft = 0.10
         charsize = 0.02
      else if ((vright-vleft) .gt. 0.6) then
         charsize = 0.02
      else
         charsize = 0.03
      endif
      if (vright .lt. 0.) vright = 0.99
      if (vbot .lt. 0.) vbot = 0.10
      if (vtop .lt. 0.) vtop = 0.99

c Set viewport...
      call agsetf('GRID/LEFT.',vleft)
      call agsetf('GRID/RIGHT.',vright)
      call agsetf('GRID/BOTTOM.',vbot)
      call agsetf('GRID/TOP.',vtop)

c Set minima and maxima for axes...
      call agsetf('X/MINIMUM.',x(1))
      call agsetf('X/MAXIMUM.',x(2))
      call agsetf('Y/MINIMUM.',y(1))
      call agsetf('Y/MAXIMUM.',y(2))

c Set the background style to "perimeter"...
      call agsetf('BACKGROUND.',1.)

c Set scaling of x and Y to linear...
      call agsetf('X/LOGARITHMIC.',0.)
      call agsetf('Y/LOGARITHMIC.',0.)

c Make sure that the grid box is bounded by xmin,xmax,ymin,ymax.
      call agsetf('X/NICE.',0.)
      call agsetf('Y/NICE.',0.)

c Set the character size of the axes labels
      CALL AGSETF('AXIS/BOTTOM/CONTROL.',1.)
      CALL AGSETF('AXIS/BOTTOM/NUMERIC/WIDTH/MAN.',charsize)
      CALL AGSETF('AXIS/LEFT/CONTROL.',1.)
      CALL AGSETF('AXIS/LEFT/NUMERIC/WIDTH/MAN.',charsize)

c Suppress the drawing of label on the X and Y axes
      call agsetc('LABEL/NAME.','B') !Bottom Label
      call agsetf('LABEL/SUPPRESSION.',1.)
      call agsetc('LABEL/NAME.','L') !Left Label
      call agsetf('LABEL/SUPPRESSION.',1.)

c Suppress the drawing of the curve. We want only the axes with tick marks
c and numbers
      x(2) = x(1)
      y(2) = y(1)

c Specify NO frame advance after drawing the axes...
      call agseti('FRAME.',2)

c Draw the axes with autograph routine ezxy...
      call ezxy(x,y,2,'$')
      return
      end

ccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c
c  "mapg" is a wrapper routine to replace tv80 plotting routine
c  MAPG by NCAR Graphics Autograph calls.
c  "mapg" is used to define the viewport, set the user coordinates
c  and draw a gridded background at the major tick marks.
c
c**************************************************************
      subroutine mapg(xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax)
      implicit none
      real*8  xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax
      real    vleft,vright,vbot,vtop,charsize
      real    x(2),y(2)
      integer ipolarc
      common /polcoord/ ipolarc

c -- We work in cartesian coordinates so set ipolarc = 0
      ipolarc = 0

      x(1) = real(xmin)
      x(2) = real(xmax)
      y(1) = real(ymin)
      y(2) = real(ymax)

      vleft = real(vxmin)
      vright = real(vxmax)
      vbot = real(vymin)
      vtop = real(vymax)

      if (vleft .lt. 0.) then
         vleft = 0.10
         charsize = 0.02
      else if ((vright-vleft) .gt. 0.6) then
         charsize = 0.04
      else
         charsize = 0.04
      endif
      if (vright .lt. 0.) vright = 0.99
      if (vbot .lt. 0.) vbot = 0.10
      if (vtop .lt. 0.) vtop = 0.99

c Set viewport...
      call agsetf('GRID/LEFT.',vleft)
      call agsetf('GRID/RIGHT.',vright)
      call agsetf('GRID/BOTTOM.',vbot)
      call agsetf('GRID/TOP.',vtop)

c Set minima and maxima for axes...
      call agsetf('X/MINIMUM.',x(1))
      call agsetf('X/MAXIMUM.',x(2))
      call agsetf('Y/MINIMUM.',y(1))
      call agsetf('Y/MAXIMUM.',y(2))

c Set scaling of x and Y to linear...
      call agsetf('X/LOGARITHMIC.',0.)
      call agsetf('Y/LOGARITHMIC.',0.)

c Make a grid at the major tick marks...
      CALL AGSETF('AXIS/LEFT/TICKS/MAJOR/LENGTH/INWARD.',1.)
      CALL AGSETF('AXIS/BOTTOM/TICKS/MAJOR/LENGTH/INWARD.',1.)

c Make sure that the grid box is bounded by xmin,xmax,ymin,ymax.
      call agsetf('X/NICE.',0.)
      call agsetf('Y/NICE.',0.)

c Set the character size of the axes labels
      CALL AGSETF('AXIS/BOTTOM/CONTROL.',1.)
      CALL AGSETF('AXIS/BOTTOM/NUMERIC/WIDTH/MAN.',charsize)
      CALL AGSETF('AXIS/LEFT/CONTROL.',1.)
      CALL AGSETF('AXIS/LEFT/NUMERIC/WIDTH/MAN.',charsize)

c Suppress the drawing of label on the X and Y axes
      call agsetc('LABEL/NAME.','B') !Bottom Label
      call agsetf('LABEL/SUPPRESSION.',1.)
      call agsetc('LABEL/NAME.','L') !Left Label
      call agsetf('LABEL/SUPPRESSION.',1.)

c Suppress the drawing of the curve. We want only the axes with tick marks
c and numbers
      x(2) = x(1)
      y(2) = y(1)

c Specify NO frame advance after drawing the axes...
      call agseti('FRAME.',2)

c Draw the axes with autograph routine ezxy...
      call ezxy(x,y,2,'$')
      return
      end

ccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c
c  "mapgsl" is a wrapper routine to replace tv80 plotting routine
c  MAPGSL by NCAR Graphics Autograph calls.
c  "mapgsl" is used to define the viewport, set the user coordinates
c  and draw a gridded background at the major tick marks.
c  This routine sets the mapping to linear in X and logorithmic in Y.
c
c**************************************************************
      subroutine mapgsl(xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax)
      implicit none
      real*8  xmin,xmax,ymin,ymax,vxmin,vxmax,vymin,vymax
      real    vleft,vright,vbot,vtop,charsize
      real    x(2),y(2)
      integer ipolarc
      common /polcoord/ ipolarc

c -- We work in cartesian coordinates so set ipolarc = 0
      ipolarc = 0

      x(1) = real(xmin)
      x(2) = real(xmax)
      y(1) = real(ymin)
      y(2) = real(ymax)

      vleft = real(vxmin)
      vright = real(vxmax)
      vbot = real(vymin)
      vtop = real(vymax)

      if (vleft .lt. 0.) then
         vleft = 0.10
         charsize = 0.02
      else if ((vright-vleft) .gt. 0.6) then
         charsize = 0.04
      else
         charsize = 0.04
      endif
      if (vright .lt. 0.) vright = 0.99
      if (vbot .lt. 0.) vbot = 0.10
      if (vtop .lt. 0.) vtop = 0.99

c Set viewport...
      call agsetf('GRID/LEFT.',vleft)
      call agsetf('GRID/RIGHT.',vright)
      call agsetf('GRID/BOTTOM.',vbot)
      call agsetf('GRID/TOP.',vtop)

c Set minima and maxima for axes...
      call agsetf('X/MINIMUM.',x(1))
      call agsetf('X/MAXIMUM.',x(2))
      call agsetf('Y/MINIMUM.',y(1))
      call agsetf('Y/MAXIMUM.',y(2))

c Set the mapping to linear in X and logorithmic in Y...
      call agsetf('X/LOGARITHMIC.',0.)
      call agsetf('Y/LOGARITHMIC.',1.)

c Make a grid at the major tick marks...
      CALL AGSETF('AXIS/LEFT/TICKS/MAJOR/LENGTH/INWARD.',1.)
      CALL AGSETF('AXIS/BOTTOM/TICKS/MAJOR/LENGTH/INWARD.',1.)

c Make sure that the grid box is bounded by xmin,xmax,ymin,ymax.
      call agsetf('X/NICE.',0.)
      call agsetf('Y/NICE.',0.)

c Set the character size of the axes labels
      CALL AGSETF('AXIS/BOTTOM/CONTROL.',1.)
      CALL AGSETF('AXIS/BOTTOM/NUMERIC/WIDTH/MAN.',charsize)
      CALL AGSETF('AXIS/LEFT/CONTROL.',1.)
      CALL AGSETF('AXIS/LEFT/NUMERIC/WIDTH/MAN.',charsize)

c Suppress the drawing of label on the X and Y axes
      call agsetc('LABEL/NAME.','B') !Bottom Label
      call agsetf('LABEL/SUPPRESSION.',1.)
      call agsetc('LABEL/NAME.','L') !Left Label
      call agsetf('LABEL/SUPPRESSION.',1.)

c Suppress the drawing of the curve. We want only the axes with tick marks
c and numbers
      x(2) = x(1)
      y(2) = y(1)

c Specify NO frame advance after drawing the axes...
      call agseti('FRAME.',2)

c Draw the axes with autograph routine ezxy...
      call ezxy(x,y,2,'$')
      return
      end

Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c
c  "mapp" is a wrapper routine to replace tv80 plotting routine
c  MAPP by NCAR Graphics Autograph calls.
c  "mapp" is used to define the viewport, set the user coordinates
c  and draw axes with tick marks and numbers. The original tv80
c  MAPP routine defines polar coordinates.
c
c**************************************************************
      subroutine mapp(rmax,dum1,dum2,dum3)
      implicit none
      real*8  rmax,dum1,dum2,dum3
      real    vleft,vright,vbot,vtop,charsize
      real    x(2),y(2)
      integer ipolarc
      common /polcoord/ ipolarc

c -- We work in polar coordinates so set ipolarc = 1
      ipolarc = 1

      x(1) = -rmax
      x(2) = rmax
      y(1) = -rmax
      y(2) = rmax

      vleft = 0.05
      vright = 0.95
      vbot = 0.05
      vtop = 0.95
      charsize = 0.01

c Set viewport...
      call agsetf('GRID/LEFT.',vleft)
      call agsetf('GRID/RIGHT.',vright)
      call agsetf('GRID/BOTTOM.',vbot)
      call agsetf('GRID/TOP.',vtop)

c Set minima and maxima for axes...
      call agsetf('X/MINIMUM.',x(1))
      call agsetf('X/MAXIMUM.',x(2))
      call agsetf('Y/MINIMUM.',y(1))
      call agsetf('Y/MAXIMUM.',y(2))

c Set the background style to "perimeter"...
      call agsetf('BACKGROUND.',1.)

c Set scaling of x and Y to linear...
      call agsetf('X/LOGARITHMIC.',0.)
      call agsetf('Y/LOGARITHMIC.',0.)

      call agsetf('X/NICE.',0.)
      call agsetf('Y/NICE.',0.)

c Specify NO frame advance after drawing the axes...
      call agseti('FRAME.',2)

c Suppress the drawing of label on the X and Y axes
      call agsetc('LABEL/NAME.','B') !Bottom Label
      call agsetf('LABEL/SUPPRESSION.',1.)
      call agsetc('LABEL/NAME.','L') !Left Label
      call agsetf('LABEL/SUPPRESSION.',1.)

c Set the character size of the axes labels
      CALL AGSETF('AXIS/BOTTOM/CONTROL.',1.)
      CALL AGSETF('AXIS/BOTTOM/NUMERIC/WIDTH/MAN.',charsize)
      CALL AGSETF('AXIS/LEFT/CONTROL.',1.)
      CALL AGSETF('AXIS/LEFT/NUMERIC/WIDTH/MAN.',charsize)

c Specify the intersection of the axes in user coordinates (0.,0.)
      call agsetf('AXIS/RIGHT/INTERSECTION/USER.',0.)
      call agsetf('AXIS/TOP/INTERSECTION/USER.',0.)
      call agsetf('AXIS/LEFT/INTERSECTION/USER.',0.)
      call agsetf('AXIS/BOTTOM/INTERSECTION/USER.',0.)

c Suppress the drawing of the curve. We want only the axes with tick marks
c and numbers
      x(1) = 0.
      y(1) = 0.
      x(2) = 0.
      y(2) = 0.

c Draw the axes with autograph routine ezxy...
      call ezxy(x,y,2,'$')
      return
      end

Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c S.ETHIER 99/09/16
c  "lpoints" is a wrapper routine to replace the tv80 plotting routine
c  POINTS by a NCAR Graphics equivalent call in the case. I changed
c  the name to LPOINTS since NCAR has a routine called POINTS already.
c  This is what is actually used in the cartesian coordinates case.
c  In the case of polar coordinates, we call the NCAR function NGDOTS
c  which permits us to change the size of the dots.
c  Cartesian coordinates are chosen by a call to MAPS which sets the
c  viewport and sets ipolarc=0. Polar coordinates are chosen by calling
c  the function MAPP which sets ipolarc=1.
c
c  In the original tv80 library, a call to MAPP would define a viewport
c  in polar coordinates so that a subsequent call to POINTS would assume
c  that the X and Y vectors are actually the R and THETA vectors,
c  where THETA is in radians. In our version, we do an explicit coordinate
c  transformation before passing X and Y to the routine POINTS.
c
c**************************************************************
      subroutine lpoints(xx1,y1,nn,dum1,dum2,dum3,dum4)
      IMPLICIT NONE
      INTEGER  nn,i,ipolarc
      common /polcoord/ ipolarc
      REAL   dotsize
      REAL*8   xx1,y1,dum1,dum2,dum3,dum4
      REAL, ALLOCATABLE :: x(:), y(:)
      dimension xx1(*), y1(*)

      if (.not.ALLOCATED(x)) ALLOCATE (x(nn))
      if (.not.ALLOCATED(y)) ALLOCATE (y(nn))

      if (ipolarc .eq. 1) then
         dotsize = 1.5   !dot diameter in world coordinate Y-axis units
         do i = 1, nn
            x(i) = xx1(i)*cos(y1(i))
            y(i) = xx1(i)*sin(y1(i))
         end do
      else
         dotsize = 0.5   !dot diameter in world coordinate Y-axis units
         do i = 1, nn
            x(i) = xx1(i)
            y(i) = y1(i)
         end do
      endif

c Draw a point at each coordinate x(i),y(i)
cccc      call ngdots(x,y,nn,dotsize,1)
      call points(x,y,nn,0,0)

ccc Update the workstations without clearing the display and
ccc flush the buffers
      CALL NGPICT (1, 0)
      CALL NGPICT (2, 0)

      DEALLOCATE (x, y)
      return
      end
Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c S.ETHIER 99/09/16
c  "trace" is a wrapper routine to replace tv80 plotting routine
c  TRACE by NCAR Graphics Autograph calls.
c  "trace" is used to draw a curve between a set of points.
c
c**************************************************************
      subroutine trace ( xx1,y1,jd,idum1,idum2,dum1,dum2 )
      IMPLICIT NONE
C============
      INTEGER jd,j,idum1,idum2
C============
      REAL*8 xx1,y1,dum1,dum2
      REAL, ALLOCATABLE :: y(:), x(:)
C============
      dimension xx1(*), y1(*)
      if (.not.ALLOCATED(x)) ALLOCATE (x(jd))
      if (.not.ALLOCATED(y)) ALLOCATE (y(jd))
      do j = 1, jd
         x(j) = xx1(j)
         y(j) = y1(j)
      end do

c Draw the curve on grid produced by previous call to ezxy
      call agcurv(x,1,y,1,jd,0)

ccc Update the workstations without clearing the display and
ccc flush the buffers
      CALL NGPICT (1, 0)
      CALL NGPICT (2, 0)

      DEALLOCATE (x, y)
      return
      end
Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c S.ETHIER 03/03/2000
c
c  "setcrt" is a wrapper routine to replace tv80 library routine
c  SETCRT by NCAR Graphics calls.
c  "setch" is used to set the current plotter pen position when
c  given user coordinates
c
c**************************************************************
      subroutine setcrt(x1,y1)
      implicit none
      real*8           x1,y1
      integer          icase,isize,iorient,ifont
      real             xxpos,yypos

      xxpos = real(x1)
      yypos = real(y1)

c Flush the polyline buffer...
      call plotif(0., 0., 2)

c Move the pen to new position by using SPSS function FRSTPT
      call FRSTPT (xxpos, yypos)

      return
      end

Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c S.ETHIER 03/03/2000
c
c  "vector8" is a wrapper routine to replace tv80 library routine
c  VECTOR by NCAR Graphics calls.
c  "vector8" draws a line segment from the current plotter pen
c  position to the given X and Y user coordinates.
c  Works in conjunction with the SETCRT (FRSTPT) routine.
c
c**************************************************************
      subroutine vector8(x1,y1)
      implicit none
      real*8           x1,y1
      real             xxpos,yypos

      xxpos = real(x1)
      yypos = real(y1)

c Draw line segment...
      call VECTOR (xxpos, yypos)

      return
      end

Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c S.ETHIER 02/15/2000
c
c  "setch" is a wrapper routine to replace tv80 library routine
c  SETCH by NCAR Graphics calls.
c  "setch" is used to set character attributes for absolute grid
c
c**************************************************************
      subroutine setch(x1,y1,icase,isize,iorient,ifont)
      implicit none
      real*8           x1,y1
      integer          icase,isize,iorient,ifont,iccase
      real             xxpos,yypos,sizechar,txangle
      common /set_com/ xxpos,yypos,sizechar,txangle,iccase

      iccase = icase

      xxpos = real(x1)
      yypos = real(y1)

ccc      if (yypos .gt. 34.) yypos=34.

C -- Set the viewport
      call set(0.,1.,0.,1.,0.,100.,0.,45.,1)
ccc      call set(0.,1.,0.,1.,0.,100.,0.,35.,1)

      sizechar = 0.012
ccc      if (isize .eq. 2) then
ccc         sizechar = 0.015
ccc      else
ccc         sizechar = 0.016
ccc      endif

      if (iorient .eq. 1) then
         txangle = 90.
      else
         txangle = 0.
      endif

C -- Turn off clipping to display text outside the viewport
      CALL GSCLIP(0)

      return
      end
Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c S.ETHIER 02/15/2000
c
c  "setlch" is a wrapper routine to replace tv80 library routine
c  SETLCH by NCAR Graphics calls.
c  "setlch" is used to set character attributes in the user's
c  coordinate space (same as setch but we don't set the viewport).
c
c**************************************************************
      subroutine setlch(x1,y1,icase,isize,iorient,ifont)
      implicit none
      real*8           x1,y1
      integer          icase,isize,iorient,ifont,iccase
      real             xxpos,yypos,sizechar,txangle
      common /set_com/ xxpos,yypos,sizechar,txangle,iccase

      xxpos = real(x1)
      yypos = real(y1)

      sizechar = 0.012
ccc      if (isize .eq. 2) then
ccc         sizechar = 0.015
ccc      else
ccc         sizechar = 0.016
ccc      endif

      if (iorient .eq. 1) then
         txangle = 90.
      else
         txangle = 0.
      endif

C -- Turn off clipping to display text outside the viewport
      CALL GSCLIP(0)

      return
      end
Cccccccccccccccccccccccccccccccccccccccccccccccccc
c**************************************************************
c
c  "gtext" is a wrapper routine to replace tv80 library routine
c  GTEXT by NCAR Graphics calls.
c  "gtext" is used to write a string at a chosen position in the
c  viewport. We use the NCAR PLOTCHAR package routine "plchlq" to
c  replace "gtext".
c
c**************************************************************
      subroutine gtext(string,nc,ioffset)
      implicit none
      integer          nc,ioffset,ioff,iccase,i,icar,nn
      character*(*)    string
      character*80     texte
      real             xxpos,yypos,sizechar,txangle
      common /set_com/ xxpos,yypos,sizechar,txangle,iccase

      nn=nc
      if (nn .lt. 1) nn=LEN_TRIM(string)
      if (nn .gt. 80) nn=80

      texte(1:nn)=string(1:nn)

      if (ioffset .eq. -1) then
        ioff = 1
      else
        ioff = ioffset + 1
      endif

c If iccase <= 0, change all lowercase character to uppercase
      if (iccase .le. 0) then
         do i=1,nn
c --------- Find position of character in the ASCII table
            icar = IACHAR(texte(i:i))
            if (icar.ge.97 .and. icar.le.122) then
c ------------ Character is lowercase so change it to uppercase
               icar = icar - 32
               texte(i:i) = ACHAR(icar)
            endif
         enddo
      endif

      call plchmq(xxpos,yypos,texte(ioff:nn),sizechar,txangle,-1.)

      yypos = yypos - 1.10  !Set Y position to next "line"

      return
      end
Cccccccccccccccccccccccccccccccccccccccccccccccccc
c*********************************************************************
c
c  wrtstr  -  write an array of strings
c
c  synopsis     call wrtstr (string,num)
c               integer num                      Number of strings
c               character*(*) string(num)        Array of strings
c
c*********************************************************************

        subroutine wrtstr (string,num)
        implicit none
        character*(*) string(*)
        integer num,i
        integer length

        length = len(string(1))

        do i = 1,num
          call gtext (string(i),length,0)
        enddo

        return
        end

Cccccccccccccccccccccccccccccccccccccccccccccccccc