C 
C Program SRFWRL to convert triangulated or polygonated surfaces into
C the Virtual Reality Modeling Language or GOCAD representation
C
C Version: 5.60
C Date: 2002, May 17
C
C Coded by: Ludek Klimes & Vaclav Bucha
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mails: klimes@seis.karlov.mff.cuni.cz
C              bucha@seis.karlov.mff.cuni.cz
C
C References:
C     
C     VRML (Virtual Reality Modeling Language) version 1.0C
C     
C     VRML97 (Virtual Reality Modeling Language ISO/IEC 14772)
C     
C     GOCAD
C     
C     Persistence of Vision scene description language, version 3.1
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 or
C             polygons.  Triangles are recommended (and obligatory if
C             VRML='GOCAD').
C             Description of file TRGL
C             Default: TRGL='trgl.out'
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'
C Input/output file:
C     WRL='string'... Name of the file to be supplemented with surfaces
C             or to be copied to the beginning of the output file.
C             If the filename is blank, output file starts from a
C             scratch (mostly not reasonable).
C             The default name of the output file is equal to WRL.
C             It is recommended to specify WRL rather than to use
C             the default name.
C             Default: WRL='out.wrl'
C     WRLOUT='string'... Name of the output file if different from WRL.
C             Default: WRLOUT=WRL
C Data specifying the form of the output file:
C     VRML='string'... Virtual reality scene description language.
C             VRML='VRML1': VRML (Virtual Reality Modeling Language)
C                           version 1.0.
C             VRML='VRML2': VRML97 according to ISO/IEC 14772 standard.
C             VRML='GOCAD': GOCAD description of surfaces (TSurf).
C             VRML='POV':   POV (Persistence Of Vision) scene
C                           description language, version 3.1.
C                           This option has not been used and is thus
C                           poorly debugged.
C             Default: VRML='VRML2' (recommended if not using GOCAD)
C     NAME='string'... String containing the GOCAD name of the surface.
C             Be sure to select different names for all objects within
C             the GOCAD file.
C             The same name is used for the corresponding colour scale,
C             written if KOLSRF is positive.
C             Used only if VRML='GOCAD'.  Obligatory parameter, must be
C             specified and cannot be blank if VRML='GOCAD'.
C Data specifying the values to be scaled in colours:
C     KOLSRF=integer... If zero, all surfaces will have the same colour
C             given by parameters R, G, B.  If positive, the values in
C             KOLSRF-th column of input file VRTX will be colour-coded
C             at each vertex of each triangle or polygon of the surface.
C             If VRML.NE.'GOCAD', this setting may be modified by
C             parameters KOLPOS and KOLNEG.
C             If both KOLPOS and KOLNEG are specified, KOLSRF is used
C             only if VRML='GOCAD'.
C             Default: KOLSRF=7
C     KOLPOS=integer... Analogous to KOLSRF, but applies just to the
C             positive side of the the surface.
C             Not used if VRML='GOCAD'.
C             Default: KOLPOS=KOLSRF
C     KOLNEG=integer... Analogous to KOLSRF, but applies just to the
C             negative side of the the surface.
C             Not used if VRML='GOCAD'.
C             Default: KOLNEG=KOLSRF
C     PROPERTIES='string'... String containing names of properties
C             corresponding to values Z1,Z2,Z3,V1,...,VN (see file
C             VRTX) which may be used to control the
C             colour of the surface.  The names are separated by blanks.
C             If the number of names is smaller than the number of
C             values, the leftmost values are considered.  PROPERTIES
C             must be specified if VRML='GOCAD' and KOLSRF is positive.
C             If KOLSRF is 1, 2 or 3, the last name is assumed to denote
C             the KOLSRFth coordinate rather than the quantity in the
C             corresponding column, and the value of the coordinate
C             copied into that column.
C             If PROPERTIES=' ', no values are considered and GOCAD atom
C             VRTX is used for the vertices (otherwise, GOCAD atom PVRTX
C             is used).
C             Used only if VRML='GOCAD'.
C             Default: PROPERTIES=' '
C Data specifying the colour scale:
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     R=real, G=real, B=real... Float numbers between 0 and 1 specifying
C             the colour of the surfaces if KOLSRF=0 or KOLPOS=0 or
C             KOLNEG=0.
C             Defaults: R=1, G=1, B=1 (white)
C     TRANSP=real... Transparency of the surfaces (sometimes called
C             transmit).  Values from 0 to 1.
C             Default: TRANSP=0.
C     AMBIENT=real... Float number between 0 and 1 specifying the
C             intensity of the ambient light.  The colour of the ambient
C             light is assumed white.  Applied to the surfaces only if
C             VRML='vrml1'.  Otherwise, the ambient light source of
C             intensity AMBIENT is prescribed by program
C             iniwrl.for.
C             Not used if VRML='GOCAD'.
C             Default:  AMBIENT=0.20 (default for VRML materials)
C     SPECULAR=real... Intensity of the specular reflections from
C             glossy surfaces.  Values from 0 to 1.
C             Not used if VRML='GOCAD'.
C             Default: SPECULAR=0 (default for VRML materials)
C     SHININESS=real... Shininess of the surfaces (sometimes called
C             transmit).  Values from 0 to 1.
C             Not used if VRML='GOCAD'.
C             Default: SHININESS=0.20 (default for VRML materials)
C Optional parameters specifying the form of the real quantities
C written in the output formatted files:
C     MINDIG,MAXDIG=positive integers ... See the description in file
C             forms.for.
C
C                                                    
C Input file VRTX with the vertices:
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,V1,...,VN/
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 surface at the vertex.  The normals are
C             used for shading of the surface if VRML='VRML1' or
C             VRML='VRML2'.  If at least one normal is zero, shading
C             corresponds  to flat triangles or polygons.
C             Normals are transmitted to the GOCAD file if VRML='GOCAD'
C             and parameter PROPERTIES is specified, but do not
C             influence the surface appearance.
C     V1,...,VN...Optional values which may be used to control the
C             colour of the surface.
C     /...    None to several values terminated by a slash.
C (3) / or end of file.
C
C                                                    
C Input file TRGL with the triangles or polygons:
C (1) For each triangle data (1.1), or for each polygon data (1.2):
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             For polygon, three indices I1,I2,I3 are replaced with more
C             ones.
C     /...    List of vertices is terminated by a slash.
C (1.2) I1,I2,...,IN,/
C     I1,I2,...,IN... Indices of N vertices of the polygon.
C             The vertices in file VRTX are indexed by positive integers
C             according to their order.
C     /...    List of vertices must be terminated by a slash.
C (2) / or end of file.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
C
      INTEGER IRAM(MRAM)
      EQUIVALENCE (IRAM,RAM)
C
C.......................................................................
C
C     External functions and subroutines:
      EXTERNAL LENGTH,RSEP1,RSEP3T,RSEP3I,ERROR,FORM2,COLOR1,COLOR2
      INTEGER  LENGTH
C
C     Filenames and parameters:
      CHARACTER*80 FSEP,FVRTX,FTRGL,FCOLS,FIN,FOUT
      INTEGER LU1,LU2,IUNDEF,MVRTX,MQ
      PARAMETER (LU1=1,LU2=2,IUNDEF=-999999,MVRTX=99,MQ=30)
C     MVRTX...  Maximum number of vertices of a single polygon.
C
C     Other variables:
      CHARACTER*(8+8*MQ) FORMAT
      CHARACTER*5   VRML
      CHARACTER*255 NAME,PROP,TEXT
      LOGICAL LNORM
      INTEGER KOLSRF,KOLPOS,KOLNEG,KQ,NQ
      INTEGER NVRTX,NPLGN,IREF,IRGB,I0,I1,I2,I,N
      REAL AMBI,TRANSP,SPEC,SHIN,RED,GREEN,BLUE
      REAL OUTMIN(MQ),OUTMAX(MQ),R,G,B,AUX,AUXA(1)
C     LNORM.. Says whether the surface normals are specified.
C
C.......................................................................
C
C     Reading main input data:
      WRITE(*,'(A)') '+SRFWRL: Enter input filename: '
      FSEP=' '
      READ (*,*) FSEP
      IF(FSEP.EQ.' ') THEN
C       SRFWRL-08
        CALL ERROR('SRFWRL-08: 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
      CALL RSEP1(LU1,FSEP)
      WRITE(*,'(A)') '+SRFWRL: Working...            '
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('WRL'   ,FIN  ,'out.wrl' )
      CALL RSEP3T('WRLOUT',FOUT ,FIN       )
      CALL RSEP3T('VRML'  ,VRML ,'VRML2'   )
      CALL LOWER(VRML)
C
C     Reading input parameters for surface appearance:
      CALL RSEP3I('KOLSRF',KOLSRF,7)
      CALL RSEP3I('KOLPOS',KOLPOS,KOLSRF)
      CALL RSEP3I('KOLNEG',KOLNEG,KOLSRF)
      CALL RSEP3R('AMBIENT'  ,AMBI  ,0.20)
      CALL RSEP3R('TRANSP'   ,TRANSP,0.00)
      CALL RSEP3R('SPECULAR' ,SPEC  ,0.00)
      CALL RSEP3R('SHININESS',SHIN  ,0.20)
      CALL RSEP3R('R'        ,RED   ,1.)
      CALL RSEP3R('G'        ,GREEN ,1.)
      CALL RSEP3R('B'        ,BLUE  ,1.)
C
C     Opening the output file and writing its beginning:
      CALL WRL1(LU1,LU2,FIN,FOUT,VRML,1)
C
C     Writing the prolog for the surface (part 1):
      IF (VRML.EQ.'vrml1') THEN
        CONTINUE
      ELSE IF (VRML.EQ.'vrml2') THEN
        CONTINUE
      ELSE IF (VRML.EQ.'gocad') THEN
        KOLPOS=KOLSRF
        KOLNEG=KOLSRF
        CALL RSEP3T('NAME',NAME,' ')
C       Subroutine WRL has already checked that NAME is not blank.
        WRITE(LU2,'(A)')
     *   'GOCAD TSurf 1.0'
        WRITE(LU2,'(2A)')
     *   'HDR name:',NAME(1:LENGTH(NAME))
        WRITE(LU2,'(A)')
     *   'HDR *visible:true'
        CALL RSEP3T('PROPERTIES',PROP,' ')
        I0=1
        KQ=3
        DO 11 I=1,LEN(PROP)-1
          IF (PROP(I:I).EQ.' '.AND.PROP(I+1:I+1).NE.' ') THEN
            I0=I+1
          END IF
          IF (PROP(I:I).NE.' '.AND.PROP(I+1:I+1).EQ.' ') THEN
            KQ=KQ+1
            IF (KQ.EQ.KOLSRF.OR.(1.LE.KOLSRF.AND.KOLSRF.LE.3)) THEN
              I1=I0
              I2=I
            END IF
          END IF
   11   CONTINUE
        IF (KOLSRF.LE.0) THEN
          WRITE(LU2,'(3(A,F4.2))')
     *     'HDR color: ',RED,' ',GREEN,' ',BLUE
          WRITE(LU2,'(A,F4.2)')
     *     'HDR *solid*transparency:',TRANSP
        ELSE
          IF (KQ.LT.KOLSRF.OR.KQ.LT.4) THEN
C           SRFWRL-09
            CALL ERROR('SRFWRL-09: GOCAD property name not specified')
C           If KOLSRF is not zero, list PROPERTIES of property names
C           must contain MAX(1,KOLSRF-3) names at the least, see the
C           description of the input data.
          END IF
          WRITE(LU2,'(A)')
     *     'HDR *painted:true'
     *    ,'HDR *shaded_painted:true'
     *    ,'HDR *precise_painted:true'
          WRITE(LU2,'(2A)')
     *     'HDR *painted*variable:',PROP(I1:I2)
        END IF
        IF (KQ.GT.3) THEN
          WRITE(LU2,'(2A)')
     *     'PROPERTIES ',PROP(1:LENGTH(PROP))
        END IF
        IF (KOLSRF.NE.0) THEN
          IF (LENGTH(PROP)+(KQ-3)*LENGTH(NAME).GT.LEN(TEXT)) THEN
C           SRFWRL-10
            CALL ERROR('SRFWRL-10: Too long property class names')
C           Each property class name is composed of the object name
C           given by input parameter NAME and the property name.
C           The property names are given by input parameter PROPERTIES.
C           All property class names should fit into character variable
C           TEXT.  The length of TEXT thus should not be smaller than
C           the length of the value of PROPERTIES, plus the number of
C           properties times the length of the value of NAME.
          END IF
          I0=0
          DO 12 I=1,LENGTH(PROP)
            IF (I.EQ.1.AND.PROP(1:1).NE.' ') THEN
              TEXT(I0+1:I0+LENGTH(NAME))=NAME(1:LENGTH(NAME))
              I0=I0+LENGTH(NAME)
            END IF
            I0=I0+1
            TEXT(I0:I0)=PROP(I:I)
            IF (PROP(I:I).EQ.' '.AND.PROP(I+1:I+1).NE.' ') THEN
              TEXT(I0+1:I0+LENGTH(NAME))=NAME(1:LENGTH(NAME))
              I0=I0+LENGTH(NAME)
            END IF
   12     CONTINUE
          WRITE(LU2,'(2A)')
     *     'PROPERTY_CLASSES ',TEXT(1:I0)
          WRITE(LU2,'(4A)')
     *    'PROPERTY_CLASS_HEADER ',NAME(1:LENGTH(NAME)),PROP(I1:I2),' {'
C         The output file now waits for the colour scale.
        END IF
C       KQ is the number of coordinates and properties at each point.
      ELSE
C       SRFWRL-11
        CALL ERROR('SRFWRL-11: No valid string in VRML')
C       Valid string specifying the form of the output file is:
C       VRML='VRML1' or 'VRML2' or 'GOCAD' or 'POV'.  Default and
C       recommended value is 'VRML2'.
      END IF
C
C     Reading vertices:
      LNORM=.TRUE.
      IF(VRML.EQ.'gocad') THEN
        NQ=KQ
      ELSE
        KQ=MAX0(6,KOLPOS,KOLNEG)
        IF(KOLPOS.EQ.0.AND.KOLNEG.EQ.0) THEN
          NQ=6
        ELSE IF(KOLPOS.EQ.KOLNEG) THEN
          NQ=7
        ELSE
          NQ=8
        END IF
C       Values to be displayed will be shifted to the 7th and 8th column
      END IF
      IF(NQ.GT.MQ) THEN
C       SRFWRL-12
        CALL ERROR('SRFWRL-12: Too small arrays OUTMIN and OUTMAX')
      END IF
      OPEN(LU1,FILE=FVRTX,STATUS='OLD')
      READ(LU1,*) (TEXT,I=1,20)
      NVRTX=0
   20 CONTINUE
        IF(NVRTX+KQ.GT.MRAM) THEN
C         SRFWRL-01
          CALL ERROR('SRFWRL-01: Too small array RAM')
        END IF
        TEXT='$'
        DO 21 I=NVRTX+2,NVRTX+KQ
          RAM(I)=0.
   21   CONTINUE
        READ(LU1,*,END=29) TEXT,(RAM(I),I=NVRTX+1,NVRTX+KQ)
        IF(TEXT.EQ.'$') THEN
          GO TO 29
        END IF
C       Relocating the values to be displayed to the 7th and 8th columns
        IF(VRML.EQ.'gocad') THEN
          IF(1.LE.KOLSRF.AND.KOLSRF.LE.3) THEN
            RAM(NVRTX+KQ)=RAM(NVRTX+KOLSRF)
          END IF
        ELSE
          IF(KOLNEG.GT.0) THEN
            AUX=RAM(NVRTX+KOLNEG)
          END IF
          IF(KOLPOS.GT.0) THEN
            RAM(NVRTX+7)=RAM(NVRTX+KOLPOS)
          END IF
          IF(KOLNEG.GT.0.AND.KOLPOS.NE.KOLNEG) THEN
            RAM(NVRTX+8)=AUX
          END IF
        END IF
C       Normalizing the normal
        AUX=SQRT(RAM(NVRTX+4)**2+RAM(NVRTX+5)**2+RAM(NVRTX+6)**2)
        IF(AUX.GT.0.) THEN
          AUX=0.999/AUX
          RAM(NVRTX+4)=RAM(NVRTX+4)*AUX
          RAM(NVRTX+5)=RAM(NVRTX+5)*AUX
          RAM(NVRTX+6)=RAM(NVRTX+6)*AUX
        ELSE
          LNORM=.FALSE.
        END IF
C       Determining the minimum and maximum values
        IF(NVRTX.EQ.0) THEN
          DO 22 I=1,NQ
            OUTMIN(I)=RAM(NVRTX+I)
            OUTMAX(I)=RAM(NVRTX+I)
   22     CONTINUE
        ELSE
          DO 23 I=1,NQ
            OUTMIN(I)=AMIN1(OUTMIN(I),RAM(NVRTX+I))
            OUTMAX(I)=AMAX1(OUTMAX(I),RAM(NVRTX+I))
   23     CONTINUE
        END IF
C       Number of storage locations in RAM used for the vertices
        NVRTX=NVRTX+NQ
      GO TO 20
   29 CONTINUE
      CLOSE(LU1)
C     NVRTX is the number of storage locations in RAM used for vertices
      IF(VRML.NE.'gocad') THEN
        IF(KOLNEG.NE.0) THEN
          IF(KOLPOS.EQ.KOLNEG) THEN
            KOLNEG=7
          ELSE
            KOLNEG=8
          END IF
        END IF
        IF(KOLPOS.NE.0) THEN
          KOLPOS=7
        END IF
        IF(NQ.GE.8) THEN
          OUTMIN(7)=AMIN1(OUTMIN(7),OUTMIN(8))
          OUTMAX(7)=AMAX1(OUTMAX(7),OUTMAX(8))
        END IF
      END IF
C     Values to be displayed have been shifted to the 7th or 8th columns
C
C     Determining the colour map:
      IF(KOLPOS.GT.0.OR.KOLNEG.GT.0) THEN
        IF(VRML.EQ.'gocad') THEN
          CALL COLOR1(LU1,MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),
     *                                  1,OUTMIN(KOLSRF),OUTMAX(KOLSRF))
          WRITE(LU2,'(2A)')
     *     ' *colormap:',NAME(1:LENGTH(NAME))
          FORMAT='(A,'
          CALL FORM2(1,OUTMIN(KOLSRF),OUTMAX(KOLSRF),FORMAT(4:11))
          FORMAT(9:11)=')  '
          IF(OUTMAX(KOLSRF).GT.OUTMIN(KOLSRF)) THEN
            WRITE(LU2,FORMAT)
     *       ' *low_clip: ',OUTMIN(KOLSRF)
     *      ,' *high_clip:',OUTMAX(KOLSRF)
          ELSE
            WRITE(LU2,FORMAT)
     *       ' *low_clip: ',OUTMIN(KOLSRF)
     *      ,' *high_clip:',OUTMIN(KOLSRF)+1.
          END IF
          WRITE(LU2,'(4A)')
     *     ' *colormap*',NAME(1:LENGTH(NAME)),'*colors: ',CHAR(92)
          AUX=(OUTMAX(KOLSRF)-OUTMIN(KOLSRF))/255.
          DO 31 I=0,255
            AUXA(1)=OUTMIN(KOLSRF)+FLOAT(I)*AUX
            CALL COLOR2(MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),
     *                                                     1,AUXA,R,G,B)
            IF (I.LT.255) THEN
              WRITE(LU2,'(I5,3(1X,F4.2),2A)')
     *         I,R,G,B,' ',CHAR(92)
            ELSE
              WRITE(LU2,'(I5,3(1X,F4.2),2A)')
     *         I,R,G,B
            END IF
   31     CONTINUE
          IF(TRANSP.GT.0.) THEN
            WRITE(LU2,'(2A)')
     *       ' *colormap*alphas: ',CHAR(92)
            DO 32 I=0,255
              IF (I.LT.255) THEN
                WRITE(LU2,'(I5,1X,F4.2,2A)')
     *           I,TRANSP,' ',CHAR(92)
              ELSE
                WRITE(LU2,'(I5,1X,F4.2,2A)')
     *           I,TRANSP
              END IF
   32       CONTINUE
          END IF
          WRITE(LU2,'(A)')
     *     '}'
        ELSE IF (VRML.EQ.'pov') THEN
          AUX=0.01/SHIN
          WRITE(LU2,'(A)')
     *     '#default {'
          WRITE(LU2,'(A,2(F4.2,A))')
     *     '  finish { ambient 1.00 specular ',SPEC,
     *                                            ' roughness ',AUX,' }'
          WRITE(LU2,'(A)')
     *     '  pigment {'
     *    ,'    color_map {'
          CALL COLOR3(MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),1,IREF,IRGB)
          I=NVRTX+1+IRAM(NVRTX+1)
          IREF=NVRTX+IREF
          IRGB=NVRTX+IRGB
          DO 57 I2=1,IRAM(NVRTX+2)-IRAM(NVRTX+1)
            WRITE(LU2,'(A,F8.6,A,4(F4.2,A))')
     *       '      [',RAM(I+I2),' rgbt <',
     *                     (RAM(IRGB+I1),',',I1=3*I2-2,3*I2),TRANSP,'>]'
   57     CONTINUE
          WRITE(LU2,'(A)')
     *     '    }'
     *    ,'  }'
     *    ,'}'
          WRITE(LU2,'(A,G13.6,A)')
     *     '#declare CREF = ',RAM(IREF+1),';'
     *    ,'#declare VREF = ',RAM(IREF+2),';'
     *    ,'#declare VPER = ',RAM(IREF+3),';'
        ELSE
          CALL COLOR1(LU1,MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),
     *                                            1,OUTMIN(7),OUTMAX(7))
        END IF
      END IF
C
C     Writing the prolog for the surface (part 2):
      IF (VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)')
     *   'DEF SurfaceMaterial Material {'
        WRITE(LU2,'(3(A,F4.2))')
     *   '  diffuseColor    ',RED,' ',GREEN,' ',BLUE
     *  ,'  ambientColor    ',RED*AMBI,' ',GREEN*AMBI,' ',BLUE*AMBI
     *  ,'  specularColor   ',SPEC,' ',SPEC,' ',SPEC
        WRITE(LU2,'(A,F4.2)')
     *   '  shininess       ',SHIN
     *  ,'  transparency    ',TRANSP
        WRITE(LU2,'(A)')
     *   '  emissiveColor    0.00 0.00 0.00'
     *  ,'}'
        WRITE(LU2,'(A)')
     *   'Separator {'
     *  ,'USE SurfaceMaterial'
        IF(LNORM) THEN
          WRITE(LU2,'(A)') 'NormalBinding { value PER_VERTEX }'
        ELSE
          WRITE(LU2,'(A)') 'NormalBinding { value PER_FACE }'
        END IF
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'Shape {'
     *  ,'  appearance DEF SurfaceAppearance Appearance {'
     *  ,'    material Material {'
        WRITE(LU2,'(3(A,F4.2))')
     *   '      diffuseColor     ',RED,' ',GREEN,' ',BLUE
     *  ,'      specularColor    ',SPEC,' ',SPEC,' ',SPEC
        WRITE(LU2,'(A,F4.2)')
     *   '      shininess        ',SHIN
     *  ,'      transparency     ',TRANSP
        WRITE(LU2,'(A)')
     *   '      ambientIntensity 1.00'
     *  ,'      emissiveColor    0.00 0.00 0.00'
     *  ,'    }'
     *  ,'  }'
     *  ,'}'
     *  ,'Surface {'
     *  ,'appearance USE SurfaceAppearance'
      ELSE IF (VRML.EQ.'pov') THEN
        WRITE(LU2,'(A,I6,A)')
     *   '#declare NVRTX =',NVRTX/NQ,';'
        WRITE(LU2,'(A)')
     *   '#declare PTS = array[NVRTX][7]'
     *  ,'#declare IVRTX = 0;'
     *  ,'#macro VRTX(X1,X2,X3,Z1,Z2,Z3,V1)'
     *  ,'  #declare PTS[IVRTX][0] = X1;'
     *  ,'  #declare PTS[IVRTX][1] = X2;'
     *  ,'  #declare PTS[IVRTX][2] = X3;'
     *  ,'  #declare PTS[IVRTX][3] = Z1;'
     *  ,'  #declare PTS[IVRTX][4] = Z2;'
     *  ,'  #declare PTS[IVRTX][5] = Z3;'
     *  ,'  #declare PTS[IVRTX][6] = V1;'
     *  ,'  #declare IVRTX = IVRTX + 1;'
     *  ,'#end'
     *  ,'#macro TRGL(I1,I2,I3)'
     *  ,'  #local X1=;'
     *  ,'  #local X2=;'
     *  ,'  #local X3=;'
     *  ,'  #local Z1=;'
     *  ,'  #local Z2=;'
     *  ,'  #local Z3=;'
     *  ,'  #local V1=PTS[I1][6]-PTS[I3][6];'
     *  ,'  #local V2=PTS[I2][6]-PTS[I3][6];'
     *  ,'  #local V3=           PTS[I3][6];'
     *  ,'  #if (V1=0 & V2=0)'
     *  ,'    #local V1=VPER/999999;'
     *  ,'  #end'
     *  ,'  #local D1=X1-X3;'
     *  ,'  #local D2=X2-X3;'
     *  ,'  #local D11=vdot(D1,D1);'
     *  ,'  #local D12=vdot(D1,D2);'
     *  ,'  #local D22=vdot(D2,D2);'
     *  ,'  #local D  =D11*D22-D12*D12;'
     *  ,'  #local G =(D1*(D22*V1-D12*V2)+D2*(-D12*V1+D11*V2))/D;'
     *  ,'  #local GN= vlength(G);'
     *  ,'  #local G0= G*VPER/GN/GN;'
     *  ,'  #local G1= V2*D1-V1*D2;'
     *  ,'  #local G2= vcross(G0,G1);'
     *  ,'  smooth_triangle {'
     *  ,'    X1,Z1,X2,Z2,X3,Z3'
     *  ,'    texture {'
     *  ,'      pigment {'
     *  ,'        gradient x'
     *  ,'        translate ((VREF-V3)/VPER-CREF-100)*x'
     *  ,'        matrix '
     *  ,'        translate X3'
     *  ,'      }'
     *  ,'    }'
     *  ,'  }'
     *  ,'#end'
      END IF
C
C     Writing the vertices:
      IF (VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)') 'Coordinate3 { point ['
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)') 'point ['
      END IF
C     ------
      IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
        FORMAT='('
        CALL FORM2(3,OUTMIN(1),OUTMAX(1),FORMAT(2:25))
        DO 60 I=1,NVRTX,NQ
          WRITE(LU2,FORMAT) RAM(I),' ',RAM(I+1),' ',RAM(I+2),','
   60   CONTINUE
      ELSE IF (VRML.EQ.'gocad') THEN
C       Writing the vertices with normals and values:
        FORMAT='(A,I0,A,'
        FORMAT(5:5)=CHAR(ICHAR('1')+INT(ALOG10(FLOAT(NVRTX/NQ)+0.5)))
        IF (NQ.EQ.3) THEN
          CALL FORM2(3,OUTMIN(1),OUTMAX(1),FORMAT(9:8+8*3))
          DO 62 I0=1,NVRTX,NQ
            WRITE(LU2,FORMAT) 'VRTX ',I0/NQ+1,(' ',RAM(I),I=I0,I0+2)
   62     CONTINUE
        ELSE
          CALL FORM2(NQ,OUTMIN(1),OUTMAX(1),FORMAT(9:8+8*NQ))
          DO 63 I0=1,NVRTX,NQ
            WRITE(LU2,FORMAT) 'PVRTX ',I0/NQ+1,(' ',RAM(I),I=I0,I0+NQ-1)
   63     CONTINUE
        END IF
      ELSE IF (VRML.EQ.'pov') THEN
C       Writing the vertices with normals and values:
        IF(KOLNEG.NE.KOLPOS) THEN
C         SRFWRL-51
          CALL WARN('SRFWRL-51: POV surface sides differently coloured')
C         POV scene description language does not allow for different
C         colours at the positive and negative side of a surface.
        END IF
        FORMAT='(A,'
        CALL FORM2(3,OUTMIN(1),OUTMAX(1),FORMAT(4:27))
        FORMAT(27:38)=',3(F5.3,A),'
        CALL FORM2(1,OUTMIN(7),OUTMAX(7),FORMAT(39:46))
        DO 65 I=1,NVRTX,NQ
          WRITE(LU2,FORMAT) 'VRTX(',(RAM(I1),',',I1=I,I+5),RAM(I+6),')'
   65   CONTINUE
      END IF
C     ------
      IF (VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)') '] }'
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)') ']'
      END IF
C
C     Writing the right-handed normals (positive surface side):
      IF(LNORM) THEN
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') 'DEF SurfaceNormal Normal { vector ['
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') 'normalPos Normal { vector ['
        END IF
C       ------
        IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
          FORMAT='(3(F5.3,A))'
          DO 66 I=4,NVRTX,NQ
            WRITE(LU2,FORMAT) RAM(I),' ',RAM(I+1),' ',RAM(I+2),','
   66     CONTINUE
        END IF
C       ------
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') '] }'
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') '] }'
        END IF
      END IF
C
C     Writing the left-handed normals (negative surface side):
      IF(LNORM) THEN
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') 'Normal { vector ['
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') 'normalNeg Normal { vector ['
        END IF
C       ------
        IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
          DO 67 I=4,NVRTX,NQ
            WRITE(LU2,FORMAT) -RAM(I),' ',-RAM(I+1),' ',-RAM(I+2),','
   67     CONTINUE
        END IF
C       ------
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') '] }'
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') '] }'
        END IF
      END IF
C
C     Writing the colours of the positive surface side:
      IF(KOLPOS.GT.0) THEN
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') 'DEF SurfaceColor Material { diffuseColor ['
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') 'colorPos DEF SurfaceColor Color { color ['
        END IF
C       ------
        IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
          DO 71 I=KOLPOS,NVRTX,NQ
            CALL COLOR2(MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),
     *                                                   1,RAM(I),R,G,B)
            WRITE(LU2,'(3(F4.2,A))') R,' ',G,' ',B,','
   71     CONTINUE
        END IF
C       ------
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') '] }'
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') '] }'
        END IF
      END IF
C
C     Writing the colours of the negative surface side:
      IF(KOLNEG.GT.0) THEN
        IF(KOLNEG.EQ.KOLPOS) THEN
          IF (VRML.EQ.'vrml1') THEN
            CONTINUE
          ELSE IF (VRML.EQ.'vrml2') THEN
            WRITE(LU2,'(A)') 'colorNeg USE SurfaceColor'
          END IF
        ELSE
          IF (VRML.EQ.'vrml1') THEN
            WRITE(LU2,'(A)') 'Material { diffuseColor ['
          ELSE IF (VRML.EQ.'vrml2') THEN
            WRITE(LU2,'(A)') 'colorNeg Color { color ['
          ELSE IF (VRML.EQ.'pov') THEN
          END IF
C         ------
          IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
            DO 72 I=KOLNEG,NVRTX,NQ
              CALL COLOR2(MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),
     *                                                   1,RAM(I),R,G,B)
              WRITE(LU2,'(3(F4.2,A))') R,' ',G,' ',B,','
   72       CONTINUE
          END IF
C         ------
          IF (VRML.EQ.'vrml1') THEN
            WRITE(LU2,'(A)') '] }'
          ELSE IF (VRML.EQ.'vrml2') THEN
            WRITE(LU2,'(A)') '] }'
          END IF
        END IF
      END IF
C
C     Reading the polygons (usually triangles):
      DO 81 I=1,MRAM
        IRAM(I)=0
   81 CONTINUE
      OPEN(LU1,FILE=FTRGL)
      NPLGN=0
   82 CONTINUE
        IF(NPLGN+MVRTX+1.GT.MRAM) THEN
C         SRFWRL-02
          CALL ERROR('SRFWRL-02: Too small array RAM')
        END IF
        IRAM(NPLGN+1)=IUNDEF
        READ(LU1,*,END=89) (IRAM(I),I=NPLGN+1,NPLGN+MVRTX+1)
        IF(IRAM(NPLGN+1).EQ.IUNDEF) THEN
          GO TO 89
        END IF
        DO 83 I=NPLGN+1,NPLGN+MVRTX+1
          IF(IRAM(I).LE.0) THEN
C           Number of polygon vertices
            N=I-1-NPLGN
            GO TO 84
          ELSE IF(IRAM(I).GT.NVRTX/NQ) THEN
C           SRFWRL-03
            WRITE(TEXT,'(A,I6)')'SRFWRL-03: Wrong vertex index:',IRAM(I)
            CALL ERROR(TEXT(1:LENGTH(TEXT)))
          END IF
   83   CONTINUE
C         SRFWRL-04
          CALL ERROR('SRFWRL-04: Too many vertices in polygons')
   84   CONTINUE
        IF(N.LT.3) THEN
C         SRFWRL-52
          CALL WARN('SRFWRL-52: Polygon of less than 3 vertices')
        END IF
C       Checking vertex indices:
        DO 86 I2=NPLGN+1,NPLGN+N
          DO 85 I1=I2+1,NPLGN+N
          IF(IRAM(I2).EQ.IRAM(I1)) THEN
C           SRFWRL-05
            WRITE(TEXT,'(A,I6)')
     *        'SRFWRL-05: The same vertex twice in a polygon:',IRAM(I2)
            CALL ERROR(TEXT(1:LENGTH(TEXT)))
C           All vertices of a polygon must be different.
          END IF
   85     CONTINUE
   86   CONTINUE
C       Terminating polygon by zero
        IF(N.GE.3) THEN
          NPLGN=NPLGN+N+1
          IRAM(NPLGN)=0
        END IF
      GO TO 82
   89 CONTINUE
      CLOSE(LU1)
C
C     Writing the polygons (usually triangles):
      IF(VRML.EQ.'vrml1') THEN
        IF(KOLNEG.GT.0) THEN
          WRITE(LU2,'(A)') 'MaterialBinding { value PER_VERTEX }'
        ELSE
          WRITE(LU2,'(A)') 'MaterialBinding { value OVERALL }'
        END IF
        WRITE(LU2,'(A)') 'ShapeHints {'
        WRITE(LU2,'(A)') '  vertexOrdering CLOCKWISE'
        WRITE(LU2,'(A)') '  shapeType SOLID'
        WRITE(LU2,'(A)') '}'
        WRITE(LU2,'(A)') 'DEF Surface IndexedFaceSet { coordIndex ['
      ELSE IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)') 'coordIndex ['
      END IF
C     ------
      N=0
      IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
        FORMAT='(99(I0,A))'
        I=INT(ALOG10(FLOAT(NVRTX/NQ)-0.5))+1
        FORMAT(6:6)=CHAR(ICHAR('0')+I)
        DO 91 I2=1,NPLGN
          IF(IRAM(I2).LE.0) THEN
            WRITE(LU2,FORMAT)
     *                (IRAM(I1)-1,', ',I1=N+1,I2-2),IRAM(I2-1)-1,', -1,'
            N=I2
          END IF
   91   CONTINUE
      ELSE IF (VRML.EQ.'gocad') THEN
        FORMAT='(A,3(A,I0))'
        I=INT(ALOG10(FLOAT(NVRTX/NQ)+0.5))+1
        FORMAT(9:9)=CHAR(ICHAR('0')+I)
        DO 92 I2=1,NPLGN
          IF(IRAM(I2).LE.0) THEN
            IF(I2-N.GT.4) THEN
C             SRFWRL-06
              CALL ERROR('SRFWRL-06: More than 3 vertices in polygon')
C             In this version of the SRFWRL program, only triangles are
C             allowed for GOCAD.  Polygons should be divided into
C             triangles using program 'trgl.for'.
            END IF
            WRITE(LU2,FORMAT) 'TRGL',(' ',IRAM(I1),I1=N+1,I2-1)
            N=I2
          END IF
   92   CONTINUE
      ELSE IF(VRML.EQ.'pov') THEN
        FORMAT='(99(A,I0))'
        I=INT(ALOG10(FLOAT(NVRTX/NQ)-0.5))+1
        FORMAT(8:8)=CHAR(ICHAR('0')+I)
        DO 93 I2=1,NPLGN
          IF(IRAM(I2).LE.0) THEN
            IF(I2-N.GT.4) THEN
C             SRFWRL-07
              CALL ERROR('SRFWRL-07: More than 3 vertices in polygon')
C             In this version of the SRFWRL program, only triangles are
C             allowed for the POV scene description language.  Polygons
C             should be divided into triangles using program 'trgl.for'.
            END IF
            WRITE(LU2,FORMAT)
     *             'TRGL(',(IRAM(I1)-1,',',I1=N+1,I2-2),IRAM(I2-1)-1,')'
            N=I2
          END IF
   93   CONTINUE
      END IF
C     ------
      IF(VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)') '] }'
        IF(LNORM) THEN
          WRITE(LU2,'(A)') 'USE SurfaceNormal'
        END IF
        IF(KOLPOS.GT.0) THEN
          WRITE(LU2,'(A)') 'USE SurfaceColor'
          WRITE(LU2,'(A)') 'MaterialBinding { value PER_VERTEX }'
        ELSE
          WRITE(LU2,'(A)') 'MaterialBinding { value OVERALL }'
        END IF
        WRITE(LU2,'(A)') 'ShapeHints {'
        WRITE(LU2,'(A)') '  vertexOrdering COUNTERCLOCKWISE'
        WRITE(LU2,'(A)') '  shapeType SOLID'
        WRITE(LU2,'(A)') '}'
        WRITE(LU2,'(A)') 'USE Surface'
      ELSE IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)') ']'
      END IF
C
C     Writing the trailor for the surface:
      IF (VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)') '}'
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)') '}'
      ELSE IF (VRML.EQ.'gocad') THEN
        WRITE(LU2,'(A)') 'END'
      END IF
      CLOSE(LU2)
      WRITE(*,'(A)') '+SRFWRL: Done.                 '
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'length.for'
C     length.for
      INCLUDE 'forms.for'
C     forms.for
      INCLUDE 'colors.for'
C     colors.for
      INCLUDE 'wrl.for'
C     wrl.for
C
C=======================================================================
C