C   PLOT89
C   AUTHOR: RODGER STADEN
C
C   13-8-92 new organisation: let pl4010 do device scaling and hardwire
C           it for 1023x768
C
C
C   25-1-90  XHAIRN changed order of arguments to diabox and fmt4ln
C            so that horizontal and vertical sequences were consistent
C            with rest of sip
C    5-4-90  Removed ndc and put it in pl4010. added redir
C    4-5-90  Added the new routines for sap
C    14-11-90 Replaced radio by radion
C    2-3-92 set filnam = ' ' for calls to openf1
C   ROUTINES IN THIS LIBRARY
C
C   LINE
C   POINT
C   FRAME
C   TEXT
C   RULER
C   SCALES
C   BLIP
C   XHAIRS
C   XHAIRN
C   INQGT
C   REDIR
C    line
      SUBROUTINE LINE(XF,XT,YF,YT,XMAX,XMIN,YMAX,YMIN,
     +IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
C   AUTHOR: RODGER STADEN
C   DRAWS A LINE FROM XF,YF TO XT,YT. COORDINATE SYSTEMS ARE
C   1) WORLD SYSTEM: XMIN TO XMAX, YMIN TO YMAX
C   2) DRAWING BOARD 0 TO ISXMAX, 0 TO ISYMAX
C   3) DEVICE COORDINATES 0 TO MAXDVX, 0 TO MAXDVY
C   THE POSITION OF THE PLOT IS DEFINED IN THE DRAWING BOARD SYSTEM BY A
C   BOX STARTING AT IX0,IY0 WITH SIDES IXLEN, IYLEN (IN DRAWING BOARD UNITS)
C  RANGE IN WORLD COORDS
      RANGWX=XMAX-XMIN
      IF(RANGWX.EQ.0.0)RETURN
      RANGWY=YMAX-YMIN
      IF(RANGWY.EQ.0.0)RETURN
C  CLIP
      CALL CLIP(XF,XMAX,XMIN,YF,YMAX,YMIN,XFF,YFF)
      CALL CLIP(XT,XMAX,XMIN,YT,YMAX,YMIN,XTT,YTT)
C  PROPORTIONAL X POSITIONS
      XWF=(XFF-XMIN)/RANGWX
      XWT=(XTT-XMIN)/RANGWX
C  PROPORTIONAL Y POSITIONS
      YWF=(YFF-YMIN)/RANGWY
      YWT=(YTT-YMIN)/RANGWY
C  POSITIONS IN DRAWING BOARD UNITS
      XDF=IX0+XWF*IXLEN
      XDT=IX0+XWT*IXLEN
      YDF=IY0+YWF*IYLEN
      YDT=IY0+YWT*IYLEN
C  POSITIONS IN DEVICE UNITS
      IXF=NINT(XDF)
      IXT=NINT(XDT)
      IYF=NINT(YDF)
      IYT=NINT(YDT)
C   DRAW IT
      CALL MOVEGR(IXF,IYF)
      CALL DRAWGR(IXT,IYT)
      END
C    POINT
      SUBROUTINE POINT(XF,YF,XMAX,XMIN,YMAX,YMIN,
     +IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
C   AUTHOR: RODGER STADEN
C   DRAWS A POINT AT XF,YF. COORDINATE SYSTEMS ARE
C   1) WORLD SYSTEM: XMIN TO XMAX, YMIN TO YMAX
C   2) DRAWING BOARD 0 TO ISXMAX, 0 TO ISYMAX
C   3) DEVICE COORDINATES 0 TO MAXDVX, 0 TO MAXDVY
C   THE POSITION OF THE PLOT IS DEFINED IN THE DRAWING BOARD SYSTEM BY A
C   BOX STARTING AT IX0,IY0 WITH SIDES IXLEN, IYLEN (IN DRAWING BOARD UNITS)
C  RANGE IN WORLD COORDS
      RANGWX=XMAX-XMIN
      IF(RANGWX.EQ.0.0)RETURN
      RANGWY=YMAX-YMIN
      IF(RANGWY.EQ.0.0)RETURN
C  CLIP
      CALL CLIP(XF,XMAX,XMIN,YF,YMAX,YMIN,XFF,YFF)
C  PROPORTIONAL X POSITIONS
      XWF=(XFF-XMIN)/RANGWX
C  PROPORTIONAL Y POSITIONS
      YWF=(YFF-YMIN)/RANGWY
C  POSITIONS IN DRAWING BOARD UNITS
      XDF=IX0+XWF*IXLEN
      YDF=IY0+YWF*IYLEN
      IXF=NINT(XDF)
      IYF=NINT(YDF)
C   PLOT IT
      CALL POINTG(IXF,IYF)
      END
      SUBROUTINE FRAME(IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
C   AUTHOR: RODGER STADEN
C   DRAWS A BOX FROM IX0,IY0 OF SIDES IXLEN,IYLEN COORDINATE SYSTEMS ARE
C   2) DRAWING BOARD 0 TO ISXMAX, 0 TO ISYMAX
C   3) DEVICE COORDINATES 0 TO MAXDVX, 0 TO MAXDVY 
      IXF=IX0
      IXT=IX0+IXLEN
      IYF=IY0
      IYT=IY0+IYLEN
      CALL MOVEGR(IXF,IYF)
      CALL DRAWGR(IXF,IYT)
      CALL DRAWGR(IXT,IYT)
      CALL DRAWGR(IXT,IYF)
      CALL DRAWGR(IXF,IYF)
      END
C    TEXT
      SUBROUTINE TEXT(XF,YF,CHARS,NCHARS,ISIZE,XMAX,XMIN,YMAX,YMIN,
     +IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
C   AUTHOR: RODGER STADEN
C      CHARACTER CHARS(NCHARS)
      CHARACTER CHARS*(*)
C   WRITE TEXT AT XF,YF. COORDINATE SYSTEMS ARE
C   1) WORLD SYSTEM: XMIN TO XMAX, YMIN TO YMAX
C   2) DRAWING BOARD 0 TO ISXMAX, 0 TO ISYMAX
C   3) DEVICE COORDINATES 0 TO MAXDVX, 0 TO MAXDVY
C   THE POSITION OF THE PLOT IS DEFINED IN THE DRAWING BOARD SYSTEM BY A
C   BOX STARTING AT IX0,IY0 WITH SIDES IXLEN, IYLEN (IN DRAWING BOARD UNITS)
C  RANGE IN WORLD COORDS
      RANGWX=XMAX-XMIN
      IF(RANGWX.EQ.0.0)RETURN
      RANGWY=YMAX-YMIN
      IF(RANGWY.EQ.0.0)RETURN
C  CLIP
C   IF OFF SCREEN DONT WRITE
      IF(XF.GT.XMAX)RETURN
      IF(XF.LT.XMIN)RETURN
      IF(YF.GT.YMAX)RETURN
      IF(YF.LT.YMIN)RETURN
C  PROPORTIONAL X POSITIONS
      XWF=(XF-XMIN)/RANGWX
C  PROPORTIONAL Y POSITIONS
      YWF=(YF-YMIN)/RANGWY
C  POSITIONS IN DRAWING BOARD UNITS
      XDF=IX0+XWF*IXLEN
      YDF=IY0+YWF*IYLEN
      IXF=NINT(XDF)
      IYF=NINT(YDF)
C   PLOT IT
      CALL WRITET(IXF,IYF,CHARS,NCHARS)
      END
      SUBROUTINE SCALES(XMAX,XMIN,YMAX,YMIN,
     +IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX,
     +BIT,IBLIPH,FIRST,ISCALE)
C   AUTHOR: RODGER STADEN
C   ROUTINE TO PUT A SCALE ALONG AN AXIS EITHER X OR Y
C   DEPENDING ON ISCALE (1=X,2=Y AXES)
C   BLIPS OF HEIGHT IBLIPH ARE PLACED ALONG THE AXIS EVERY
C   BIT OF LENGTH STARTING FROM FIRST. FIRST CAN BE USED
C   TO MAKE SURE THAT A BLIP OCCURS AT A PARTICULAR POSITION
C   FOR EXAMPLE AT A ZERO POINT, OTHERWISE FIRST IS SET TO
C   XMIN OR YMIN
C   1) WORLD SYSTEM: XMIN TO XMAX, YMIN TO YMAX
C   2) DRAWING BOARD 0 TO ISXMAX, 0 TO ISYMAX
C   3) DEVICE COORDINATES 0 TO MAXDVX, 0 TO MAXDVY
C   THE POSITION OF THE PLOT IS DEFINED IN THE DRAWING BOARD SYSTEM BY A
C   BOX STARTING AT IX0,IY0 WITH SIDES IXLEN, IYLEN (IN DRAWING BOARD UNITS)
      IF(ISCALE.EQ.1)THEN
C  NUMBER OF POINTS
        NP=1+(XMAX-FIRST)/BIT
C  RANGE IN WORLD COORDS
        RANGWX=XMAX-XMIN
        IF(RANGWX.EQ.0.0)RETURN
C  GET END POINTS IN Y
        IYF=IY0
        IYT=IY0+IBLIPH
C  CALC AND PLOT POINTS
        DO 10 I=1,NP
C  PROPORTIONAL X POSITIONS
          XFF=FIRST+(I-1)*BIT
          XWF=(XFF-XMIN)/RANGWX
C  POSITION IN DRAWING BOARD UNITS
          XDF=IX0+XWF*IXLEN
          IXF=NINT(XDF)
          CALL MOVEGR(IXF,IYF)
          CALL DRAWGR(IXF,IYT)
10      CONTINUE
        END IF
      IF(ISCALE.EQ.2)THEN
C  NUMBER OF POINTS
        NP=1+(YMAX-FIRST)/BIT
C  RANGE IN WORLD COORDS
        RANGWY=YMAX-YMIN
        IF(RANGWY.EQ.0.0)RETURN
C  GET END POINTS IN X
        IXF=IX0
        IXT=IX0+IBLIPH
C  CALC AND PLOT POINTS
        DO 20 I=1,NP
C  PROPORTIONAL Y POSITIONS
          YFF=FIRST+(I-1)*BIT
          YWF=(YFF-YMIN)/RANGWY
C  POSITION IN DRAWING BOARD UNITS
          YDF=IY0+YWF*IYLEN
          IYF=NINT(YDF)
          CALL MOVEGR(IXF,IYF)
          CALL DRAWGR(IXT,IYF)
20      CONTINUE
        END IF
      END
      INTEGER FUNCTION IPSEP(XMAX,XMIN,NMAX)
C   FIND SENSIBLE DEFAULT BLIP SEPARATION (SAY NMAX BLIPS PER PLOT)
      D=XMAX-XMIN
      IPSEP=D
      IF(NMAX.LT.1)RETURN
      NSEP=0
1     CONTINUE
      NSEP=NSEP+1
      D=D/NMAX
      IF(D.GT.1.0)GO TO 1
      IPSEP=NMAX**(NSEP-1)
      END
      SUBROUTINE XHAIRS(XMAX,XMIN,YMAX,YMIN,IX0,IXLEN,IY0,
     +IYLEN,ISXMAX,ISYMAX,IHX,IHY,NCHAR,KBOUT)
C   AUTHOR: RODGER STADEN
C      WRITE(KBOUT,*)' CROSS HAIRS'
      CHARACTER TERM,COMMA
      PARAMETER (COMMA=',')
C  RANGE IN WORLD COORDS
      RANGWX=XMAX-XMIN
      IF(RANGWX.EQ.0.0)RETURN
      RANGWY=YMAX-YMIN
      IF(RANGWY.EQ.0.0)RETURN
      XFF=IHX
      YFF=IHY
C  PROPORTIONAL X POSITIONS
      XWF=(XFF-XMIN)/RANGWX
C  PROPORTIONAL Y POSITIONS
      YWF=(YFF-YMIN)/RANGWY
C  POSITIONS IN DRAWING BOARD UNITS
      XDF=IX0+XWF*IXLEN
      YDF=IY0+YWF*IYLEN
      IXF=NINT(XDF)
      IYF=NINT(YDF)
10    CONTINUE
      CALL XHAIR(IXF,IYF,TERM)
C  RETURNS POSITION IN DB UNITS. CONVERT TO DRAWING BOARD UNITS
C  RELATIVE POSITIONS
      XFF=IXF-IX0
      YFF=IYF-IY0
      XFF=XFF/IXLEN
      YFF=YFF/IYLEN
C  CONVERT TO WORLD UNITS
      XFW=XMIN+XFF*RANGWX
      YFW=YMIN+YFF*RANGWY
      IHX=NINT(XFW)
      IHY=NINT(YFW)
C   BACK TO VT100 MODE
      CALL VT100M
      WRITE(KBOUT,1014)IHX,IHY
1014  FORMAT(' Cross hair at',2I7)
      IF(TERM.EQ.COMMA)GO TO 10
      END
      SUBROUTINE LABLER(KBIN,KBOUT,
     +ISXMAX,ISYMAX,
     +IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER LABEL*80,HELPF*(*)
      CHARACTER LEFT,RIGHT,TERM,TUPPER
      INTEGER CSIZE
      EXTERNAL NOTIRL,TUPPER
      PARAMETER (CSIZE=80)
      PARAMETER (LEFT='L',RIGHT='R')
C  FIDDLE TO CHECK ON GOING OFF SCREEN. ASSUME 80 CHARS PER SCREEN WIDTH
C  NEED TO FIND WIDTH OF SCREEN IN DEVICE UNITS
      CSCALE=ISXMAX/CSIZE
      CALL CLEARV
      WRITE(KBOUT,1004)
1004  FORMAT(
     +' Type label then drive cross hair to left or right end',/,
     +' of label position then hit  "L"  to  write label left',/,
     +' justified or  "R"  to  write label right justified or',/,
     +' the space bar to quit')
      CALL BPAUSE(KBIN,KBOUT,IOK)
      IF(IOK.NE.0) RETURN
10    CONTINUE
      CALL VT100M
      CALL CLEARV
      LENGTH = 0
      CALL GTSTR('Label',' ',LABEL,LENGTH,KBOUT,KBIN,INFLAG)
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(INFLAG.EQ.2) RETURN
      IF(LENGTH.EQ.0) RETURN
20    CONTINUE
      CALL XHAIR(IHX,IHY,TERM)
      TERM = TUPPER(TERM)
      IF((TERM.EQ.RIGHT).OR.(TERM.EQ.LEFT))THEN
        IF(TERM.EQ.RIGHT)IHX=NINT(REAL(IHX)-LENGTH*CSCALE)
        IF((IHX.LT.1).OR.((IHX+LENGTH*CSCALE).GT.ISXMAX))GO TO 10
        CALL WRITET(IHX,IHY,LABEL,LENGTH)
        GO TO 20
      END IF
      GO TO 10
      END
      SUBROUTINE CLIP(X1,XMAX,XMIN,Y1,YMAX,YMIN,X2,Y2)
C  AUTHOR RODGER STADEN
C  CLIPS COORDINATES IN USER UNITS
      X2=MAX(X1,XMIN)
      X2=MIN(X2,XMAX)
      Y2=MAX(Y1,YMIN)
      Y2=MIN(Y2,YMAX)
      RETURN
      END
      SUBROUTINE XHAIRN(XMAX,XMIN,YMAX,YMIN,IX0,IXLEN,IY0,
     +IYLEN,ISXMAX,ISYMAX,IHX,IHY,NCHAR,KBOUT,
     +SEQ1,ISTAR1,IDIM1,SEQ2,ISTAR2,IDIM2,NSEQ)
C   AUTHOR: RODGER STADEN
C      WRITE(KBOUT,*)' CROSS HAIRS'
      CHARACTER TERM,COMMA
      PARAMETER (COMMA=',',ISPAN = 19)
      CHARACTER SEQ1(IDIM1),SEQ2(IDIM2),MATCH(ISPAN)
C  RANGE IN WORLD COORDS
      RANGWX=XMAX-XMIN
      IF(RANGWX.EQ.0.0)RETURN
      RANGWY=YMAX-YMIN
      IF(RANGWY.EQ.0.0)RETURN
      XFF=IHX
      YFF=IHY
C  PROPORTIONAL X POSITIONS
      XWF=(XFF-XMIN)/RANGWX
C  PROPORTIONAL Y POSITIONS
      YWF=(YFF-YMIN)/RANGWY
C  POSITIONS IN DRAWING BOARD UNITS
      XDF=IX0+XWF*IXLEN
      YDF=IY0+YWF*IYLEN
      IXF=NINT(XDF)
      IYF=NINT(YDF)
10    CONTINUE
      CALL XHAIR(IXF,IYF,TERM)
C  RETURNS POSITION IN Db UNITS. CONVERT TO DRAWING BOARD UNITS
C  RELATIVE POSITIONS
      XFF=IXF-IX0
      YFF=IYF-IY0
      XFF=XFF/IXLEN
      YFF=YFF/IYLEN
C  CONVERT TO WORLD UNITS
      XFW=XMIN+XFF*RANGWX
      YFW=YMIN+YFF*RANGWY
      IHX=NINT(XFW)
      IHY=NINT(YFW)
C   BACK TO VT100 MODE
      CALL CLEARV
      IF((TERM.EQ.'S').OR.(TERM.EQ.'s'))THEN
        K1 = MAX(1,IHX) - ISTAR1 + 1
        K2 = MIN(IHX+ISPAN,IDIM1) - ISTAR1 + 1
        IF(NSEQ.NE.2)THEN
        WRITE(KBOUT,1015)K1+ISTAR1-1,(SEQ1(K),K=K1,K2)
1015    FORMAT(' ',I7,' ',21A1)
        ELSE IF(NSEQ.EQ.2)THEN
          KK1 = MAX(1,IHY) - ISTAR2 + 1
          KK2 = MIN(IHY+ISPAN,IDIM2) - ISTAR2 + 1
          L = MIN(K2-K1,KK2-KK1) + 1
          IF(L.GT.0) THEN
            CALL SQMTCH(SEQ1(K1),SEQ2(KK1),MATCH,L)
            CALL FMT4LN(SEQ2(KK1),SEQ1(K1),MATCH,L,
     +      KK1+ISTAR2-1,K1+ISTAR1-1,KBOUT)
          END IF
        END IF
        GO TO 10
      END IF
      IF((TERM.EQ.'M').OR.(TERM.EQ.'m').AND.(NSEQ.EQ.2))THEN
        K1 = MAX(1,IHX) - ISTAR1 + 1
        K2 = MIN(IHX+ISPAN,IDIM1) - ISTAR1 + 1
        KK1 = MAX(1,IHY) - ISTAR2 + 1
        KK2 = MIN(IHY+ISPAN,IDIM2) - ISTAR2 + 1
        L = MIN(K2-K1,KK2-KK1) + 1
        IF(L.GT.0) THEN
          CALL DIABOX(SEQ2,IDIM2,SEQ1,IDIM1,KK1,K1,L,MATCH,KBOUT)
        END IF
        GO TO 10
      END IF
      WRITE(KBOUT,1014)IHX,IHY
1014  FORMAT(' Cross hair at',2I7)
      IF(TERM.EQ.COMMA)GO TO 10
      RETURN
      END
      SUBROUTINE DIABOX(SEQ1,IDIM1,SEQ2,IDIM2,I11,I21,
     +LENGTH,LINE,KBOUT)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ1(IDIM1),SEQ2(IDIM2),LINE(LENGTH)
      INTEGER CTONUM
      EXTERNAL CTONUM
      WRITE(KBOUT,*)
      I12 = I11 + LENGTH - 1
      I22 = I21 + LENGTH - 1
      WRITE(KBOUT,1000)(SEQ2(K),K=I21,I22)
      DO 100 I=I12,I11,-1
        CALL FILLC(LINE,LENGTH,'.')
        L=0
        DO 50 J=I21,I22
          L=L+1
          IF(CTONUM(SEQ1(I)).EQ.CTONUM(SEQ2(J))) 
     +    LINE(L) = SEQ1(I)
50      CONTINUE
        WRITE(KBOUT,1001)SEQ1(I),(LINE(K),K=1,L),SEQ1(I)
100   CONTINUE
      WRITE(KBOUT,1000)(SEQ2(K),K=I21,I22)
1000  FORMAT(4X,36A1)
1001  FORMAT(3X,A1,36A1,A1)
      END
      SUBROUTINE RULER(J1,J2,IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,KBIN,KBOUT,ISCALE,
     +IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      EXTERNAL IPSEP
C  RULER DRAWS A SCALE ON THE X OR Y AXIS. THE CURRENT ACTIVE REGION IS 
C  J1,J2. THE USER CAN GIVE THE COORDINATE OF THE FIRST CHARACTER POSIITON
C  TO BE MARKED (THE DEFAULT IS J1). THE SEPARATION AND HEIGHT IS ALSO 
C  DEFINED BY THE USER
      IBH1=ISYMAX/100
      IF(ISCALE.EQ.2)IBH1=ISXMAX/100
      XMAX=J2
      XMIN=J1
      YMAX=J2
      YMIN=J1
      WRITE(KBOUT,1000)
1000  FORMAT(' Draw a scale')
      MMN = J1
      MMX = J2
      ISTART = J1
      CALL GETINT(MMN,MMX,ISTART,'Put first tick at',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF((IOK.NE.0).OR.(IVAL.EQ.0)) THEN
        CALL CLEARV
        RETURN
      END IF
      ISTART = IVAL
      FIRST=J1
C   SET DEFAULT NUMBER OF BLIPS TO 10
      NMAX=10
C   CHECK ON SEPARATION (NO CLOSER THAT 1 EVERY 5 PIXELS)
      UMIN=ABS(XMIN-XMAX)
      SMIN=IXLEN
      ISEP=IPSEP(XMAX,XMIN,NMAX)
      IF(ISCALE.EQ.2)THEN
        UMIN=ABS(YMAX-YMIN)
        SMIN=IYLEN
        ISEP=IPSEP(YMAX,YMIN,NMAX)
      END IF
      IF(SMIN.EQ.0.0)THEN
        WRITE(KBOUT,*)' ERROR IN SCREEN DEFINITION'
        RETURN
      END IF
C   FIVE PIXELS IS
      ONEPIX=UMIN/SMIN
      IFIVEP=ONEPIX*5.0
100   CONTINUE
      MMN = IFIVEP
      MMX = J2 - J1
      INC = ISEP
      CALL GETINT(MMN,MMX,INC,'Tick spacing',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF((IOK.NE.0).OR.(IVAL.EQ.0)) THEN
        CALL CLEARV
        RETURN
      END IF
      INC = IVAL
      BIT=INC
      MMN = 0
      IF(ISCALE.EQ.1) MMX = IYLEN
      IF(ISCALE.EQ.2) MMX = IXLEN
      IBH = IBH1
      CALL GETINT(MMN,MMX,IBH,'Tick height',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF((IOK.NE.0).OR.(IVAL.EQ.0)) THEN
        CALL CLEARV
        RETURN
      END IF
      IBH = IVAL
      IF(ISTART.GT.0)FIRST=ISTART
      CALL CLEARV
      CALL VECTOM
      CALL SCALES(XMAX,XMIN,YMAX,YMIN,
     +IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX,
     +BIT,IBH,FIRST,ISCALE)
      CALL VT100M
      GO TO 100
      END
      SUBROUTINE REDIR(IDEV,DEVOUT,IDEVGR,GORT,FILNAM,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,KOPT)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
C   routine to allow the user to select disk output
C   if GORT = 0 redirection off
C   if GORT = 1 redirection of text
C   if GORT = 2 redirection of graphics
C
C   notice the redirection is handled differently for text and graphics:
C   text is done by changing idev to devout and opening idev
C   graphics is done by closing idevgr and opening devout and changing
C   the value of idevgr in the graphics common block. Note also that
C   IGORF is used by the graphics to suppress clearv and xhair
C
C   Postscript output: file opened here, flag is posto: 0 off, 1 open
C   All output controlled from c but implemented by modifying move
C   and draw subroutines in pl4010
C
C   Can do one job at a time: if opening only one, if closing only one
C   ie 2 visits to close both postcript and redirection
C   if either is open and we come in to open the other we will first
C   be asked if we want to close the open one
C
      CHARACTER FILNAM*(*)
      INTEGER DEVOUT,GORT,POSTO
      PARAMETER (MAXPRM = 19)
      CHARACTER PROMPT(3)*(MAXPRM)
      CHARACTER FNDFIL*1024, FIL2*1024
      INTEGER OPENP
      EXTERNAL FNDFIL, OPENP
      SAVE POSTO
      DATA POSTO/0/
      IF(GORT.NE.0) THEN
        CALL YESNO(IN,'Close redirection file',
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        IF(IN.EQ.0) THEN
          IF(GORT.EQ.1) THEN
            CLOSE(UNIT=DEVOUT)
            IDEV = KBOUT
          ELSE IF(GORT.EQ.2) THEN
            CLOSE(UNIT=DEVOUT)
            CALL OPENGR(IDEVGR)
          END IF
          GORT = 0
          RETURN
        END IF
      END IF
      IF(POSTO.NE.0) THEN
        CALL YESNO(IN,'Close postscript file',
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        IF(IN.EQ.0) THEN
          IJUNK=OPENP(' ',0,0,0,0,0,0)
          POSTO = 0
          RETURN
        END IF
      END IF
      IN = 1
      PROMPT(1) = 'Redirect text'
      PROMPT(2) = 'Redirect graphics'
      PROMPT(3) = 'Open postscipt file'
      CALL RADION('Select redirection',PROMPT,3,IN,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IN.EQ.1) THEN
        IF (GORT.NE.0) THEN
          CALL ERROM(KBOUT,
     +    'Output already redirected: please close file')
          RETURN
        END IF
        FILNAM = ' '
        CALL OPENF1(DEVOUT,FILNAM,1,IOK,KBIN,KBOUT,
     +    'Text file name',IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0)RETURN
        IDEV=DEVOUT
        GORT = 1
      ELSE IF(IN.EQ.2) THEN
        IF (GORT.NE.0) THEN
          CALL ERROM(KBOUT,
     +    'Output already redirected: please close file')
          RETURN
        END IF
        CLOSE(UNIT = IDEVGR)
        FILNAM = ' '
        CALL OPENF1(DEVOUT,FILNAM,1,IOK,KBIN,KBOUT,
     +    'Graphics file name',IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0) THEN
          CALL OPENGR(IDEVGR)
          GORT = 0
          RETURN
        END IF
        CALL OPENGF(DEVOUT)
        GORT = 2
      ELSE IF(IN.EQ.3) THEN
        IF (POSTO.NE.0) THEN
          CALL ERROM(KBOUT,
     +    'Postscript already selected: please close file')
          RETURN
        END IF
 10     CONTINUE
        FILNAM = ' '
        LIN = 0
        CALL GTSTR('Postcript file name',' ',FILNAM,LIN,
     +  KBOUT,KBIN,INFLAG)
        IF(INFLAG.EQ.1) THEN
          CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          GO TO 10
        END IF
        POSTO = 0
        IF ((INFLAG.EQ.2).OR.(LIN.EQ.0)) THEN
          RETURN
        END IF
CALL CROUTINE
        IF (KOPT.EQ.1) THEN
           CALL YESNO(LNDSCP, 'Print in portrait mode',
     +          IHELPS, IHELPE, HELPF, IDEVH, KBIN, KBOUT)
           IF (LNDSCP.EQ.-1) THEN
              RETURN
           ENDIF
           CALL GETINT(0, 9999, 0, 'Bottom left X co-ord of region',
     +          IX1, KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
           IF (IOK.EQ.1) THEN
              RETURN
           ENDIF
           CALL GETINT(0, 9999, 0, 'Bottom left Y co-ord of region',
     +          IY1, KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
           IF (IOK.EQ.1) THEN
              RETURN
           ENDIF
           CALL GETINT(IX1,9999,9999,'Top right X co-ord of region',
     +          IX2, KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
           IF (IOK.EQ.1) THEN
              RETURN
           ENDIF
           CALL GETINT(IY1,9999,9999,'Top right Y co-ord of region',
     +          IY2, KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
           IF (IOK.EQ.1) THEN
              RETURN
           ENDIF
           CALL GETINT(1,20,5,'Line thickness',
     +          IWIDTH, KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
           IF (IOK.EQ.1) THEN
              RETURN
           ENDIF
        ELSE
           LNDSCP = 0
           IX1 = 0
           IX2 = 9999
           IY1 = 0
           IY2 = 9999
           IWIDTH = 5
        END IF
        FIL2 = FNDFIL(FILNAM)
        POSTO = OPENP(FIL2, IX1, IY1, IX2, IY2, IWIDTH, LNDSCP)
      END IF
      END
      SUBROUTINE SHUTD
C
C routine to contain all necessary shutdown procedures
C
      IJUNK=OPENP(' ',0,0,0,0,0,0)
      END
      SUBROUTINE XHAIRR(ISXMAX,ISYMAX,IX,IY,TERM,DBTDUX,DBTDUY)
      CHARACTER TERM
      CALL XHAIR(IX,IY,TERM)
      END
      REAL FUNCTION CWORLD(I,I0,ILEN,RMIN,RMAX)
      CWORLD = RMIN + (REAL(I-I0)/ILEN) * (RMAX-RMIN)
      END
      INTEGER FUNCTION NOPWIN(IY,IY0,IYLEN,MAXOPT)
      INTEGER IY0(MAXOPT),IYLEN(MAXOPT)
      DO 20 I = 29,MAXOPT
        IF(IY.GT.IY0(I)) THEN
          IF(IY.LT.(IY0(I)+IYLEN(I))) THEN
            NOPWIN = I
            RETURN
          END IF
        END IF
20    CONTINUE
      NOPWIN = 0
      END
      SUBROUTINE MOVEGR(IX,IY)
C
C
C
CALL CROUTINE
      CALL MOVEP(IX,IY)
      CALL MOVEXY(IX,IY)
      END
      SUBROUTINE DRAWGR(IX,IY)
C
C
C
CALL CROUTINE
      CALL DRAWP(IX,IY)
      CALL DRAWXY(IX,IY)
      END
      SUBROUTINE WRITET(IX,IY,CHARS,NCHARS)
      CHARACTER CHARS*(*)
C
C
C
CALL CROUTINE
      CALL WRITEP(IX,IY,CHARS,NCHARS)
      CALL WRITXY(IX,IY,CHARS,NCHARS)
      END
      SUBROUTINE POINTG(IX,IY)
CALL C ROUTINE
      CALL POINTP(IX,IY)
      CALL DOTXY(IX,IY)
      END
      SUBROUTINE CLEARG
CALL C ROUTINE HERE
      CALL CLEARP
      CALL BLANKG
      END
