C
C SUBROUTINE 'QGWRPS'
C ===================
C
C WRITE POSTSCIPT OUTPUT FILE CONTAINING CURRENTLY RECORDED POSTSCRIPT 
C DATA FOR A4 O/P LANDSCAPE OR PORTRAIT (ALSO CLEARS CURRENT POSTSCRIPT
C RECORD AND STARTS A NEW RECORDING (E.G. FOR A NEW PICTURE))
C
      SUBROUTINE QGWRPS (LUNOUT, IORIEN)
C
C PARAMETERS
C
C      LUNOUT (I)   LOGICAL UNIT NUMBER OF OUTPUT POSTSCRIPT FILE - ASSUMED
C                   TO HAVE BEEN ALREADY OPENED BY THE PROGRAM AS A
C                   FORMATTED SEQUENTIAL FILE. THIS ROUTINE WILL CLOSE
C                   THE FILE WHEN THE FILE HAS BEEN WRITTEN
C      IORIEN (I)   =1 LANDSCAPE
C                   =2 PORTRAIT
C
C SPECIFICATION STATEMENTS
C ------------------------
C
      CHARACTER*80 TEXT
      LOGICAL PSCRIP, PSON
      COMMON /QQPS/ PSCRIP, PSON, LUNP
      SAVE /QQPS/
C
C CODE
C ----
C
      IF (.NOT.PSCRIP) THEN
         CLOSE (LUNOUT)
         RETURN
      ENDIF
      WRITE (LUNOUT,1001)
      IF (IORIEN.NE.2) THEN
         WRITE (LUNOUT,1002)
      ELSE
         WRITE (LUNOUT,1003)
      ENDIF
      WRITE (LUNOUT,1004)
      WRITE (LUNOUT,1005)
      WRITE (LUNOUT,1006)
      WRITE (LUNOUT,1007)
      WRITE (LUNOUT,1008)
      WRITE (LUNOUT,1009)
      REWIND (LUNP)
100   READ (LUNP,'(A)',END=200) TEXT
      LMAX = 25
      IF (TEXT(1:1).EQ.'%') LMAX = 80
      DO 110 L=LMAX,1,-1
         IF (TEXT(L:L).NE.' ') GO TO 120
110   CONTINUE
      L = 1
120   WRITE (LUNOUT,1500) TEXT(1:L)
      GO TO 100
C
200   WRITE (LUNOUT,1520)
      CLOSE (LUNOUT)
      CALL QGPSET(2)
      RETURN
C
C FORMAT STATEMENTS
C -----------------
C
C
1001  FORMAT('%!',/,'newpath')
1002  FORMAT('552 79 translate',/,
     *       '90 rotate',/,
     *       '.6667 .6667 scale',/,
     *       '/scp 4.25 def')
1003  FORMAT('67 249 translate',/,
     *       '.45 .45 scale',/,
     *       '/scp 6.30 def')
1004  FORMAT('/M {moveto} def',/,
     *       '/L {lineto} def',/,
     *       '/R {rlineto} def',/,
     *       '/S {stroke} def')
1005  FORMAT('/S1 {',/,
     *       '/hs exch def',/,
     *       '/ys exch def',/,
     *       '/xs exch def',/,
     *       'xs hs sub ys M',/,
     *       'xs hs add ys L',/,
     *       'xs ys hs sub M',/,
     *       'xs ys hs add L',/,
     *       'S } def')
1006  FORMAT('/S2 {',/,
     *       '/hs exch def',/,
     *       '/ys exch def',/,
     *       '/xs exch def',/,
     *       'xs hs sub ys hs sub M',/,
     *       'xs hs add ys hs add L',/,
     *       'xs hs add ys hs sub M',/,
     *       'xs hs sub ys hs add L',/,
     *       'S } def')
1007  FORMAT('/S3 {',/,
     *       '/hs exch def',/,
     *       '/ys exch def',/,
     *       '/xs exch def',/,
     *       'xs hs sub ys hs sub M',/,
     *       'xs hs sub ys hs add L',/,
     *       'xs hs add ys hs add L',/,
     *       'xs hs add ys hs sub L',/,
     *       'xs hs sub ys hs sub L',/,
     *       'S } def')
1008  FORMAT('/S4 {',/,
     *       '/hs exch def',/,
     *       '/ys exch def',/,
     *       '/xs exch def',/,
     *       'xs ys hs sub M',/,
     *       'xs hs sub ys L',/,
     *       'xs ys hs add L',/,
     *       'xs hs add ys L',/,
     *       'xs ys hs sub L',/,
     *       'S } def')
1009  FORMAT('/P {',/,
     *       '/hs exch def',/,
     *       '/ys exch def',/,
     *       '/xs exch def',/,
     *       'xs ys M',/,
     *       '/rad {hs scp mul} def',/,
     *       'xs ys rad 0 360 arc fill',/,
     *       '} def')
1500  FORMAT(A)
1520  FORMAT('stroke showpage')
      END
