C 
C Program PICTURES to draw lines and points
C
C Program PICTURES is designed to draw texts and 2-D projections of
C 3-D lines and points.  The drawing is controled with control data.
C The form of the file containing control data and the form of the
C files containing the data to be drawn is described below.
C
C The program is coded in the ANSI X3.9-1978 Fortran77 standard language
C employing the ANSI X3.124-1985 GKS (Graphical Kernel System) level 2b
C subroutines.
C
C Version: 5.90
C Date: 2005, May 10
C
C Coded by Jana Konopaskova, 1993, September 25
C Revised by Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C Program PICTURES has originally been designed to be linked with the
C CALCOMP-GKS interface 'calcomp.for' and with GKS graphics library for
C a particular computer system.  However, the program is recently used
C with the CALCOMP-PostScript interface 'calcops.for' supplemented with
C simple interface 'gksps.for' from GKS to PostScript.  Note that
C 'gksps.for' contains just GKS routines called by program PICTURES and
C mostly exploits subroutines of 'calcops.for'.  Moreover, the current
C version of 'gksps.for' does not support most of GKS text attributes
C used by program PICTURES and should be finished and debugged in the
C future.
C
C calcomp.for
C calcops.for
C gksps.for
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     PICDAT='string'... Name of the input file to control plotting.
C             Description of file PICDAT
C             No default, obligatory parameter.
C Data specifying the form of the output file:
C     PICTURE='string'... String containing the name of the output
C             PostScript file with the plotted picture.
C             Default: PICTURE='picture.ps'
C     CALCOPS='string'... String with the PostScript instructions, see
C             file calcops.for.
C
C                                                  
C Data to control plotting 2-D projections of 3-D lines and points,
C including corresponding descriptive texts:
C     The control file is a sequence of four sets of formated records.
C     Each set can be repeated to change the projection or plotting
C     attributes for the subsequent lines or points.
C     The form of the sets is as follows:
C (1) Projection matrix:
C     The set of two records (1.1) and (1.2) determining the projection
C     matrix:
C     (1.1) 'PROJECTION'
C             The above string identifies this section.
C     (1.2) PM(1) PM(2) PM(3) PM(4) PM(5) PM(6) PM(7) PM(8) /
C             here PM(1) to PM(8) are real numbers determining
C             projection matrix, which transforms coordinates X1,X2,X3
C             to 2-D plot coordinates Y1,Y2:
C               Y1 = PM(1) + PM(3)*X1 + PM(5)*X2 + PM(7)*X3
C               Y2 = PM(2) + PM(4)*X1 + PM(6)*X2 + PM(8)*X3
C     Note: In future versions these line may be replaced by, e.g.,
C     (1.1) 'PROJECTION'
C     (1.2) C10,C11,C12,C13
C     (1.3) C20,C21,C22,C23
C            Transformation matrix from model coordinates X1,X2,X3 to
C            2-D plot coordinates C1,C2:
C              C1 = C10 + C11*X1 + C12*X2 + C13*X3
C              C2 = C20 + C21*X1 + C22*X2 + C23*X3
C (2) Graphic attributes:
C     The set of records determining the attributes for drawing (see
C     also the GKS documentation).  Only the first and the last records
C     are compulsory.
C     Each string represents the name of the attribute parameter.
C     The parameters not listed in the control data file take the
C     default values.
C     We use notation R1,R2,...for real constants and I1,I2,...for
C     integer constants: (attention: the slashes at the end of records
C     are important)
C     'ATTRIBUTES'
C             The above string identifies this section.
C     'INIT'         /  All attributes are inicialized to their defaults
C                       (subroutine DFLTAT).
C     'ILC'    I1    /  Determines whether the lines are to be drawn
C                       (0-no, 1-yes).
C                       Default: 1
C     'IPC'    I1    /  Determines whether the points are to be drawn
C                       (0-no, 1-yes).
C                       Default: 1
C     'ITC'    I1    /  Determines whether the texts are to be drawn:
C                       0: No texts are drawn.
C                       1: Texts describing points and texts describing
C                          lines with specified reference points are
C                          drawn.
C                       2: All texts except those describing empty lines
C                          without specified reference points are drawn.
C                       3: All texts are drawn.
C                       Default: 1
C     'LCOLI'  I1    /  Color index determining the color of lines .
C                       Default: 1
C     'PCOLI'  I1    /  Color index determining the color of points.
C                       Default: 1
C     'TCOLI'  I1    /  Color index determining the color of texts.
C                       Default: 1
C     'LTYPE'  I1    /  Determines linetype:
C                       1: solid,
C                       2: dashed,
C                       3: dotted,
C                       4: dashed-dotted line.
C                       Default: 1
C     'LWIDTH' R1    /  Relative linewidth scale factor.
C                       In PostScript (interface 'gksps.for'), thickness
C                       of lines in points (1/72 in).
C                       Default: 1.0
C     'MTYPE'  I1    /  Determines marker type:
C                       1: '.',
C                       2: '+',
C                       3: '*',
C                       4: 'o',
C                       5: 'x'.
C                       Default: 3
C     'MSZSF'  R1    /  Marker size scale factor.
C                       In PostScript (interface 'gksps.for'), marker
C                       size in dekapoints (1dpt=10in/72=3.537777mm).
C                       Default: 1.0
C     'CHH'    R1    /  Character height.
C                       In PostScript (interface 'gksps.for'), character
C                       height in dekapoints (1dpt=10in/72=3.537777mm).
C                       Default: 1.0
C     'CHXP'   R1    /  Character expansion factor.
C                       Default: 1.0
C     'CHSP'   R1    /  Character spacing.
C                       Default: 0.0
C     'CHUP'   R1 R2 /  Character up vector.
C                       Default: 0.0 1.0
C     'TXAL'   I1 I2 /  Text alignment.
C                       Horizontal: I1=0 ... normal
C                                   I1=1 ... left
C                                   I1=2 ... center
C                                   I1=3 ... right
C                       Vertical:   I2=0 ... normal
C                                   I2=1 ... top
C                                   I2=3 ... half
C                                   I2=5 ... bottom
C                       Default: 0   0
C     'FP'     I1 I2 /  Font and text precision:
C                       Text precision:
C                       0: string,
C                       1: char,
C                       2: stroke.
C                       Default font: 1
C                       Default text precision: 0
C     'TXP'    I1    /  Determines text path.
C                       Default: 0
C     /                 List of attributes must be terminated by a
C                       slash.
C (3) Instruction to plot lines:
C     According to the attributes currently set, whole lines, points of
C     lines or texts at the reference pints of lines may be drawn.
C     Records (3.1) and (3.2) determine the lines to be drawn:
C     (3.1) 'LINES'
C             The above string identifies this section.
C     (3.2) 'NFILE'
C             'NFILE'... Name of the input data file containing 3-D
C             lines to be plotted according to the attributes currently
C             set.
C             If 'NFILE'=' ' or is replaced by a slash, the data
C             describing the lines are included immediately after line
C             (3.2).
C             The data representing lines should have form
C             LINES (or briefly LIN).
C             Default: 'NFILE'=' '.
C (4) Instruction to plot points:
C     According to the attributes currently set, points or texts
C     describing the points may be drawn.
C     Records (4.1) and (4.2) determine the points to be drawn:
C     (4.1) 'POINTS'
C             The above string identifies this section.
C     (4.2) 'NFILE'
C             'NFILE'... Name of the input data file containing 3-D
C             points to be plotted according to the attributes currently
C             set.
C             If 'NFILE'=' ' or is replaced by a slash, the data
C             describing the points are included immediately after line
C             (4.2).
C             The data representing points should have form
C             POINTS (or briefly PTS).
C             Default: 'NFILE'=' '.
C
C.......................................................................
C
C This file contains following routines:
C     Program PICTURES
C     Subroutine PAINT
C     Subroutine SCAN
C     Subroutine ATTRIB
C     Subroutine DFLTAT
C     Except above routines, program PICTURES requires CALCOMP plotting
C     routines and GKS (Graphical Kernel System) subroutines.
C     GKS must be installed before the program PICTURES can be
C     executed.
C
C=======================================================================
C                                                
C Program PICTURES to draw texts and 2-D projection of 3-D points and
C lines.
C
C-----------------------------------------------------------------------
      EXTERNAL ERROR,RSEP1,RSEP3T,PLOTN,PLOTS,PLOT,PAINT,SCAN
C-----------------------------------------------------------------------
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
C
C     Allocation of working arrays:
      INTEGER LDIM,NDIM,MDIM
      PARAMETER (LDIM=MRAM/6,NDIM=MRAM/6,MDIM=MRAM/6)
      REAL LX(LDIM), LY(LDIM), PX(NDIM), PY(NDIM)
      INTEGER ICOL(MDIM)
      REAL WDTH(MDIM)
      EQUIVALENCE (LX  ,RAM(                   1))
      EQUIVALENCE (LY  ,RAM(  LDIM+            1))
      EQUIVALENCE (PX  ,RAM(2*LDIM+            1))
      EQUIVALENCE (PY  ,RAM(2*LDIM+  NDIM+     1))
      EQUIVALENCE (ICOL,RAM(2*LDIM+2*NDIM+     1))
      EQUIVALENCE (WDTH,RAM(2*LDIM+2*NDIM+MDIM+1))
C
      CHARACTER INDATA*80,FSEP*80,FILPS*80
C
C     Auxiliary storage location:
      INTEGER LU1,NUM,IERR,I
      PARAMETER (LU1=1)
C-----------------------------------------------------------------------
C
C     Reading main input data:
      WRITE(*,'(A)') '+PICTURES: Enter input filename: '
      FSEP=' '
      READ (*,*) FSEP
      IF(FSEP.EQ.' ') THEN
C       PICTURES-01
        CALL ERROR('PICTURES-01: No input file specified')
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.
      END IF
      WRITE(*,'(A)') '+PICTURES: Working...            '
C
C     Reading input and output filenames:
      CALL RSEP1(LU1,FSEP)
      CALL RSEP3T('PICDAT',INDATA,' ')
      IF(INDATA.EQ.' ') THEN
C       PICTURES-02
        CALL ERROR('PICTURES-02: No input file specified')
C       Input file with the description of the picture must be specified
C       by parameter PICDAT.
C       There is no default filename.
      END IF
      CALL RSEP3T('PICTURE',FILPS,'picture.ps')
C
      CALL SCAN (INDATA,ICOL,WDTH,MDIM,NUM,IERR)
      IF(IERR.NE.0) THEN
        IF(IERR.EQ.-1) THEN
          WRITE (*,240) INDATA
          GO TO 100
        END IF
        IF (IERR.EQ.-2) WRITE (*,250) INDATA
        IF (IERR.EQ.-4) WRITE (*,260)
        IF (IERR.EQ.-5) WRITE (*,270)
        GO TO 100
      END IF
C     Initializing the GKS to CALCOMP interface:
      CALL GOPKS(0,0)
C     Initializing the CALCOMP to PostScript interface:
      CALL PLOTN(FILPS,0)
      CALL PLOTS(0,0,0)
      DO 40 I=1,NUM
        CALL PAINT(INDATA,ICOL(I),WDTH(I),PX,PY,NDIM,LX,LY,LDIM,IERR)
        IF (IERR.NE.0) THEN
          IF (IERR.EQ.-1 .OR. IERR.EQ.-2) WRITE(*,275)
          IF (IERR.EQ.-3) WRITE(*,280)
          IF (IERR.EQ.-4) WRITE(*,260)
          IF (IERR.GT.0) WRITE (*,285)
          GO TO 100
        END IF
   40 CONTINUE
      CALL PLOT (0.,0.,999)
      WRITE(*,'(A)') '+PICTURES: Done.                 '
  100 STOP
C
  230 FORMAT(/' A reading error occurred, try again.')
  240 FORMAT(/' *****************************************',
     +       /' * The file ',A12,     ' cannot be found.*'
     +       /' *****************************************')
  250 FORMAT(/' ********************************************************
     +'      /' * An error occurred when reading the file ',     A12,'.*
     +'      /' * Maybe the syntax of that file is wrong.              *
     +'    /' ********************************************************')
  260 FORMAT(/' *****************************************************'
     +       /' * An error occurred during reading the objects that *'
     +       /' * should be drawn. Maybe the syntax of the file     *'
     +       /' * containing that objects is wrong.                 *'
     +       /' *****************************************************')
  270 FORMAT(/' *****************************************************'
     +       /' * The dimension of some arrays in the program       *'
     +       /' * PICTURES is not sufficient. It is necessarry      *'
     +       /' * to increase the dimension of the arrays ICOL and  *'
     +       /' * WDTH to a certain value and to assign the same    *'
     +       /' * value to the variable MDIM (see the source code   *'
     +       /' * pictures.for)                                     *'
     +       /' *****************************************************')
  275 FORMAT(/' A problem occurred while accessing the file containing'
     +       /' control data. Maybe your disk is not all right.')
  280 FORMAT(/' ***********************************************'
     +       /' * The file containing the objects that should *'
     +       /' * be drawn cannot be found.                   *'
     +       /' ***********************************************')
  285 FORMAT(/' ********************************************************
     +'      /' * Some objects or their partitions could not be drawn  *
     +'      /' * because of insufficient dimension of some arrays in  *
     +'      /' * the program PICTURES. It is necessarry to increase   *
     +'      /' * the dimension of the arrays LX,LY (resp. PX,PY) to   *
     +'      /' * a certain value and to assign the same value to the  *
     +'      /' * variable LDIM (resp. NDIM) (see the source code      *
     +'      /' * pictures.for                                         *
     +'    /' ********************************************************')
C
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE PAINT (INDATA,ICOLOR,WIDTH,PX,PY,NDIM,LX,LY,LDIM,IERR)
C
C Subroutine PAINT is designed to draw texts and 2-D projections of 3-D
C points and lines.
C
C Input:
C     INDATA..The name of the file containing control data.
C             (character*12)
C     ICOLOR..Color index.  Only objects with color index equal to
C             ICOLOR will be drawn. (integer)
C     WIDTH...Linewidth.  Only lines with linewidth equal to WIDTH will
C             be drawn. (real)
C     NDIM... Dimension of auxiliary arrays PX, PY (integer)
C     LDIM... Dimension of auxiliary arrays LX, LY (integer)
C
C Output:
C     IERR... Error parameter (integer)
C             IERR=0:  No errors occurred
C             IERR=-1: It was not possible to open the file indata
C             IERR=-2: An error occurred while reading the file
C                      containing control data.
C             IERR=-3: It was not possible to open the file containing
C                      data that should be drawn.
C             IERR=-4: An error occurred while reading the file
C                      containing data that should be drawn.
C             IERR.GT.0: Insufficient either the dimension ndim or the
C                      dimension LDIM.  Some objects or their parts
C                      cannot be drawn.
C Auxiliary arrays:
C     PX,PY...Arrays used for the storage of the projection of points.
C             These arrays are used only when points are stored in the
C             file containing lines. (real)
C     LX,LY...Arrays used for the storage of the projection of points
C             determining a line or for the storage of the projection
C             of points. (real)
C
C Parameters in common block /DEFLT/:
C     These parameters are inicialized at the beginning of subroutine
C     paint through subroutine dfltat.  All parameters in common block
C     except LUIN, LUDATA and EPS can be changed by the help of the file
C     containing control data.
C     PM...   Array containing the projection matrix. (real)
C     LUIN... Logical unit specifier used for the access to control
C             data. (integer)
C     LUDAT...Logical unit specifier used for the access to the data to
C             be drawn. (integer)
C     ITC,IPC,ILC... Determine whether it is required to draw texts,
C             points and lines, respectively (0 - drawing is not
C             required, positive - drawing is required). (integer)
C     TCOLI,PCOLI,LCOLI...Color indices determining the color of texts,
C             points and lines, respectively (for details see the
C             documentation to the graphics system GKS). (integer)
C     LWIDTH..Relative linewidth (real)
C     EPS...  A little real number.  Lines will be drawn when
C             ABS(LWIDTH-WIDTH) is less than EPS.
C
C Subroutines required: DFLTAT, ATTRIB, GKS subroutines
C
C GKS requirements:
C     GKS must be installed and workstation(s) prepared
C     (see the documentation to GKS) so that immediate calling of GKS
C     output functions is possible.
C
C-----------------------------------------------------------------------
C
      LOGICAL PR,AT,PO,LI
      CHARACTER INDATA*12,NFILE*12,CNTR*2,W,ST*80
      INTEGER TCOLI,LCOLI,PCOLI,IERR,LUIN,LU,LUDAT,IT,IP,IL,ITC,IPC,ILC,
     *  ICOLOR,IND,INDP,INDL,LDIM,NDIM,I,N
      REAL LWIDTH,PM(8),LX(*),LY(*),PX(*),PY(*),RMAX,RC,DIF,WIDTH,EPS,
     *  X1,X2,X3,Y1,Y2,Y3,P1,P2
      COMMON/DEFLT/ PM,LUIN,LUDAT,ITC,IPC,ILC,TCOLI,PCOLI,LCOLI,LWIDTH,
     +              EPS
C
C-----------------------------------------------------------------------
C
      IERR=0
      RMAX=3.402823E+38
      RC=3.40282E+38
      CALL DFLTAT(-1)
C     ------------------------------------------------------------------
      OPEN (LUIN,ERR=190,FILE=INDATA,STATUS='OLD')
    1 CNTR='@@'
      READ (LUIN,*,END=200,ERR=180) CNTR
      IF (CNTR.EQ.'@@') GO TO 200
      PR=CNTR.EQ.'PR' .OR. CNTR.EQ.'pr'
      AT=CNTR.EQ.'AT' .OR. CNTR.EQ.'at'
      PO=CNTR.EQ.'PO' .OR. CNTR.EQ.'po'
      LI=CNTR.EQ.'LI' .OR. CNTR.EQ.'li'
      IF(.NOT.PR .AND. .NOT.AT .AND. .NOT.PO .AND. .NOT.LI) GO TO 180
C     ------------------------------------------------------------------
      IF(PR) READ (LUIN,*,ERR=180)PM
C     ------------------------------------------------------------------
      IF(AT) THEN
          CALL ATTRIB(1,IERR)
          IF (IERR.EQ.-1) GO TO 180
      END IF
C     ------------------------------------------------------------------
      IF (PO.OR.LI) THEN
          IT=0
          IP=0
          IL=0
          IF(ITC.GE.1 .AND. TCOLI.EQ.ICOLOR) IT=ITC
          IF(IPC.GE.1 .AND. PCOLI.EQ.ICOLOR) IP=1
          DIF=ABS(LWIDTH-WIDTH)
          IF(ILC.EQ.1 .AND. LCOLI.EQ.ICOLOR .AND. DIF.LT.EPS) IL=1
          NFILE='EMPTY       '
          READ (LUIN,*,ERR=180) NFILE
          LU=LUIN
          IF (NFILE.NE.'EMPTY       ')THEN
              IF(IT.EQ.0 .AND. IP.EQ.0 .AND. IL.EQ.0) GO TO 1
              OPEN (LUDAT,ERR=170,FILE=NFILE,STATUS='OLD')
              LU=LUDAT
          END IF
   10     W='@'
          READ(LU,*,ERR=195) W
          IF(W.NE.'@') GO TO 10
      END IF
C     ------------------------------------------------------------------
      IF (PO) THEN
        IND=0
   20   CONTINUE
          X1=0.
          X2=0.
          X3=0.
          ST='$'
          READ(LU,*,END=50,ERR=195) ST,X1,X2,X3
          IF (ST.EQ.'$') THEN
            GO TO 50
          END IF
          IF (IND.EQ.LDIM) THEN
            IERR=IERR+1
   25       CONTINUE
              ST='$'
              READ (LU,*,END=50,ERR=195) ST,X1,X2,X3
              IF (ST.EQ.'$') THEN
                GO TO 50
              END IF
            GO TO 25
          END IF
          IND=IND+1
          LX(IND)=PM(1)+PM(3)*X1+PM(5)*X2+PM(7)*X3
          LY(IND)=PM(2)+PM(4)*X1+PM(6)*X2+PM(8)*X3
          IF (IT.GE.1) THEN
              N=80
              DO 30 I=80,2,-1
                  IF(ST(I:I).NE.' ') GO TO 40
                  N=N-1
   30         CONTINUE
   40         CALL GTX (LX(IND),LY(IND),ST(1:N))
          END IF
        GO TO 20
   50   IF (IP.EQ.1) CALL GPM(IND,LX,LY)
        IF (LU.NE.LUIN) REWIND(LU)
      END IF
C     ------------------------------------------------------------------
      IF (LI) THEN
          INDP=0
   70     INDL=2
          Y1=RMAX
          Y2=0.
          Y3=0.
          ST='$'
          READ(LU,*,END=1,ERR=195) ST,Y1,Y2,Y3
          IF (ST.EQ.'$')THEN
              IF (IP.EQ.1 .AND. INDP.GT.0) CALL GPM (INDP,PX,PY)
              IF (LU.NE.LUIN) REWIND(LU)
              GO TO 1
          END IF
C
          X1=RMAX
          X2=0.
          X3=0.
          READ (LU,*,END=70,ERR=195) X1,X2,X3
          IF (IT.GE.1) THEN
              N=80
              DO 75 I=80,2,-1
                  IF (ST(I:I).NE.' ') GO TO 78
                  N=N-1
   75         CONTINUE
   78         CONTINUE
              IF (Y1.LE.RC) THEN
                P1=PM(1)+PM(3)*Y1+PM(5)*Y2+PM(7)*Y3
                P2=PM(2)+PM(4)*Y1+PM(6)*Y2+PM(8)*Y3
                CALL GTX (P1,P2,ST(1:N))
              ELSE IF (X1.LE.RC.AND.IT.GE.2) THEN
                P1=PM(1)+PM(3)*X1+PM(5)*X2+PM(7)*X3
                P2=PM(2)+PM(4)*X1+PM(6)*X2+PM(8)*X3
                CALL GTX (P1,P2,ST(1:N))
              ELSE IF (IT.GE.3) THEN
                P1=PM(1)
                P2=PM(2)
                CALL GTX (P1,P2,ST(1:N))
              END IF
          END IF
          IF (X1.GT.RC) GO TO 70
C
          Y1=RMAX
          Y2=0.
          Y3=0.
          READ (LU,*,END=70,ERR=195) Y1,Y2,Y3
          IF (Y1.GT.RC) THEN
              IF (INDP.LT.NDIM) THEN
                  INDP=INDP+1
                  PX(INDP)=PM(1)+PM(3)*X1+PM(5)*X2+PM(7)*X3
                  PY(INDP)=PM(2)+PM(4)*X1+PM(6)*X2+PM(8)*X3
              ELSE
                  IERR=IERR+1
              END IF
              GO TO 70
          END IF
          LX(1)=PM(1)+PM(3)*X1+PM(5)*X2+PM(7)*X3
          LY(1)=PM(2)+PM(4)*X1+PM(6)*X2+PM(8)*X3
          LX(2)=PM(1)+PM(3)*Y1+PM(5)*Y2+PM(7)*Y3
          LY(2)=PM(2)+PM(4)*Y1+PM(6)*Y2+PM(8)*Y3
   80     CONTINUE
            X1=RMAX
            X2=0.
            X3=0.
            READ(LU,*,END=70,ERR=195) X1,X2,X3
            IF (X1.GT.RC) THEN
                IF(IL.EQ.1) CALL GPL(INDL,LX,LY)
                GO TO 70
            END IF
            IF (INDL.EQ.LDIM) THEN
                IERR=IERR+1
   90           X1=RMAX
                READ(LU,*,END=70,ERR=195) X1,X2,X3
                IF (X1.LE.RC) GO TO 90
                IF (IL.EQ.1) CALL GPL(INDL,LX,LY)
                GO TO 70
            END IF
            INDL=INDL+1
            LX(INDL)=PM(1)+PM(3)*X1+PM(5)*X2+PM(7)*X3
            LY(INDL)=PM(2)+PM(4)*X1+PM(6)*X2+PM(8)*X3
          GO TO 80
      END IF
C     ------------------------------------------------------------------
      GO TO 1
  170 IERR=-3
      GO TO 200
  180 IERR=-2
      GO TO 200
  190 IERR=-1
      RETURN
  195 IERR=-4
  200 REWIND(LUIN)
      RETURN
C
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE SCAN (INDATA,ICOL,WDTH,NDIM,NUM,IERR)
C
C Subroutine SCAN is designed to look over the file containing control
C data for drawing 2-D projection of 3-D points and lines and to
C determine which colors and linewidths are required for drawing the
C data.
C
C Input:
C     INDATA..The name of the file containing control data
C             (character*12)
C     NDIM... Dimension of output arrays ICOL and WDTH (integer)
C
C Output:
C     ICOL... Array containing color indexes representing colors
C             required for drawing the data (integer)
C     WDTH... Array containing linewidths.  A linewidth in any array
C             element WDTH(I) corresponds to color index ICOL(I).  It is
C             possible to have WDTH(I) less than zero.  In such case the
C             linewidth corresponding to color index ICOL(I) is
C             arbitrary. (real)
C     NUM...  The number of color indexes (resp. linewidths) stored in
C             array ICOL (resp. WDTH) (integer)
C     IERR... Error indicator (integer)
C             IERR=0:  No errors occurred
C             IERR=-1: It was not possible to open the file indata
C             IERR=-2: An error occurred while reading the file
C                      containing control data.
C             IERR=-4: An error occurred while reading the file
C                      containing data that should be drawn.
C             IERR=-5: The dimension NDIM of the arrays ICOL and WDTH is
C                      not sufficiet.
C
C Parameters in common block /DEFLT/:
C     These parameters are inicialized at the beginning of subroutine
C     scan through subroutine DFLTAT.  All parameters in common block
C     except LUIN, LUDATA and EPS can be changed by the help of the file
C     containing control data.
C     PM...   Array containing the projection matrix.
C     LUIN... Logical unit specifier used for the access to control
C             data. (integer)
C     LUDAT.. Logical unit specifier used for the access to the data to
C             be drawn. (integer)
C     ITC,IPC,ILC... Determine whether it is required to draw texts,
C             points and lines, respectively (0 - drawing is not
C             required, positive - drawing is required). (integer)
C     TCOLI,PCOLI,LCOLI...Color indexes determining the color of texts,
C             points and lines respectively (for details see the
C             documentation to the graphics system GKS). (integer)
C     LWIDTH..Linewidth (real)
C     EPS...  A little real number.  Lines will be drawn when
C             ABS(LWIDTH-WIDTH) is less than EPS.
C
C Subroutines required: DFLTAT, ATTRIB
C
C-----------------------------------------------------------------------
C
      INTEGER TCOLI,LCOLI,PCOLI,ICOL(*),IERR,NUM,LUIN,LUDAT,ILC,IPC,ITC,
     *  I,NDIM
      REAL LWIDTH,PM(8),WDTH(*),RMAX,RC,X1,X2,X3,EPS
      CHARACTER INDATA*12,NFILE*12,CNTR*2,W
      LOGICAL PR,AT,PO,LI
      COMMON/DEFLT/ PM,LUIN,LUDAT,ITC,IPC,ILC,TCOLI,PCOLI,LCOLI,LWIDTH,
     +              EPS
C
C-----------------------------------------------------------------------
C
      IERR=0
      RMAX=3.402823E+38
      RC=3.40282E+38
      CALL DFLTAT(-2)
      NUM=0
C     ------------------------------------------------------------------
      OPEN (LUIN,ERR=170,FILE=INDATA,STATUS='OLD')
   10 CNTR='@@'
      READ (LUIN,*,END=200,ERR=180) CNTR
      IF (CNTR.EQ.'@@') GO TO 200
      PR=CNTR.EQ.'PR' .OR. CNTR.EQ.'pr'
      AT=CNTR.EQ.'AT' .OR. CNTR.EQ.'at'
      PO=CNTR.EQ.'PO' .OR. CNTR.EQ.'po'
      LI=CNTR.EQ.'LI' .OR. CNTR.EQ.'li'
      IF (.NOT.PR .AND. .NOT.AT .AND. .NOT.PO .AND. .NOT.LI) GO TO 180
C     ------------------------------------------------------------------
      IF (PR) READ (LUIN,*,ERR=180) PM
C     ------------------------------------------------------------------
      IF(AT) THEN
          CALL ATTRIB(0,IERR)
          IF (IERR.EQ.-1) GO TO 180
      END IF
C     ------------------------------------------------------------------
      IF (PO.OR.LI) THEN
          NFILE='EMPTY       '
          READ (LUIN,*,ERR=180) NFILE
          IF (NFILE.EQ.'EMPTY       ') THEN
   30         W='@'
              READ (LUIN,*,ERR=185) W
              IF (W.NE.'@') GO TO 30
          END IF
          IF (ITC.EQ.0) GO TO 60
          IF (NUM.EQ.0) GO TO 50
          DO 40 I=1,NUM
              IF (ICOL(I).EQ.TCOLI) GO TO 60
   40     CONTINUE
   50     NUM=NUM+1
          IF (NUM.GT.NDIM) GO TO 190
          ICOL(NUM)=TCOLI
          WDTH(NUM)=-1.0
   60     CONTINUE
          IF (IPC.EQ.0) GO TO 90
          IF (NUM.EQ.0) GO TO 80
          DO 70 I=1,NUM
              IF (ICOL(I).EQ.PCOLI) GO TO 90
   70     CONTINUE
   80     NUM=NUM+1
          IF (NUM.GT.NDIM) GO TO 190
          ICOL(NUM)=PCOLI
          WDTH(NUM)=-1.0
   90     CONTINUE
      END IF
C     ------------------------------------------------------------------
      IF (PO .AND. NFILE.EQ.'EMPTY       ') THEN
  100     X1=RMAX
          READ (LUIN,*,END=100,ERR=185) W,X1,X2,X3
          IF (X1.LE.RC) GO TO 100
      END IF
C     ------------------------------------------------------------------
      IF (LI) THEN
          IF (ILC.EQ.0) GO TO 130
          IF (NUM.EQ.0) GO TO 120
          DO 110 I=1,NUM
              IF (ICOL(I).EQ.LCOLI) THEN
                  IF (ABS(WDTH(I)-LWIDTH).LT.EPS)GO TO 130
                  IF (WDTH(I).GE.0.0) GO TO 110
                  WDTH(I)=LWIDTH
                  GO TO 130
              END IF
  110     CONTINUE
  120     NUM=NUM+1
          IF (NUM.GT.NDIM) GO TO 190
          ICOL(NUM)=LCOLI
          WDTH(NUM)=LWIDTH
  130     CONTINUE
          IF (NFILE.EQ.'EMPTY       ') THEN
  140         X1=RMAX
              X2=0.
              X3=0.
              READ (LUIN,*,END=10,ERR=185) W,X1,X2,X3
              IF (X1.GT.RC) GO TO 10
  150         X1=RMAX
              READ (LUIN,*,END=140,ERR=185) X1,X2,X3
              IF (X1.GT.RC) GO TO 140
              GO TO 150
          END IF
      END IF
C     ------------------------------------------------------------------
      GO TO 10
  170 IERR=-1
      RETURN
  180 IERR=-2
      GO TO 200
  185 IERR=-4
      GO TO 200
  190 IERR=-5
  200 REWIND (LUIN)
      RETURN
C
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE ATTRIB (ICONTR,IERR)
C
C Subroutine ATTRIB is designed to read some attributes from the
C file containing control data for drawing 2-D projections of 3-D
C points and lines and to set up GKS according to the attributes.
C
C Input:
C     ICONTR..Control parameter (integer)
C             ICONTR=0: Attributes are red but GKS is not set up
C                       according to them.
C             ICONTR=1: Attributes are read and GKS is set up.
C
C Output:
C     IERR... Error parameter (integer)
C             IERR=0:  No errors occurred.
C             IERR=-1: Error occurred while reading the file containing
C                      control data.
C
C Subroutines required:
C     subroutine DFLTAT
C     subroutines of GKS
C
C-----------------------------------------------------------------------
C
      INTEGER TCOLI,PCOLI,IPAR1,IPAR2,ICONTR,IERR,
     *  LUIN,LUDAT,ILC,IPC,ITC,LCOLI
      REAL LWIDTH,PM(8),PAR1,PAR2,EPS
      CHARACTER AT*6
      COMMON/DEFLT/ PM,LUIN,LUDAT,ITC,IPC,ILC,TCOLI,PCOLI,LCOLI,LWIDTH,
     +              EPS
C
C-----------------------------------------------------------------------
C
   10 AT='@@@@@@'
      PAR2=0.0
      READ (LUIN,*,ERR=30)AT,PAR1,PAR2
      IF(AT.EQ.'@@@@@@') GO TO 50
      IPAR1=NINT(PAR1)
      IPAR2=NINT(PAR2)
      IF (ICONTR.EQ.0) GO TO 20
      IF (AT.EQ.'CHH   ' .OR. AT.EQ.'chh   ') CALL GSCHH(PAR1)
      IF (AT.EQ.'CHXP  ' .OR. AT.EQ.'chxp  ') CALL GSCHXP(PAR1)
      IF (AT.EQ.'CHSP  ' .OR. AT.EQ.'chsp  ') CALL GSCHSP(PAR1)
      IF (AT.EQ.'CHUP  ' .OR. AT.EQ.'chup  ') CALL GSCHUP(PAR1,PAR2)
      IF (AT.EQ.'TXAL  ' .OR. AT.EQ.'txal  ') CALL GSTXAL(IPAR1,IPAR2)
      IF (AT.EQ.'FP    ' .OR. AT.EQ.'fp    ') CALL GSTXFP(IPAR1,IPAR2)
      IF (AT.EQ.'TXP   ' .OR. AT.EQ.'txp   ') CALL GSTXP(IPAR1)
      IF (AT.EQ.'LTYPE ' .OR. AT.EQ.'ltype ') CALL GSLN(IPAR1)
      IF (AT.EQ.'MTYPE ' .OR. AT.EQ.'mtype ') CALL GSMK(IPAR1)
      IF (AT.EQ.'MSZSF ' .OR. AT.EQ.'mszsf ') CALL GSMKSC(PAR1)
   20 IF (AT.EQ.'ITC   ' .OR. AT.EQ.'itc   ') ITC=IPAR1
      IF (AT.EQ.'IPC   ' .OR. AT.EQ.'ipc   ') IPC=IPAR1
      IF (AT.EQ.'ILC   ' .OR. AT.EQ.'ilc   ') ILC=IPAR1
      IF (AT.EQ.'INIT  ' .OR. AT.EQ.'init  ') CALL DFLTAT(ICONTR)
      IF (AT.EQ.'TCOLI ' .OR. AT.EQ.'tcoli ') THEN
          IF (ICONTR.NE.0) CALL GSTXCI(IPAR1)
          TCOLI=IPAR1
      END IF
      IF (AT.EQ.'LWIDTH' .OR. AT.EQ.'lwidth') THEN
          IF (ICONTR.NE.0) CALL GSLWSC(PAR1)
          LWIDTH=PAR1
      END IF
      IF (AT.EQ.'LCOLI ' .OR. AT.EQ.'lcoli ') THEN
          IF (ICONTR.NE.0) CALL GSPLCI(IPAR1)
          LCOLI=IPAR1
      END IF
      IF (AT.EQ.'PCOLI ' .OR. AT.EQ.'pcoli ') THEN
          IF (ICONTR.NE.0) CALL GSPMCI(IPAR1)
          PCOLI=IPAR1
      END IF
      GO TO 10
C     ------------------------------------------------------------------
   30 IERR=-1
   50 RETURN
C
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE DFLTAT(ICONTR)
C
C Subroutine DFLTAT is designed to initialize some parameters.
C This subroutine serves to subroutines PAINT and SCAN.
C
C Input:
C     ICONTR...Control parameter (integer)
C             ICONTR=0:  Only the parameters TCOLI,LWIDTH LCOLI,PCOLI,
C                        ITC,IPC,ILC are initialized
C             ICONTR=-2: As ICONTR=0 but in addition LUIN,LUDAT,EPS
C                        and projection matrix PM are initialized
C             ICONTR=-1: As ICONTR=-2 but in addition GKS is set up
C                        according to initial attributes
C             ICONTR=1:  As ICONTR=0 but in addition GKS is set up
C                        according to initial attributes
C
C     Subroutines required: Subroutines of system GKS
C
C-----------------------------------------------------------------------
C
      INTEGER TXALH,TXALV,TCOLI,FONT,PREC,TXP,PCOLI,ICONTR,LTYPE,MTYPE,
     *  LUIN,LUDAT,ILC,IPC,ITC,LCOLI
      REAL LWIDTH,MSZSF,PM(8),EPS,CHH,CHXP,CHSP,CHUX,CHUY
      COMMON/DEFLT/ PM,LUIN,LUDAT,ITC,IPC,ILC,TCOLI,PCOLI,LCOLI,LWIDTH,
     +              EPS
C
C-----------------------------------------------------------------------
C
      IF (ICONTR.NE.-1 .AND. ICONTR.NE.-2) GO TO 5
      PM(1)=0.0
      PM(2)=0.0
      PM(3)=1.0
      PM(4)=0.0
      PM(5)=0.0
      PM(6)=1.0
      PM(7)=0.0
      PM(8)=0.0
      LUIN=1
      LUDAT=2
      EPS=0.001
    5 TCOLI=1
      LWIDTH=1.0
      LCOLI=1
      PCOLI=1
      ITC=1
      IPC=1
      ILC=1
      IF (ICONTR.EQ.0 .OR. ICONTR.EQ.-2) GO TO 10
      CHH=1.0
      CHXP=1.0
      CHSP=0.0
      CHUX=0.0
      CHUY=1.0
      TXALH=0
      TXALV=0
      FONT=1
      PREC=0
      TXP=0
      LTYPE=1
      MTYPE=3
      MSZSF=1.0
      CALL GSCHH(CHH)
      CALL GSCHXP(CHXP)
      CALL GSCHSP(CHSP)
      CALL GSCHUP(CHUX,CHUY)
      CALL GSTXAL(TXALH,TXALV)
      CALL GSTXCI(TCOLI)
      CALL GSTXFP(FONT,PREC)
      CALL GSTXP(TXP)
      CALL GSLN(LTYPE)
      CALL GSLWSC(LWIDTH)
      CALL GSPLCI(LCOLI)
      CALL GSMK(MTYPE)
      CALL GSMKSC(MSZSF)
      CALL GSPMCI(PCOLI)
   10 RETURN
C
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'length.for'
C     length.for
      INCLUDE 'calcops.for'
C     calcops.for
      INCLUDE 'gksps.for'
C     gksps.for
C
C=======================================================================
C