C 
C Program TRGLPS to display values defined in vertices of triangulated
C 2-D sections in PostScript.
C
C Version: 5.50
C Date: 2001, June 12
C
C Coded by Petr Bulant
C             Department of Geophysics, Charles University Prague
C             Ke Karlovu 3,  121 16  Praha 2,  Czech Republic
C             E-mail: bulant@seis.karlov.mff.cuni.cz
C
C.......................................................................
C                                                    
C Description of data files:
C
C Input data read from the standard input device (*):
C     The data are read by the list directed input (free format) and
C     consist of a single string 'SEP':
C     'SEP'...String in apostrophes containing the name of the input
C             SEP parameter or history file with the input data.
C     No default, 'SEP' must be specified and cannot be blank.
C
C                                                     
C Input data file 'SEP':
C     File 'SEP' has the form of the SEP
C     parameter file.  The parameters, which do not differ from their
C     defaults, need not be specified in file 'SEP'.
C Data specifying input files:
C     VRTX='string'... Name of the file with vertices of the polygons.
C        Description of file VRTX
C             Default: VRTX='vrtx.out'
C     TRGL='string'... Name of the file describing the triangles
C             of the 2-D section.
C             Description of file TRGL
C             Default: TRGL='trgl.out'
C Output PostScript file:
C     TRGLPS='string'... Name of the output PostScript file.
C             It is recommended to specify TRGLPS rather than to use the
C             default name.
C             Default: TRGLPS='trglps.ps'
C Data describing dimensions and layout of the picture:
C     UNIT='string'... All lengths controlling the size and position of
C             the plot are assumed to be expressed in the units given
C             by the string.  The units also influence the default
C             paper size, plot size and margins.  Allowed values:
C             UNIT='cm': centimetres (default),
C             UNIT='in': inches (1in=2.54cm).
C     XSIGN=real... Determines the sign of the default value of HSIZE.
C             Default: XSIGN=1.
C     HSIZE=real... Size (in UNITs) of the image, corresponding to the
C             X1 plot axis (horizontal before a possible rotation).
C             If negative, the values will be displayed from the right
C             to the left.
C             Default: HSIZE=SIGN( 16.0,XSIGN) for UNIT='cm',
C                      HSIZE=SIGN(  6.5,XSIGN) for UNIT='in',
C     YSIGN=real... Determines the sign of the default value of VSIZE.
C             Default: YSIGN=1.
C     VSIZE=real... Size (in UNITs) of the image, corresponding to the
C             X2 plot axis (vertical before a possible rotation).
C             If negative, the values will be displayed from the top to
C             the bottom.
C             Default (proportional display):
C               VSIZE=SIGN(HSIZE*DY/DX,YSIGN) where DY=YMAX-YMIN is the
C               extent of the coordinates of vertices corresponding to
C               X2 plot axis, DX is the extent corresponding to X1 axis.
C     HOFFSET=real... Distance (in UNITs) of the image from the leftmost
C             paper edge (before a possible rotation).  Controls the
C             horizontal position of the figure.
C             Default: HOFFSET=2.5 for UNIT='cm',
C                      HOFFSET=1.0 for UNIT='in',
C     VOFFSET=real... Distance (in UNITs) of the image from the bottom
C             paper edge (before a possible rotation).  Controls the
C             vertical position of the figure.
C             Default:
C               if VSIZE.LE.HEIGHT-2*2.5:     VOFFSET=HEIGHT-2.5-VSIZE
C               otherwise if VSIZE.LE.HEIGHT: VOFFSET=(HEIGHT-VSIZE)/2.
C               otherwise:                    VOFFSET=2.5
C     HEIGHT=real... Height of the paper in a portrait position.
C             Default: HEIGHT=29.7 for UNIT='cm',
C                      HEIGHT=11.0 for UNIT='in',
C     ROTATE=real... Enables to rotate the image by angle specified in
C             degrees (positive counterclockwise).  The image is rotated
C             around the centre of the square paper of size HEIGHT.
C             If applied, the user will probably wish to specify the
C             value of ROTATE=90.
C             Parameters HSIZE,VSIZE,HOFFSET,VOFFSET apply to the image
C             before rotation.
C             Attention: BoundingBox is incorrect if ROTATE is not
C               multiple of 90 degrees.
C             Default: ROTATE=0.
C     LEFT=integer... Determines, whether the 2-D section is to be
C             displayed in right-handed coordinate system with the
C             X1 plot axis corresponding to x1 (x2, x3 respectively)
C             section axis and X2 plot axis corresponding to
C             x2 (x3, x1 respectively) section axis,
C             or rather in left-handed system with X1 plot axis
C             corresponding to x2 (x3, x1) and X2 to x1 (x2, x3).
C             LEFT=0    ... Right-handed system
C             otherwise ... Left-handed system
C             Default: LEFT=0
C Data specifying the values to be scaled in colours:
C     KOLSRF=integer ... number of a column in file VRTX. The triangles
C             will be filled by colours according to the values written
C             in the KOLSRFth column of file VRTX.
C             Default: KOLSRF=7
C Data specifying the colour scale:
C     COLORS='string'... Name of the file containing the data describing
C             the colour map.
C             Description of file COLORS
C             Default: COLORS='hsv.dat'  (mostly sufficient)
C     VADD=real, VMUL=real, VPER=real, VREF=real, CREF=real, CREF1=real,
C     CREF2=real, CREF3=real, etc... Refer to file
C             colors.for.
C     VDIV=real... Period of values corresponding to one colour. The
C             triangles are divided into smaller polygons, in such way,
C             that the extent of values in the vertices of the polygons
C             is less than VDIV.
C             Default: VDIV=VPER/256.
C     R=real, G=real, B=real... Colour of the undefined
C             values.
C             Defaults: R=0.80, G=0.80, B=0.80 (light grey)
C
C                                                    
C Input file VRTX with the vertices of the triangles:
C (1) None to several strings terminated by / (a slash)
C (2) For each vertex data (2.1):
C (2.1) 'NAME',X1,X2,X3,Z1,Z2,Z3,/
C     'NAME'... Name of the vertex.  Not considered.  May be blank.
C     X1,X2,X3... Coordinates of the vertex.
C     Z1,Z2,Z3... Normal to the triangle at the vertex. Must be either
C             [1.,0.,0.], or [0.,1.,0.], or [0.,0.,1.].
C     /...    None to several values terminated by a slash.
C (3) / (a slash) or end of file.
C
C                                                    
C Input file TRGL with the triangles:
C (1) For each triangle data (1.1):
C (1.1) I1,I2,I3,/
C     I1,I2,I3... Indices of 3 vertices of the triangle, right-handed
C             with respect to the given surface normals.
C             The vertices in file VRTX are indexed by positive integers
C             according to their order.
C     /...    List of vertices of the triangle is terminated by a slash.
C
C=======================================================================
C Subroutines and external functions required:
      EXTERNAL CHANGE,ERROR,RSEP1,RSEP3T,RSEP3R,RSEP3I,FORM1,LOWER,
     *LENGTH,COLOR1,COLOR2,COLOR3
      INTEGER  LENGTH
C     CHANGE ... This file.
C     ERROR ... File error.for.
C     RSEP1,RSEP3T,RSEP3R,RSEP3I ...
C             File sep.for.
C     FORM1,LOWER ... File forms.for.
C     LENGTH ... File length.for.
C     COLOR1,COLOR2,COLOR3 ... File colors.for.
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
C
      INTEGER IRAM(MRAM)
      EQUIVALENCE (IRAM,RAM)
      INTEGER NVRTX,NPLGN
C.......................................................................
C
      INTEGER LU
      PARAMETER (LU=1)
      CHARACTER*80 FSEP,FOUT,FVRTX,FTRGL,FCOLS
      CHARACTER*255 TEXT,FORMAT
      INTEGER LEFT
      LOGICAL LRIGHT
      INTEGER KOLSRF,KQ,NQ
      REAL ROTATE,R,G,B,COLOR,DC
      CHARACTER*2 UNIT
      REAL UNITPT,HEIGHT,OFFSET,WIDTH
      REAL XSIGN,YSIGN
      REAL XMIN,XMAX,YMIN,YMAX,CMIN,CMAX,DX,DY
      REAL BBOX1,BBOX2,BBOX3,BBOX4,BB1,BB2,BB3,BB4
      REAL BB1P,BB2P,BB3P,BB4P,BB2DEF,BB4DEF,AUX,C,S
      INTEGER I1,I2
      INTEGER JX1,JY1,JC1,JX2,JY2,JC2,JX3,JY3,JC3
      REAL X2A,Y2A,X2B,Y2B,X3A,Y3A,X3B,Y3B
      REAL DC2,DC3,DC4,DX2,DY2,DX3,DY3,DX4,DY4
      REAL B1,B2,B3,B4
C
C     UNIT... One of: 'cm', 'in'.
C     UNITPT...Size of the length unit, in which input data controlling
C             the size and position of the plot are expressed, in big
C             points (pt).  E.g., UNITPT=72./2.54 corresponds to
C             plotting in cm.
C     HEIGHT..Anticipated height of the paper sheet.
C     OFFSET..Left margin, and top or bottom margin for low or high
C             plots, respectively.
C     WIDTH...Default width of the plot.
C
C-----------------------------------------------------------------------
C
C     Reading name of SEP file with input data:
      FSEP=' '
      WRITE(*,'(A)') '+TRGLPS: Enter input filename:'
      READ(*,*) FSEP
      WRITE(*,'(A)') '+TRGLPS: Working...           '
C
C     Reading all the data from the SEP file into the memory:
      IF (FSEP.NE.' ') THEN
        CALL RSEP1(LU,FSEP)
      ELSE
C       TRGLPS-01
        CALL ERROR('TRGLPS-01: SEP file not given')
C       Input file in the form of the SEP (Stanford Exploration Project)
C       parameter or history file must be specified.
C       There is no default filename.
      ENDIF
C
C     Reading input and output filenames:
      CALL RSEP3T('VRTX'  ,FVRTX,'vrtx.out')
      CALL RSEP3T('TRGL'  ,FTRGL,'trgl.out')
      CALL RSEP3T('COLORS',FCOLS,'hsv.dat' )
      CALL RSEP3T('TRGLPS',FOUT ,'trglps.ps')
C
C
C     Reading vertices:
      CALL RSEP3I('LEFT',LEFT,0)
      LRIGHT=.TRUE.
      IF (LEFT.NE.0) LRIGHT=.FALSE.
      CALL RSEP3I('KOLSRF',KOLSRF,7)
      KQ=MAX0(6,KOLSRF)
      IF (KOLSRF.LE.0) THEN
C       NQ=2
C       TRGLPS-02
        CALL ERROR('TRGLPS-02: Wrong value of KOLSRF')
C       KOLSRF must be positive integer.
      ELSE
        NQ=3
      ENDIF
      OPEN(LU,FILE=FVRTX,FORM='FORMATTED',STATUS='OLD')
      READ(LU,*) (TEXT,I1=1,20)
      NVRTX=0
   10 CONTINUE
        IF (NVRTX+KQ.GT.MRAM) THEN
C         TRGLPS-03
          CALL ERROR('TRGLPS-03: Too small array RAM')
        ENDIF
        TEXT='$'
        RAM(NVRTX+4)=0.
        RAM(NVRTX+5)=0.
        RAM(NVRTX+6)=0.
        IF (KOLSRF.GT.0) THEN
          RAM(NVRTX+KOLSRF)=0.
        ENDIF
        READ(LU,*,END=19) TEXT,(RAM(I1),I1=NVRTX+1,NVRTX+KQ)
        IF (TEXT.EQ.'$') GOTO 19
C       Shifting the coordinates to columns 1 to 2:
        IF (RAM(NVRTX+4).EQ.1.) THEN
          RAM(NVRTX+1)=RAM(NVRTX+2)
          RAM(NVRTX+2)=RAM(NVRTX+3)
        ELSEIF (RAM(NVRTX+5).EQ.1.) THEN
          RAM(NVRTX+2)=RAM(NVRTX+1)
          RAM(NVRTX+1)=RAM(NVRTX+3)
        ELSEIF (RAM(NVRTX+6).EQ.1.) THEN
C         RAM(NVRTX+1)=RAM(NVRTX+1)
C         RAM(NVRTX+2)=RAM(NVRTX+2)
          CONTINUE
        ELSE
C         TRGLPS-04
          CALL ERROR('TRGLPS-04: Wrong normal')
C         Input grid must be 2-D, one of the components of the normal
C         must equal 1, and the other two must equal zero.
        ENDIF
        IF (.NOT.LRIGHT) THEN
          AUX=RAM(NVRTX+1)
          RAM(NVRTX+1)=RAM(NVRTX+2)
          RAM(NVRTX+2)=AUX
        ENDIF
C       Shifting the value of color to column 3:
        IF (KOLSRF.GT.0) THEN
          RAM(NVRTX+3)=RAM(NVRTX+KOLSRF)
        ENDIF
C       Recording the minima and maxima of the coordinates:
        IF (NVRTX.EQ.0) THEN
          XMIN=RAM(NVRTX+1)
          XMAX=RAM(NVRTX+1)
          YMIN=RAM(NVRTX+2)
          YMAX=RAM(NVRTX+2)
          CMIN=RAM(NVRTX+3)
          CMAX=RAM(NVRTX+3)
        ELSE
          XMIN=AMIN1(XMIN,RAM(NVRTX+1))
          XMAX=AMAX1(XMAX,RAM(NVRTX+1))
          YMIN=AMIN1(YMIN,RAM(NVRTX+2))
          YMAX=AMAX1(YMAX,RAM(NVRTX+2))
          CMIN=AMIN1(CMIN,RAM(NVRTX+3))
          CMAX=AMAX1(CMAX,RAM(NVRTX+3))
        ENDIF
        NVRTX=NVRTX+NQ
      GOTO 10
   19 CONTINUE
      CLOSE(LU)
      DX=XMAX-XMIN
      DY=YMAX-YMIN
      IF (DX.LE.0..OR.DY.LE.0.) THEN
C       TRGLPS-05
        CALL ERROR('TRGLPS-05: Infinitely thin section')
C       The section should be two-dimensional.
      ENDIF
C
C
C     Recalling the plotting unit and setting default dimensions:
      CALL RSEP3T('UNIT',UNIT,'cm')
      CALL LOWER(UNIT)
      IF (UNIT.EQ.'cm') THEN
        UNITPT=72./2.54
        HEIGHT=29.7
        OFFSET=2.5
        WIDTH=16.0
      ELSEIF (UNIT.EQ.'in') THEN
        UNITPT=72.
        HEIGHT=11.0
        OFFSET=1.0
        WIDTH=6.5
*     ELSEIF (UNIT.EQ.'pt') THEN
*       UNITPT=1.
*       HEIGHT=FLOAT(N32*N2)
*       OFFSET=0.0
*       WIDTH=FLOAT(N31*N1)
      ELSE
C       TRGLPS-06
        CALL ERROR('TRGLPS-06: Unrecognized plotting units')
C       Allocated plotting units are UNIT='cm', UNIT='in' or UNIT='pt'.
      ENDIF
C
C
C     Recalling the data for the plotting area:
      CALL RSEP3R('XSIGN'  ,XSIGN,1.)
      CALL RSEP3R('YSIGN'  ,YSIGN,1.)
      AUX=HEIGHT
      CALL RSEP3R('HEIGHT' ,HEIGHT,AUX)
      CALL RSEP3R('HSIZE'  ,BB3,SIGN(WIDTH,XSIGN))
      CALL RSEP3R('HOFFSET',BB1,OFFSET)
C     Default height of the figure (proportional image):
      BB4DEF=ABS(BB3)*DY/DX
      CALL RSEP3R('VSIZE'  ,BB4,SIGN(BB4DEF,YSIGN))
C     Default vertical position of the figure:
      IF (ABS(BB4).LE.HEIGHT-2.*OFFSET) THEN
        BB2DEF=HEIGHT-OFFSET-ABS(BB4)
      ELSEIF(ABS(BB4).LE.HEIGHT) THEN
        BB2DEF=(HEIGHT-ABS(BB4))/2.
      ELSE
        BB2DEF=OFFSET
      ENDIF
      CALL RSEP3R('VOFFSET',BB2,BB2DEF)
      IF (BB3.LT.0.) BB1=BB1-BB3
      IF (BB4.LT.0.) BB2=BB2-BB4
      CALL RSEP3R('ROTATE',ROTATE,0.)
C
C     Transformation from plotting units (e.g. centimetres) to points:
      BB1P=BB1*UNITPT
      BB2P=BB2*UNITPT
      BB3P=BB3*UNITPT
      BB4P=BB4*UNITPT
C
C     Bounding box:
      BBOX1=AMIN1(BB1P,BB1P+BB3P)
      BBOX2=AMIN1(BB2P,BB2P+BB4P)
      BBOX3=AMAX1(BB1P,BB1P+BB3P)
      BBOX4=AMAX1(BB2P,BB2P+BB4P)
      B1=BBOX1
      B2=BBOX2
      B3=BBOX3
      B4=BBOX4
      IF(ROTATE.NE.0.) THEN
        C=COS(ROTATE*3.14159/180.)
        S=SIN(ROTATE*3.14159/180.)
        BBOX1=BBOX1-HEIGHT*UNITPT/2.
        BBOX2=BBOX2-HEIGHT*UNITPT/2.
        BBOX3=BBOX3-HEIGHT*UNITPT/2.
        BBOX4=BBOX4-HEIGHT*UNITPT/2.
        AUX  =C*BBOX1-S*BBOX2
        BBOX2=S*BBOX1+C*BBOX2
        BBOX1=AUX
        AUX  =C*BBOX3-S*BBOX4
        BBOX4=S*BBOX3+C*BBOX4
        BBOX3=AUX
        BBOX1=BBOX1+HEIGHT*UNITPT/2.
        BBOX2=BBOX2+HEIGHT*UNITPT/2.
        BBOX3=BBOX3+HEIGHT*UNITPT/2.
        BBOX4=BBOX4+HEIGHT*UNITPT/2.
        AUX  =AMIN1(BBOX1,BBOX3)
        BBOX3=AMAX1(BBOX1,BBOX3)
        BBOX1=AUX
        AUX  =AMIN1(BBOX2,BBOX4)
        BBOX4=AMAX1(BBOX2,BBOX4)
        BBOX2=AUX
      ENDIF
C
C
C     Recomputing true coordinates of the vertices into page coordinates
      DO 20, I1=1,NVRTX,NQ
        RAM(I1)=(RAM(I1)-XMIN)/DX*BB3P+BB1P
        RAM(I1+1)=(RAM(I1+1)-YMIN)/DY*BB4P+BB2P
  20  CONTINUE
C
C
C     Reading the triangles:
      DO 81 I1=NVRTX+1,MRAM
        IRAM(I1)=0
   81 CONTINUE
      OPEN(LU,FILE=FTRGL,FORM='FORMATTED',STATUS='OLD')
      NPLGN=NVRTX
   82 CONTINUE
        IF (NPLGN.GT.MRAM) THEN
C         TRGLPS-07
          CALL ERROR('TRGLPS-07: Too small array RAM')
        ENDIF
        READ(LU,*,END=89) (IRAM(I1),I1=NPLGN+1,NPLGN+3)
        DO 83 I1=NPLGN+1,NPLGN+3
          IF ((IRAM(I1).LE.0).OR.(IRAM(I1).GT.NVRTX/NQ)) THEN
C           TRGLPS-08
            WRITE(TEXT,'(A,I6)')'TRGLPS-08: Wrong vertex index',IRAM(I1)
            CALL ERROR(TEXT(1:LENGTH(TEXT)))
          ENDIF
   83   CONTINUE
        NPLGN=NPLGN+3
      GOTO 82
   89 CONTINUE
      CLOSE(LU)
C
C
C     Reading colours of undefined values:
      CALL RSEP3R('R',R,0.8)
      CALL RSEP3R('G',G,0.8)
      CALL RSEP3R('B',B,0.8)
C     Determining the colour map:
      IF (KOLSRF.GT.0) THEN
        CALL COLOR1(LU,MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                            1,CMIN,CMAX)
      ENDIF
C
C     Writing PostScript prolog:
      WRITE(*,'(''+'',79('' ''))')
      WRITE(*,'(2A)') '+TRGLPS: Writing ',FOUT(1:MIN0(LEN(FOUT),63))
      OPEN(LU,FILE=FOUT)
      WRITE(LU,'(A/A,4I6,/(A))')
     *'%!PS-Adobe-3.0',
     *'%%BoundingBox:',INT(BBOX1+.5),INT(BBOX2+.5),
     *                 INT(BBOX3+.5),INT(BBOX4+.5),
     *'%%EndComments',
     *'%%BeginProlog',
     *'%%BeginProcSet: (trglps)',
     *'%%Creator: trglps',
     *'%-----------------------------------------------------------',
     *'/C {setrgbcolor} bind def',
     *'/M {moveto} bind def',
     *'/L {lineto} bind def',
     *'/F {lineto closepath fill} bind def',
     *'%-----------------------------------------------------------',
     *'%%EndProcSet',
     *'%%EndProlog',
     *'%-----------------------------------------------------------',
     *'%%BeginSetup',
     *'% Numerical values describing the image size and position:'
cc    WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB1',BB1P,' def %',BB1,'cm'
cc    WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB2',BB2P,' def %',BB2,'cm'
cc    WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB3',BB3P,' def %',BB3,'cm'
cc    WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB4',BB4P,' def %',BB4,'cm'
      WRITE(LU,'(A,F8.1,A)')        '/PAPERSIZE',HEIGHT*UNITPT,' def'
      WRITE(LU,'(A,F8.1,A)')        '/ROTATE',ROTATE,' def'
      WRITE(LU,'(A)')
     *'%%EndSetup',
     *'%-----------------------------------------------------------',
     *'%%BeginObject: (trglps)',
     *'PAPERSIZE  2 div dup translate ROTATE rotate',
     *'PAPERSIZE -2 div dup translate',
     *'%-----------------------------------------------------------'
C     Setting colour of undefined values:
      WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
C
C
C     Writing the triangles:
      CALL COLOR3(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),1,I1,I2)
      I1=I1+NPLGN+2
      CALL RSEP3R('VDIV',DC,RAM(I1)/256.)
      DC=ABS(DC)
      IF (DC.EQ.0.) THEN
C       TRGLPS-09
        CALL ERROR('TRGLPS-09: Wrong value of VDIV')
C       VDIV must be nonzero.
      ENDIF
      FORMAT='(F00.0,A,F00.0,A,F00.0,A,F00.0,A,F00.0,A,F00.0,A:F00.0,A,F
     *00.0,A)'
      CALL FORM1(AMIN1(AINT(BBOX1+.5),AINT(BBOX2+.5)),
     *           AMAX1(AINT(BBOX3+.5),AINT(BBOX4+.5)),FORMAT(2:9))
      FORMAT(11:14)=FORMAT(3:6)
      FORMAT(19:22)=FORMAT(3:6)
      FORMAT(27:30)=FORMAT(3:6)
      FORMAT(35:38)=FORMAT(3:6)
      FORMAT(43:46)=FORMAT(3:6)
      FORMAT(51:54)=FORMAT(3:6)
      FORMAT(59:62)=FORMAT(3:6)
C     Plotting undefined values:
      WRITE(LU,FORMAT) B1,' ',B2,' M ',B1,' ',B4,' L ',
     *     B3,' ',B4,' L ',B3,' ',B2,' F'
      DO 99, I2=NVRTX+1,NPLGN,3
        JX1=(IRAM(I2)-1)*3+1
        JY1=JX1+1
        JC1=JY1+1
        JX2=(IRAM(I2+1)-1)*3+1
        JY2=JX2+1
        JC2=JY2+1
        JX3=(IRAM(I2+2)-1)*3+1
        JY3=JX3+1
        JC3=JY3+1
        IF (KOLSRF.GT.0) THEN
C         Ordering the vertices according to the colour:
          IF (RAM(JC1).GT.RAM(JC2)) CALL CHANGE(JX1,JY1,JC1,JX2,JY2,JC2)
          IF (RAM(JC2).GT.RAM(JC3)) CALL CHANGE(JX2,JY2,JC2,JX3,JY3,JC3)
          IF (RAM(JC1).GT.RAM(JC2)) CALL CHANGE(JX1,JY1,JC1,JX2,JY2,JC2)
          DC2=RAM(JC2)-RAM(JC1)
          DC3=RAM(JC3)-RAM(JC1)
          DC4=RAM(JC3)-RAM(JC2)
          IF (DC3.LE.DC) THEN
C           Writing the whole triangle:
            COLOR=(RAM(JC3)+RAM(JC1))/2.
            CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                   1,COLOR,R,G,B)
            WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
            WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ',
     *            RAM(JX2),' ',RAM(JY2),' L ',RAM(JX3),' ',RAM(JY3),' F'
          ELSE
            DX2=RAM(JX2)-RAM(JX1)
            DY2=RAM(JY2)-RAM(JY1)
            DX3=RAM(JX3)-RAM(JX1)
            DY3=RAM(JY3)-RAM(JY1)
            DX4=RAM(JX3)-RAM(JX2)
            DY4=RAM(JY3)-RAM(JY2)
            IF (DC2.LE.DC) THEN
C             Writing the whole first part of the triangle:
              COLOR=(RAM(JC2)+RAM(JC1))/2.
              CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                    1,COLOR,R,G,B)
              WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
              X2B=RAM(JX2)
              Y2B=RAM(JY2)
              X3B=RAM(JX1)+DC2/DC3*DX3
              Y3B=RAM(JY1)+DC2/DC3*DY3
              WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ',
     *              X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
            ELSE
C             Writing the first part of the triangle by parts:
              COLOR=RAM(JC1)+DC/2.
              CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                    1,COLOR,R,G,B)
              WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
              X2B=RAM(JX1)+DC/DC2*DX2
              Y2B=RAM(JY1)+DC/DC2*DY2
              X3B=RAM(JX1)+DC/DC3*DX3
              Y3B=RAM(JY1)+DC/DC3*DY3
              WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ',
     *              X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
              DO 92, I1=1,INT(DC2/DC)-1
                COLOR=COLOR+DC
                CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                    1,COLOR,R,G,B)
                WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
                X2A=X2B
                Y2A=Y2B
                X3A=X3B
                Y3A=Y3B
                X2B=X2B+DC/DC2*DX2
                Y2B=Y2B+DC/DC2*DY2
                X3B=X3B+DC/DC3*DX3
                Y3B=Y3B+DC/DC3*DY3
                WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ',
     *              X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
  92          CONTINUE
              COLOR=(COLOR+DC/2. + RAM(JC2))/2.
              CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                   1,COLOR,R,G,B)
              WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
              X2A=X2B
              Y2A=Y2B
              X3A=X3B
              Y3A=Y3B
              X2B=RAM(JX2)
              Y2B=RAM(JY2)
              X3B=RAM(JX1)+DC2/DC3*DX3
              Y3B=RAM(JY1)+DC2/DC3*DY3
              WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ',
     *            X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
            ENDIF
            IF (DC4.LE.DC) THEN
C             Writing the whole second part of the triangle:
              COLOR=(RAM(JC3)+RAM(JC2))/2.
              CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                    1,COLOR,R,G,B)
              WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
              WRITE(LU,FORMAT) RAM(JX3),' ',RAM(JY3),' M ',
     *              X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
            ELSE
C             Writing the second part of the triangle by parts:
              COLOR=RAM(JC2)+DC/2.
              CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                    1,COLOR,R,G,B)
              WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
              X2A=X2B
              Y2A=Y2B
              X3A=X3B
              Y3A=Y3B
              X2B=X2B+DC/DC4*DX4
              Y2B=Y2B+DC/DC4*DY4
              X3B=X3B+DC/DC3*DX3
              Y3B=Y3B+DC/DC3*DY3
              WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ',
     *            X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
              DO 94, I1=1,INT(DC4/DC)-1
                COLOR=COLOR+DC
                CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                    1,COLOR,R,G,B)
                WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
                X2A=X2B
                Y2A=Y2B
                X3A=X3B
                Y3A=Y3B
                X2B=X2B+DC/DC4*DX4
                Y2B=Y2B+DC/DC4*DY4
                X3B=X3B+DC/DC3*DX3
                Y3B=Y3B+DC/DC3*DY3
                WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ',
     *              X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F'
  94          CONTINUE
              COLOR=(COLOR+DC/2. + RAM(JC3))/2.
              CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),
     *                                                   1,COLOR,R,G,B)
              WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C '
              X2A=X2B
              Y2A=Y2B
              X3A=X3B
              Y3A=Y3B
              X2B=RAM(JX3)
              Y2B=RAM(JY3)
              WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ',
     *            X2B,' ',Y2B,' F '
            ENDIF
          ENDIF
        ELSE
C         Writing the vertices of the triangle:
          WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ',
     *          RAM(JX2),' ',RAM(JY2),' L ',RAM(JX3),' ',RAM(JY3),' F'
        ENDIF
   99 CONTINUE
C
C
C     Writing PostScript trailer:
      WRITE(LU,'(A)')
     *'PAPERSIZE  2 div dup translate ROTATE neg rotate',
     *'PAPERSIZE -2 div dup translate',
     *'%%EndObject',
     *'showpage',
     *'%%EOF'
      CLOSE(LU)
C
      WRITE(*,'(''+'',79('' ''))')
      WRITE(*,'(A)') '+TRGLPS: Done.'
C
      STOP
      END
C-----------------------------------------------------------------------
      SUBROUTINE CHANGE(I,J,K,L,M,N)
      INTEGER I,J,K,L,M,N,IA,JA,KA
      IA=I
      JA=J
      KA=K
      I=L
      J=M
      K=N
      L=IA
      M=JA
      N=KA
      RETURN
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'forms.for'
C     forms.for
      INCLUDE 'colors.for'
C     colors.for
      INCLUDE 'length.for'
C     length.for
C
C=======================================================================
C