C
C     ****************************************************************
C
C     PROGRAM ANRAYVRM GENERATES 3-D IMAGES OF THE MODEL AND RAYS
C
C     ****************************************************************
C
      common /gcenter/xcenter,ycenter,zcenter
C
      INTEGER LU_VRML
      PARAMETER (LU_VRML=97)
      CHARACTER*80 text, FILEIN1
C
      LUIN1=96
C
      WRITE(*,'(2A)')
        1' Enter input file name (list)'
      filein1='list'
      OPEN(LUIN1,FILE=FILEIN1,FORM='FORMATTED',STATUS='OLD')
      call Vrml_Init1(LU_VRML)                          ! In An_VRML_1
C
      read(LUIN1,*)text
      call Vrml_Init2(LUIN1,LU_VRML)                  ! In An_VRML_1
C
      read(LUIN1,*)text
      read(LUIN1,*)Iread
      if(Iread.ne.0) call Vrml_Line(LUIN1,LU_VRML)    ! In An_VRML_2 draw border
C
      read(LUIN1,*)text
      read(LUIN1,*)Iread
      if(Iread.ne.0) call Vrml_Surface(LUIN1,LU_VRML) ! In An_VRML_3
C
      read(LUIN1,*)text
      read(LUIN1,*)Iread
      if(Iread.ne.0) call Vrml_Line(LUIN1,LU_VRML)    ! In An_VRML_2  draw rays
C
      STOP
      END
C
C     Initialize vrml file
C
      subroutine Vrml_Init1(LU2)
      CHARACTER*80 FName
C
C     Opening output VRML file:
      FName='anvrml00.wrl'
      DO 20 I=0,99
        WRITE(FName(7:8),'(2I1)') I/10,I-I/10*10
        OPEN(LU2,FILE=FName,STATUS='NEW',ERR=10)
        GO TO 30
   10   CONTINUE
   20 CONTINUE
      PAUSE 'Error: Unable to open output VRML file anvrml**.wrl'
   30 CONTINUE
      WRITE(LU2,'(A)')'#VRML V2.0 utf8'
      RETURN
        END
C
C
      subroutine Vrml_Init2(LUIN1,LU2)
C     External functions and subroutines:
      EXTERNAL LENGTH,ERROR,RSEP1,RSEP3T,RSEP3R
      INTEGER  LENGTH
C
C     Filenames and parameters:
      CHARACTER*80 FILE1,FILE2
      INTEGER LU1,LU2
      REAL UNDEF
      PARAMETER (LU1=1,LU12=12,UNDEF=-999999.)
C
C     Other variables:
      CHARACTER*5   VRML
      CHARACTER*255 TEXT
      INTEGER I,J
      REAL UP1,UP2,UP3,RED,GREEN,BLUE
      REAL X1,X2,X3,T1,T2,T3,R1,R2,R3,R4,W,H,C,S,DIST,AUX
      REAL R11,R21,R31,R12,R22,R32,R13,R23,R33
      REAL S11,S21,S31,S12,S22,S32,S13,S23,S33
C
C.......................................................................
C
C     Reading main input data:
      WRITE(*,'(A)') '+INIWRL: Enter input filename: '
      FILE1=' '
      READ(LUIN1,*) FILE1
      IF(FILE1.EQ.' ') THEN
C       <A NAME="error01"></A><FONT COLOR="RED">INIWRL-01</FONT>
        CALL ERROR('INIWRL-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)') '+INIWRL: Working...            '
C
C     Reading output filename and opening the output file:
      CALL RSEP1(LU1,FILE1)
      CALL RSEP3T('VRML',VRML ,'vrml2'  )
      CALL LOWER(VRML)
      IF(VRML.NE.'vrml1'.AND.
     *   VRML.NE.'vrml2'.AND.
     *   VRML.NE.'pov'  .AND.
     *   VRML.NE.'gocad') THEN
C       <A NAME="error02"></A><FONT COLOR="RED">INIWRL-02</FONT>
        CALL ERROR('INIWRL-02: No valid string in VRML')
C       Valid string specifying the form of the output file is:
C       VRML='VRML1' or 'VRML2' or 'POV' or 'GOCAD'.
C       Default and recommended value is 'VRML2'.
      END IF
      CALL RSEP3T('WRL' ,FILE2,'out.wrl')
c$$$      OPEN(LU2,FILE=FILE2)
C
C     Writing beginning of the output file:
      CALL RSEP3T('WRLINI',FILE1,' ')
c$$$      CALL WRL1(LU1,LU2,FILE1,FILE2,VRML)
C
C.......................................................................
C
C     Cameras (viewpoints):
C
      CALL RSEP3T('CAMERA',FILE1,' ')
      CALL RSEP3R('UP1',UP1,0.)
      CALL RSEP3R('UP2',UP2,0.)
      CALL RSEP3R('UP3',UP3,1.)
      IF(FILE1.NE.' ') THEN
        OPEN(LU1,FILE=FILE1,STATUS='OLD')
        READ(LU1,*) (TEXT,I=1,20)
C
C       Loop over viewpoints
   20   CONTINUE
          TEXT='$'
          X1=0.
          X2=0.
          X3=0.
          T1=0.
          T2=0.
          T3=0.
          W=UNDEF
          H=UNDEF
          READ(LU1,*,END=29) TEXT,X1,X2,X3,T1,T2,T3,W,H
          IF(TEXT.EQ.'$') THEN
            GO TO 29
          END IF
C
C         Camera back unit vector
          R13=X1-T1
          R23=X2-T2
          R33=X3-T3
          DIST=SQRT(R13*R13+R23*R23+R33*R33)
          IF(DIST.EQ.0.) THEN
C           <A NAME="error03"></A><FONT COLOR="RED">INIWRL-03</FONT>
            CALL ERROR('INIWRL-03: Zero distance from camera to model')
          END IF
          R13=R13/DIST
          R23=R23/DIST
          R33=R33/DIST
C
C         Viewing frame
          IF(W.EQ.UNDEF.AND.H.EQ.UNDEF) THEN
            H=DIST*2.*(SQRT(2.)-1.)
            W=H*4./3.
          ELSE IF(W.EQ.UNDEF) THEN
            W=H*4./3.
          ELSE IF(H.EQ.UNDEF) THEN
            H=W*3./4.
          END IF
C
          IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
C           Camera top unit vector
            AUX=UP1*R13+UP2*R23+UP3*R33
            R12=UP1-R13*AUX
            R22=UP2-R23*AUX
            R32=UP3-R33*AUX
            AUX=SQRT(R12*R12+R22*R22+R32*R32)
            IF(AUX.GE.0.00025) THEN
              R12=R12/AUX
              R22=R22/AUX
              R32=R32/AUX
            ELSE IF(ABS(R13).LE.ABS(R23).AND.ABS(R13).LE.ABS(R33)) THEN
              AUX=SQRT(R23*R23+R33*R33)
              R12=0.
              R22= R33/AUX
              R32=-R23/AUX
            ELSE IF(ABS(R23).LE.ABS(R33)) THEN
              AUX=SQRT(R13*R13+R33*R33)
              R12= R33/AUX
              R22=0.
              R32=-R13/AUX
            ELSE
              AUX=SQRT(R13*R13+R23*R23)
              R12= R23/AUX
              R22=-R13/AUX
              R32=0.
            END IF
C
C           Camera right unit vector
            R11=R22*R33-R32*R23
            R21=R32*R13-R12*R33
            R31=R12*R23-R22*R13
C
C           Rotation axis vector
            C=R11+R22+R33-1.
            R11=R11-1.
            R22=R22-1.
            R33=R33-1.
            S11=R22*R33-R32*R23
            S21=R32*R13-R12*R33
            S31=R12*R23-R22*R13
            S12=R23*R31-R33*R21
            S22=R33*R11-R13*R31
            S32=R13*R21-R23*R11
            S13=R21*R32-R31*R22
            S23=R31*R12-R11*R32
            S33=R11*R22-R21*R12
            IF(S11.LE.0..AND.S22.LE.0..AND.S33.LE.0.) THEN
              R1=0.
              R2=0.
              R3=1.
              R4=0.
            ELSE IF(S33.GE.S22.AND.S33.GE.S11) THEN
              R1=S13+S31
              R2=S23+S32
              R3=S33+S33
            ELSE IF(S22.GE.S11) THEN
              R1=S12+S21
              R2=S22+S22
              R3=S32+S23
            ELSE
              R1=S11+S11
              R2=S21+S12
              R3=S31+S13
            END IF
            AUX=SQRT(R1*R1+R2*R2+R3*R3)
            R1=R1/AUX
            R2=R2/AUX
            R3=R3/AUX
            S=R1*(R32-R23)+R2*(R13-R31)+R3*(R21-R12)
            R4=ATAN2(S,C)
C
            IF(VRML.EQ.'vrml1') THEN
              AUX=2.*ATAN(H/DIST/2.)
              WRITE(LU2,'(A)')
     *         'PerspectiveCamera {'
              WRITE(LU2,'(A,F8.6)')
     *         '  heightAngle ',AUX
              WRITE(LU2,'(A,G15.6)')
     *         '  focalDistance ',DIST
            ELSE
              AUX=2.*ATAN(AMAX1(W*3./4.,H)/DIST/2.)
              WRITE(LU2,'(A)')
     *         'Viewpoint {'
              WRITE(LU2,'(3A)')
     *         '  description "',TEXT(1:LENGTH(TEXT)),'"'
              WRITE(LU2,'(A,F8.6)')
     *         '  fieldOfView ',AUX
            END IF
            WRITE(LU2,'(3(A,G15.6))')
     *       '  position ',X1,' ',X2,' ',X3
            WRITE(LU2,'(4(A,F9.6))')
     *       '  orientation ',R1,' ',R2,' ',R3,' ',R4
            WRITE(LU2,'(A)')
     *       '}'
C
          ELSE IF(VRML.EQ.'pov') THEN
            WRITE(LU2,'(A)')
     *       'camera {'
     *      ,'  perspective'
            WRITE(LU2,'(A,3(G15.6,A))')
     *       '  right     <',-W ,',', 0.,',', 0. ,'>'
     *      ,'  up        <', 0.,',', H ,',', 0. ,'>'
     *      ,'  direction <', 0.,',', 0.,',',DIST,'>'
     *      ,'  sky       <',UP1,',',UP2,',',UP3 ,'>'
     *      ,'  location  <', X1,',', X2,',', X3 ,'>'
     *      ,'  look_at   <', T1,',', T2,',', T3 ,'>'
            WRITE(LU2,'(A)')
     *       '}'
C
          END IF
        GO TO 20
C       End of the loop over viewpoints
C
   29   CONTINUE
        CLOSE(LU1)
      END IF
C
C.......................................................................
C
C     Ambient light:
C
      CALL RSEP3R('AMBIENT',W,0.20)
C     VRML 1.0 has an implicit ambient light of intensity 1.00
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'NavigationInfo {'
     *  ,'  headlight FALSE'
     *  ,'}'
     *  ,'DirectionalLight {'
     *  ,'  color 1.00 1.00 1.00'
     *  ,'  intensity 0.00'
        WRITE(LU2,'(A,F4.2)')
     *   '  ambientIntensity ',W
        WRITE(LU2,'(A)')
     *   '  on TRUE'
     *  ,'}'
      ELSE IF(VRML.EQ.'pov') THEN
        WRITE(LU2,'(A,3(F4.2,A))')
     *   'global_settings { ambient_light rgb <',W,',',W,',',W,'> }'
      END IF
C
C.......................................................................
C
C     Directional and point lights:
C
      DO 39 J=1,2
        IF(J.EQ.1) THEN
C         Directional lights
          CALL RSEP3T('DLIGHT',FILE1,' ')
        ELSE
C         Point lights
          CALL RSEP3T('PLIGHT',FILE1,' ')
        END IF
        IF(FILE1.NE.' ') THEN
          OPEN(LU1,FILE=FILE1,STATUS='OLD')
          READ(LU1,*) (TEXT,I=1,20)
C
C         Loop over lights
   30     CONTINUE
            TEXT='$'
            X1=0.
            X2=0.
            X3=0.
            W =0.80
            READ(LU1,*,END=38) TEXT,X1,X2,X3,W
            IF(TEXT.EQ.'$') THEN
              GO TO 38
            END IF
C
            IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
              IF(J.EQ.1) THEN
                WRITE(LU2,'(A)')
     *           'DirectionalLight {'
                AUX=SQRT(X1*X1+X2*X2+X3*X3)
                X1=-X1/AUX
                X2=-X2/AUX
                X3=-X3/AUX
                WRITE(LU2,'(3(A,F9.6))')
     *           '  direction ',X1,' ',X2,' ',X3
              ELSE
                WRITE(LU2,'(A)')
     *           'PointLight {'
                WRITE(LU2,'(3(A,G15.6))')
     *           '  location ',X1,' ',X2,' ',X3
                WRITE(LU2,'(A)')
     *           '  radius 999999'
              END IF
              WRITE(LU2,'(A)')
     *         '  color 1.00 1.00 1.00'
              WRITE(LU2,'(A,F4.2)')
     *         '  intensity ',ABS(W)
              IF(VRML.EQ.'vrml2') THEN
                WRITE(LU2,'(A)')
     *           '  ambientIntensity 0.00'
              END IF
              IF(W.GT.0.) THEN
                WRITE(LU2,'(A)')
     *           '  on TRUE'
              ELSE
                WRITE(LU2,'(A)')
     *           '  on FALSE'
              END IF
              WRITE(LU2,'(A)')
     *         '}'
            ELSE IF(VRML.EQ.'pov') THEN
              WRITE(LU2,'(A)')
     *         'light_source {'
              WRITE(LU2,'(A,3(G15.6,A))')
     *         '  <',X1,',',X2,',',X3,'>'
              WRITE(LU2,'(A,3(F4.2,A))')
     *         '  rgb <',W,',',W,',',W,'>'
              WRITE(LU2,'(A)')
     *         '}'
            END IF
          GO TO 30
C         End of the loop over directional lights
C
   38     CONTINUE
          CLOSE(LU1)
        END IF
   39 CONTINUE
C
C.......................................................................
C
C     Background colour:
C
      CALL RSEP3R('R',RED  ,0.)
      CALL RSEP3R('G',GREEN,0.)
      CALL RSEP3R('B',BLUE ,0.)
C     VRML 1.0 has no background node
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A,3(F4.2,A))')
     *    'Background { skyColor ',RED,' ',GREEN,' ',BLUE,' }'
      ELSE IF(VRML.EQ.'pov') THEN
        WRITE(LU2,'(A,3(F4.2,A))')
     *    'background { color rgb <',RED,',',GREEN,',',BLUE,'> }'
      END IF
C
C.......................................................................
C
C     Separating the header by a blank line
      IF (VRML.NE.'gocad') THEN
        WRITE(LU2,'(A)')
      END IF
C
C.......................................................................
C
C     Subroutine for surfaces:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO Surface ['
     *  ,'  exposedField SFNode  appearance NULL'
     *  ,'  field        MFVec3f point      []'
     *  ,'  exposedField SFNode  normalPos  NULL'
     *  ,'  exposedField SFNode  normalNeg  NULL'
     *  ,'  exposedField SFNode  colorPos   NULL'
     *  ,'  exposedField SFNode  colorNeg   NULL'
     *  ,'  field        MFInt32 coordIndex []'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    children ['
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry IndexedFaceSet {'
     *  ,'          ccw TRUE # positive surface side'
     *  ,'          coord DEF SurfaceCoord Coordinate {'
     *  ,'            point    IS point'
     *  ,'          }'
     *  ,'          normal     IS normalPos'
     *  ,'          color      IS colorPos'
     *  ,'          coordIndex IS coordIndex'
     *  ,'        }'
     *  ,'      }'
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry IndexedFaceSet {'
     *  ,'          ccw FALSE # negative surface side'
     *  ,'          coord USE SurfaceCoord'
     *  ,'          normal     IS normalNeg'
     *  ,'          color      IS colorNeg'
     *  ,'          coordIndex IS coordIndex'
     *  ,'        }'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      END IF
C
C.......................................................................
C
C     Subroutine for lines:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO Line ['
     *  ,'  exposedField SFNode  appearance NULL'
     *  ,'  field        MFVec3f point      []'
     *  ,'  exposedField SFNode  color      NULL'
     *  ,'  field        MFInt32 coordIndex []'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    children ['
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry IndexedLineSet {'
     *  ,'          coord Coordinate {'
     *  ,'            point    IS point'
     *  ,'          }'
     *  ,'          color      IS color'
     *  ,'          coordIndex IS coordIndex'
     *  ,'        }'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      ELSE IF (VRML.EQ.'pov') THEN
        WRITE(LU2,'(A)')
     *   '#declare LINERADIUS = 0.1;'
     *  ,' '
     *  ,'#macro LINE(X1,X2,X3,X4,Y1,Y2,Y3,Y4)'
     *  ,'  #local X=<X1,X2,X3>;'
     *  ,'  #local Y=<Y1,Y2,Y3>;'
     *  ,'  #local VD=X4-Y4;'
     *  ,'  #local VY=   Y4;'
     *  ,'  #if (VD=0)'
     *  ,'    #local VD=VPER/999999;'
     *  ,'  #end'
     *  ,'  #local G0=(X-Y)*VPER/VD;'
     *  ,'  cylinder {'
     *  ,'    X Y LINERADIUS'
     *  ,'    texture {'
     *  ,'      pigment {'
     *  ,'        gradient x'
     *  ,'        translate ((VREF-V3)/VPER-CREF-100)*x'
     *  ,'        matrix <vdot(G0,x),vdot(G0,y),vdot(G0,z),'
     *  ,'                0,1,0, 0,0,1, 0,0,0>'
     *  ,'        translate Y'
     *  ,'      }'
     *  ,'    }'
     *  ,'  }'
     *  ,'#end'
     *  ,' '
      END IF
C
C.......................................................................
C
C     Subroutine for points:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO Point ['
     *  ,'  exposedField SFNode  appearance NULL'
     *  ,'  field        MFVec3f point      []'
     *  ,'  exposedField SFNode  color      NULL'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    children ['
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry PointSet {'
     *  ,'          coord Coordinate {'
     *  ,'            point    IS point'
     *  ,'          }'
     *  ,'          color      IS color'
     *  ,'        }'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      END IF
C
C.......................................................................
C
C     Subroutine for texts:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO text ['
     *  ,'  exposedField SFNode   appearance NULL'
     *  ,'  exposedField SFVec3f  point      0 0 0'
     *  ,'  exposedField MFString string     []'
     *  ,'  exposedField SFNode   fontStyle  NULL'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    translation IS point'
     *  ,'    children ['
     *  ,'      Billboard {'
        AUX=SQRT(UP1*UP1+UP2*UP2+UP3*UP3)
        R1=UP1/AUX
        R2=UP2/AUX
        R3=UP3/AUX
        WRITE(LU2,'(3(A,F6.3))')
     *   '        axisOfRotation ',R1,' ',R2,' ',R3
        AUX=SQRT(UP2*UP2+UP3*UP3)
        WRITE(LU2,'(A)')
     *   '        children ['
     *  ,'          Transform {'
        AUX=SQRT(UP1*UP1+UP3*UP3)
        IF(AUX.NE.0.) THEN
          R1=UP3/AUX
          R2=0.
          R3=-UP1/AUX
          R4=ATAN2(AUX,UP2)
        ELSE
          R1=1.
          R2=0.
          R3=0.
          IF(UP2.GE.0.) THEN
            R4=0.
          ELSE
            R4=3.141593
          END IF
        END IF
        WRITE(LU2,'(3(A,F6.3),A,F9.6)')
     *   '            rotation ',R1,' ',R2,' ',R3,' ',R4
        WRITE(LU2,'(A)')
     *   '            children ['
     *  ,'              Shape {'
     *  ,'                appearance IS appearance'
     *  ,'                geometry Text {'
     *  ,'                  string IS string'
     *  ,'                  fontStyle IS fontStyle'
     *  ,'                }'
     *  ,'              }'
     *  ,'            ]'
     *  ,'          }'
     *  ,'        ]'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      END IF
C
C.......................................................................
C
c$$      CLOSE(LU2)
      WRITE(*,'(A)') '+INIWRL: Done.                 '
      return
      END
C
C
c draw line
C
      subroutine Vrml_Line(LUIN1,LU2)
C                                                            <HTML><PRE>
C Program LINWRL to convert lines into Virtual Reality Modeling Language
C
C Version: 5.40
C Date: 2000, February 11
C
C Coded 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 References:
C     <A HREF="http://www.vrml.org/VRML1.0/vrml10c.html">
C     VRML (Virtual Reality Modeling Language) version 1.0C</A>
C     <A HREF="http://www.vrml.org/Specifications/VRML97/index.html">
C     VRML97 (Virtual Reality Modeling Language ISO/IEC 14772)</A>
C     <A HREF="http://pommard.ensg.u-nancy.fr/GOCAD">
C     GOCAD</A>
C
C.......................................................................
C                                                    <A NAME="data"></A>
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                                                     <A NAME="SEP"></A>
C Input data file 'SEP':
C     File 'SEP' has the form of the <A HREF="../forms/sep.htm">SEP</A>
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     LIN='string'... Name of the file with the polylines.
C             <A HREF="#LIN">Description of file LIN</A>
C             Default: LIN='lin.out'
C     COLORS='string'... Name of the file containing the data describing
C             the colour map.
C             <A HREF="colors.for#data">Description of file COLORS</A>
C             Not used if VRML='GOCAD'.
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 curves (PLine).
C             Default: VRML='VRML2' (recommended)
C     NAME='string'... String containing the GOCAD name of the set of
C             lines.
C             Used only if VRML='GOCAD'.  Obligatory parameter, must be
C             specified and cannot be blank if VRML='GOCAD'.
C Optional data to shift the lines:
C     SHIFT1=real, SHIFT2=real, SHIFT3=real... All lines will be shifted
C             by vector (SHIFT1,SHIFT2,SHIFT3).  The shift may be
C             applied to the lines situated at a surface to make them
C             visible.
C             SHIFT1=0., SHIFT2=0., SHIFT3=0.
C Data specifying the values to be scaled in colours:
C     KOLLIN=integer... If zero, all lines will have the same colour
C             given by parameters R, G, B.  If positive, the values in
C             KOLLIN-th column of input file LIN will be colour-coded
C             at each point on the lines.
C             Not used if VRML='GOCAD'.
C             Default: KOLLIN=0
C     PROPERTIES='string'... String containing names of properties
C             corresponding to optional values V1,...,VN (see file
C             <A HREF="#LIN">LIN</A>) which may be used to control the
C             colour of the line.  If the number of names is smaller
C             than the number of values, the leftmost values are
C             considered.  If PROPERTIES=' ', no values are considered
C             and GOCAD atom VRTX is used for the points (otherwise,
C             GOCAD atom PVRTX is used).
C             Used only if VRML='GOCAD'.
C             Default: PROPERTIES=' '
C Data specifying the colour scale (not used if VRML='GOCAD'):
C     VADD=real, VMUL=real, VPER=real, VREF=real, CREF=real, CREF1=real,
C     CREF2=real, CREF3=real, etc... Refer to file
C             <A HREF="colors.for#SEP">colors.for</A>.
C     R=real, G=real, B=real... Float numbers between 0 and 1 specifying
C             the colour of the lines if KOLLIN=0.
C             Defaults: R=1, G=1, B=1 (white)
C
C                                                     <A NAME="LIN"></A>
C Input file LIN with the lines:
C (1) None to several strings terminated by / (a slash)
C (2) For each line data (2.1), (2.2) and (2.3):
C (2.1) 'NAME',X1,X2,X3,/
C     'NAME'... Name of the line.  Not considered.  May be blank but
C             must be different from '$'.
C     X1,X2,X3... Optional coordinates of the reference point of the
C             line.  Not considered.
C     /...    List of values must be terminated by a slash.
C (2.2) For each point of the line data (2.2.1):
C (2.2.1) X1,X2,X3,V1,...,VN,/
C     X1,X2,X3... Coordinates of the point of the line.
C     V1,...,VN...Optional values which may be used to control the
C             colour of the line.
C     /...    List of values must be terminated by a slash.
C (2.3) /
C (3) / or end of file.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="ram.inc">ram.inc</A>
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,FLIN,FCOLS,FIN,FOUT
      INTEGER LU1,LU2,IUNDEF,MQ
      REAL UNDEF
      PARAMETER (LU1=1,LU12=2,IUNDEF=-999999,UNDEF=-999999.,MQ=30)
C
C     Other variables:
      CHARACTER*(8+8*MQ) FORMAT
      CHARACTER*5   VRML
      CHARACTER*255 TEXT
      INTEGER KOLLIN,KQ,NQ
      INTEGER MVRTX,NVRTX,IVRTX,IREF,IRGB,I1,I2,I
      REAL SHIFT1,SHIFT2,SHIFT3,RED,GREEN,BLUE,TRANSP
      REAL OUTMIN(MQ),OUTMAX(MQ),R,G,B
C     TEXT... Also used to copy lines from input WRL to output WRL file.
C
C.......................................................................
C
C     Reading main input data:
      WRITE(*,'(A)') '+LINWRL: Enter input filename: '
      FSEP=' '
      READ (LUIN1,'(a)') FSEP
      IF(FSEP.EQ.' ') THEN
C       <A NAME="error02"></A><FONT COLOR="RED">LINWRL-02</FONT>
        CALL ERROR('LINWRL-02: 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)') '+LINWRL: Working...            '

C
C     Reading input and output filenames:
      CALL RSEP1(LU1,FSEP)
      CALL RSEP3T('LIN'   ,FLIN ,'lin.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     Beginning of the output file:
C$$$      OPEN(LU2,FILE=FOUT)
C$$$      CALL WRL1(LU1,LU2,FIN,FOUT,VRML)
C
C     Determining the colour map:
      CALL RSEP3I('KOLLIN',KOLLIN,0)
      CALL RSEP3R('R'     ,RED   ,1.00)
      CALL RSEP3R('G'     ,GREEN ,1.00)
      CALL RSEP3R('B'     ,BLUE  ,1.00)
      MVRTX=MRAM/2
      IF(KOLLIN.GT.0) THEN
        CALL COLOR1(LU1,MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+1),1,0.,0.)
        IF (VRML.EQ.'pov') THEN
          CALL RSEP3R('TRANSP',TRANSP,0.)
C         WRITE(LU2,'(A)')
C    *     '#default {'
C    *    ,'  pigment {'
C    *    ,'    color_map {'
C         CALL COLOR3(MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+1),1,IREF,IRGB)
C         I=MVRTX+1+IRAM(MVRTX+1)
C         IREF=MVRTX+IREF
C         IRGB=MVRTX+IRGB
C         DO 57 I2=1,IRAM(MVRTX+2)-IRAM(MVRTX+1)
C           WRITE(LU2,'(A,F8.6,A,4(F4.2,A))')
C    *       '      [',RAM(I+I2),' rgbt <',
C    *                     (RAM(IRGB+I1),',',I1=3*I2-2,3*I2),TRANSP,'>]'
C  57     CONTINUE
C         WRITE(LU2,'(A)')
C    *     '    }'
C    *    ,'  }'
C    *    ,'}'
C         WRITE(LU2,'(A,G13.6,A)')
C    *     '#declare CREF = ',RAM(IREF+1),';'
C    *    ,'#declare VREF = ',RAM(IREF+2),';'
C    *    ,'#declare VPER = ',RAM(IREF+3),';'
        END IF
      END IF
C
C     Writing the prolog for the lines:
      IF (VRML.EQ.'vrml1') THEN
        IF(KOLLIN.LE.0) THEN
          WRITE(LU2,'(A)')
     *     'DEF LineMaterial Material {'
          WRITE(LU2,'(A,3(1X,F4.2))')
     *     '  emissiveColor',RED,GREEN,BLUE
          WRITE(LU2,'(A)')
     *     '}'
     *    ,' '
        END IF
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'Shape {'
     *  ,'  appearance DEF LineAppearance Appearance {'
     *  ,'    material Material {'
        IF(KOLLIN.LE.0) THEN
          WRITE(LU2,'(A,3(1X,F4.2))')
     *     '      emissiveColor',RED,GREEN,BLUE
        END IF
        WRITE(LU2,'(A)')
     *   '    }'
     *  ,'  }'
     *  ,'}'
      ELSE IF (VRML.EQ.'gocad') THEN
        WRITE(LU2,'(A)')
     *   'GOCAD PLine'
        CALL RSEP3T('NAME',TEXT,' ')
        IF (TEXT.NE.' ') THEN
          I=LENGTH(TEXT)
          WRITE(LU2,'(2A)')
     *     'HDR name:',TEXT(1:I)
        ELSE
C         <A NAME="error04"></A><FONT COLOR="RED">LINWRL-04</FONT>
          CALL ERROR('LINWRL-04: No name of GOCAD object')
C         Name of the GOCAD object (set of points) must be specified.
        END IF
        CALL RSEP3T('PROPERTIES',TEXT,' ')
        IF (TEXT.NE.' ') THEN
          I=LENGTH(TEXT)
          WRITE(LU2,'(2A)')
     *     'PROPERTIES ',TEXT(1:I)
          KOLLIN=4
          DO 11 I=1,I-2
            IF (TEXT(I:I).NE.' '.AND.TEXT(I+1:I+1).EQ.' ') THEN
              KOLLIN=KOLLIN+1
            END IF
   11     CONTINUE
        ELSE
          KOLLIN=0
        END IF
C     ELSE IF (VRML.EQ.'pov') THEN
C       ***
      ELSE
C       <A NAME="error03"></A><FONT COLOR="RED">LINWRL-03</FONT>
        CALL ERROR('LINWRL-03: No valid string in VRML')
C       Valid string specifying the form of the output file is:
C       VRML='VRML1' or 'VRML2'. Default and recommended
C       value is 'VRML2'.
      END IF
C
C     Optional shift:
      CALL RSEP3R('SHIFT1',SHIFT1,0.00)
      CALL RSEP3R('SHIFT2',SHIFT2,0.00)
      CALL RSEP3R('SHIFT3',SHIFT3,0.00)
C
C     Reading lines:
      KQ=MAX0(3,KOLLIN)
C     Values to be displayed will be shifted to the 4th column
      IF(VRML.EQ.'gocad') THEN
        NQ=KQ
      ELSE IF(KOLLIN.EQ.0) THEN
        NQ=3
      ELSE
        NQ=4
      END IF
      IF(NQ.GT.MQ) THEN
C       <A NAME="error04"></A><FONT COLOR="RED">LINWRL-04</FONT>
        CALL ERROR('LINWRL-04: Too small arrays OUTMIN and OUTMAX')
      END IF
      OPEN(LU1,FILE=FLIN,STATUS='OLD')
      READ(LU1,*) (TEXT,I=1,20)
C     Loop over lines:
      IVRTX=0
   60 CONTINUE
        NVRTX=0
        TEXT='$'
        READ(LU1,*,END=90) TEXT,R,R,R
        IF(TEXT.EQ.'$') THEN
          GO TO 90
        END IF
C       Reading the line points
   70   CONTINUE
          IF(NVRTX+KQ.GT.MVRTX) THEN
C           <A NAME="error01"></A><FONT COLOR="RED">LINWRL-01</FONT>
            CALL ERROR('LINWRL-01: Too small array RAM')
          END IF
          RAM(NVRTX+1)=UNDEF
          DO 71 I=NVRTX+2,NVRTX+KQ
            RAM(I)=0.
   71     CONTINUE
          READ(LU1,*,END=80) (RAM(I),I=NVRTX+1,NVRTX+KQ)
          IF(RAM(NVRTX+1).EQ.UNDEF) THEN
C           End of the line
            GO TO 80
          END IF
C         Relocating the values to be displayed to the 4th column
          IF(KOLLIN.GT.0) THEN
            RAM(NVRTX+4)=RAM(NVRTX+KOLLIN)
          END IF
C         Shifting the point
          RAM(NVRTX+1)=RAM(NVRTX+1)+SHIFT1
          RAM(NVRTX+2)=RAM(NVRTX+2)+SHIFT2
          RAM(NVRTX+3)=RAM(NVRTX+3)+SHIFT3
          IF(NVRTX.EQ.0) THEN
            DO 72 I=1,NQ
              OUTMIN(I)=RAM(NVRTX+I)
              OUTMAX(I)=RAM(NVRTX+I)
   72       CONTINUE
          ELSE
            DO 73 I=1,NQ
              OUTMIN(I)=AMIN1(OUTMIN(I),RAM(NVRTX+I))
              OUTMAX(I)=AMAX1(OUTMAX(I),RAM(NVRTX+I))
   73       CONTINUE
          END IF
          NVRTX=NVRTX+NQ
          IVRTX=IVRTX+1
        GO TO 70
   80   CONTINUE
        IF(NVRTX/NQ.LT.2) THEN
          GO TO 60
        END IF
C
C       Writing the line:
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)')
     *     'Separator {'
          IF(KOLLIN.GT.0) THEN
            WRITE(LU2,'(A)')
     *       'MaterialBinding { value PER_VERTEX }'
          ELSE
            WRITE(LU2,'(A)')
     *       'MaterialBinding { value OVERALL }'
     *      ,'USE LineMaterial'
          END IF
          WRITE(LU2,'(A)')
     *     'Coordinate3 { point ['
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)')
     *     'Line {'
     *    ,'appearance USE LineAppearance'
     *    ,'point ['
        ELSE IF (VRML.EQ.'pov') THEN
C         ***
        END IF
C
C       Writing the vertices:
        IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
          FORMAT='('
          CALL FORM2(3,OUTMIN(1),OUTMAX(1),FORMAT(2:25))
          DO 81 I=1,NVRTX,NQ
            WRITE(LU2,FORMAT) RAM(I),' ',RAM(I+1),' ',RAM(I+2),','
   81     CONTINUE
        ELSE IF (VRML.EQ.'gocad') THEN
          FORMAT='(A,I0,A,'
          FORMAT(5:5)=CHAR(ICHAR('1')+INT(ALOG10(FLOAT(IVRTX)+0.5)))
          CALL FORM2(NQ,OUTMIN(1),OUTMAX(1),FORMAT(9:8+8*NQ))
          IF (KOLLIN.EQ.0) THEN
            DO 82 I=1,NVRTX,NQ
              WRITE(LU2,FORMAT) 'VRTX ',IVRTX-(NVRTX-I)/NQ,
     *                          (' ',RAM(J),J=I,I+NQ-1)
   82       CONTINUE
          ELSE
            DO 83 I=1,NVRTX,NQ
              WRITE(LU2,FORMAT) 'PVRTX ',IVRTX-(NVRTX-I)/NQ,
     *                          (' ',RAM(J),J=I,I+NQ-1)
   83       CONTINUE
          END IF
        ELSE IF (VRML.EQ.'pov') THEN
C         Writing the vertices with values:
          FORMAT='(A,'
          CALL FORM2(NQ,OUTMIN,OUTMAX,FORMAT(4:27))
          FORMAT(27:38)=',3(F5.3,A),'
          CALL FORM2(1,OUTMIN(7),OUTMAX(7),FORMAT(39:46))
          DO 84 I=1,NVRTX-NQ,NQ
            WRITE(LU2,FORMAT)
     *        'VRTX(',(RAM(I1),',',I1=I,I+NQ-2),RAM(I+NQ-1),')'
   84     CONTINUE
        END IF
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') '] }'
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') ']'
        END IF
C
C       Writing the colours of the points:
        IF(KOLLIN.GT.0) THEN
          IF (VRML.EQ.'vrml1') THEN
            WRITE(LU2,'(A)') 'Material { emissiveColor ['
          ELSE IF (VRML.EQ.'vrml2') THEN
            WRITE(LU2,'(A)') 'color Color { color ['
          END IF
          IF (VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
            DO 85 I=NQ,NVRTX,NQ
              CALL COLOR2(MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+1),
     *                                                   1,RAM(I),R,G,B)
              WRITE(LU2,'(3(F4.2,A))') R,' ',G,' ',B,','
   85       CONTINUE
          END IF
          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 indices of the points:
        IF(VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') 'IndexedLineSet { coordIndex ['
        ELSE IF(VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') 'coordIndex ['
        END IF
        IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
          FORMAT='(10(I0,A))'
          I=INT(ALOG10(FLOAT(NVRTX/NQ)-0.5))+1
          FORMAT(6:6)=CHAR(ICHAR('0')+I)
          WRITE(LU2,FORMAT) (I1,', ',I1=0,NVRTX/NQ-2),NVRTX/NQ-1
        ELSE IF (VRML.EQ.'gocad') THEN
          FORMAT='(2(A,I0))'
          I=INT(ALOG10(FLOAT(IVRTX)+0.5))+1
          FORMAT(7:7)=CHAR(ICHAR('0')+I)
          WRITE(LU2,FORMAT)
     *                  ('SEG ',I1,' ',I1+1,I1=IVRTX-NVRTX/NQ+1,IVRTX-1)
        END IF
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') '] }'
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') ']'
        END IF
C
C       Writing the trailor for the line:
        IF (VRML.EQ.'vrml1') THEN
          WRITE(LU2,'(A)') '}'
        ELSE IF (VRML.EQ.'vrml2') THEN
          WRITE(LU2,'(A)') '}'
        END IF
      GO TO 60
C
   90 CONTINUE
C
C     Writing the trailor for the set of lines:
      IF (VRML.EQ.'gocad') THEN
        WRITE(LU2,'(A)') 'END'
      END IF
      CLOSE(LU1)
c$$      CLOSE(LU2)
      WRITE(*,'(A)') '+LINWRL: Done.                 '
      RETURN
      END
C
C
C draw interfaces
C
      subroutine Vrml_Surface(LUIN1,LU2)
C                                                            <HTML><PRE>
C Program SRFWRL to convert triangulated or polygonated surface into
C Virtual Reality Modeling Language
C
C Version: 5.30
C Date: 1999, June 11
C
C Coded 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 References:
C     <A HREF="http://www.vrml.org/VRML1.0/vrml10c.html">
C     VRML (Virtual Reality Modeling Language) version 1.0C</A>
C     <A HREF="http://www.vrml.org/Specifications/VRML97/index.html">
C     VRML97 (Virtual Reality Modeling Language ISO/IEC 14772)</A>
C     <A HREF="http://www.povray.org">
C     Persistence of Vision scene description language, version 3.1</A>
C
C.......................................................................
C
C                                                    <A NAME="data"></A>
C Description of the data files:
C
C Input data read from the * external unit:
C     The data are read in by the list directed input (free format)
C     using a single READ statement.
C (1) 'SEP',/
C     'SEP'...String in apostrophes containing the name of the input
C             SEP parameter file with the input data.
C             <A HREF="#SEP">Description of file SEP</A>
C     No default, obligatory parameter.
C
C                                                     <A NAME="SEP"></A>
C Data file 'SEP' has the form of the SEP (Stanford Exploration Project)
C parameter file:
C     All the data are specified in the form of PARAMETER=VALUE, e.g.
C     N1=50, with PARAMETER directly preceding = without intervening
C     spaces and with VALUE directly following = without intervening
C     spaces.  The PARAMETER=VALUE couple must be delimited by a space
C     or comma from both sides.
C     The PARAMETER string is not case-sensitive.
C     PARAMETER= followed by a space resets the default parameter value.
C     All other text in the input files is ignored.  The file thus may
C     contain unused data or comments without leading comment character.
C     Everything between comment character # and the end of the
C     respective line is ignored, too.
C     The PARAMETER=VALUE couples may be specified in any order.
C     The last appearance takes precedence.
C Data specifying input files:
C     VRTX='string'... Name of the file with vertices of the polygons.
C             <A HREF="#VRTX">Description of file VRTX</A>
C             Default: VRTX='vrtx.out'
C     TRGL='string'... Name of the file describing the triangles or
C             polygons.  Triangles are recommended.
C             <A HREF="#TRGL">Description of file TRGL</A>
C             Default: TRGL='trgl.out'
C     COLORS='string'... Name of the file containing the data describing
C             the colour map.
C             <A HREF="colors.for#data">Description of file COLORS</A>
C             Default: COLORS='hsv.dat'
C Input/output file:
C     WRL='string'... Name of the file to be modified or copied to the
C             beginning of the output file.  The default name of the
C             output file is equal to WRL.  If the filename is blank,
C             output file starts from a scratch (not reasonable).
C             It is recommended to specify WRL rather than to use the
C             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='POV':   POV (Persistence Of Vision) scene description
C                           language, version 3.1.
C             Default: VRML='VRML2' (recommended)
C Data specifying the values to be scaled in colours:
C     KOLPOS=integer...
C             Default: KOLPOS=7
C     KOLNEG=integer...
C             Default: KOLNEG=7
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             <A HREF="colors.for#SEP">colors.for</A>.
C     R=real, G=real, B=real... Float numbers between 0 and 1 specifying
C             the colour of the surfaces if 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             <A HREF="iniwrl.for#SEP">iniwrl.for</A>.
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             Default: SPECULAR=0 (default for VRML materials)
C     SHININESS=real... Shininess of the surfaces (sometimes called
C             transmit).  Values from 0 to 1.
C             Default: SHININESS=0.20 (default for VRML materials)
C
C                                                    <A NAME="VRTX"></A>
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,/
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.
C     /...    None to several values terminated by a slash.
C (3) / or end of file.
C
C                                                    <A NAME="PLGN"></A>
C (1) For each polygon data (1.1):
C (1.1) 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                                                    <A NAME="TRGL"></A>
C Input file TRGL with the triangles or polygons:
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             For polygon, three indices I1,I2,I3 are replaced with more
C             ones.
C     /...    List of vertices is terminated by a slash.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="ram.inc">ram.inc</A>
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
      PARAMETER (LU1=1,LU12=2,IUNDEF=-999999,MVRTX=99)
C     MVRTX...  Maximum number of vertices of a single polygon.
C
C     Other variables:
      CHARACTER*46  FORMAT
      CHARACTER*5   VRML
      CHARACTER*255 TEXT
      LOGICAL LNORM
      INTEGER KOLPOS,KOLNEG,KQ,NQ
      INTEGER NVRTX,NPLGN,IREF,IRGB,I1,I2,I,N
      REAL AMBI,TRANSP,SPEC,SHIN,RED,GREEN,BLUE
      REAL OUTMIN(8),OUTMAX(8),R,G,B,AUX
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 (LUIN1,*) FSEP
      IF(FSEP.EQ.' ') THEN
C       <A NAME="error07"></A><FONT COLOR="RED">SRFWRL-07</FONT>
        CALL ERROR('SRFWRL-07: 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)') '+SRFWRL: Working...            '

C
C     Reading input and output filenames:
      CALL RSEP1(LU1,FSEP)
      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     Beginning of the output file:
c$$$      OPEN(LU2,FILE=FOUT)

c               pause 'qqq'
c      CALL WRL1(LU1,LU2,FIN,FOUT,VRML)
c               pause 'sss'

C
C     Reading vertices:
      LNORM=.TRUE.
      CALL RSEP3I('KOLPOS',KOLPOS,7)
      CALL RSEP3I('KOLNEG',KOLNEG,7)
      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
      OPEN(LU1,FILE=FVRTX)
      READ(LU1,*) (TEXT,I=1,20)
      NVRTX=0
   10 CONTINUE
        IF(NVRTX+KQ.GT.MRAM) THEN
C         <A NAME="error01"></A><FONT COLOR="RED">SRFWRL-01</FONT>
          CALL ERROR('SRFWRL-01: Too small array RAM')
        END IF
        TEXT='$'
        RAM(NVRTX+4)=0.
        RAM(NVRTX+5)=0.
        RAM(NVRTX+6)=0.
        IF(KOLPOS.GT.0) THEN
          RAM(NVRTX+KOLPOS)=0.
        END IF
        IF(KOLNEG.GT.0) THEN
          RAM(NVRTX+KOLNEG)=0.
        END IF
        READ(LU1,*,END=19) TEXT,(RAM(I),I=NVRTX+1,NVRTX+KQ)
        IF(TEXT.EQ.'$') THEN
          GO TO 19
        END IF
C       Shifting the values to be displayed to the 7th and 8th columns
        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
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
        IF(NVRTX.EQ.0) THEN
          DO 11 I=1,NQ
            OUTMIN(I)=RAM(NVRTX+I)
            OUTMAX(I)=RAM(NVRTX+I)
   11     CONTINUE
        ELSE
          DO 12 I=1,NQ
            OUTMIN(I)=AMIN1(OUTMIN(I),RAM(NVRTX+I))
            OUTMAX(I)=AMAX1(OUTMAX(I),RAM(NVRTX+I))
   12     CONTINUE
        END IF
        NVRTX=NVRTX+NQ
      GO TO 10
   19 CONTINUE
      CLOSE(LU1)
      IF(NQ.GE.8) THEN
        OUTMIN(7)=AMIN1(OUTMIN(7),OUTMIN(8))
        OUTMAX(7)=AMAX1(OUTMAX(7),OUTMAX(8))
      END IF
C     Values to be displayed have been shifted to the 7th or 8th columns
      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
C
C     Reading input parameters for surface appearance:
      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     Determining the colour map:
      IF(KOLPOS.GT.0.OR.KOLNEG.GT.0) THEN
        CALL COLOR1(LU1,MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1),
     *                                            1,OUTMIN(7),OUTMAX(7))
        IF (VRML.EQ.'pov') THEN
          AUX=0.01/SHININ
          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),';'
        END IF
      END IF
C
C     Writing the prolog for the surface:
      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=<PTS[I1][0],PTS[I1][1],PTS[I1][2]>;'
     *  ,'  #local X2=<PTS[I2][0],PTS[I2][1],PTS[I2][2]>;'
     *  ,'  #local X3=<PTS[I3][0],PTS[I3][1],PTS[I3][2]>;'
     *  ,'  #local Z1=<PTS[I1][3],PTS[I1][4],PTS[I1][5]>;'
     *  ,'  #local Z2=<PTS[I2][3],PTS[I2][4],PTS[I2][5]>;'
     *  ,'  #local Z3=<PTS[I3][3],PTS[I3][4],PTS[I3][5]>;'
     *  ,'  #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 <vdot(G0,x),vdot(G0,y),vdot(G0,z),'
     *  ,'                vdot(G1,x),vdot(G1,y),vdot(G1,z),'
     *  ,'                vdot(G2,x),vdot(G2,y),vdot(G2,z),0,0,0>'
     *  ,'        translate X3'
     *  ,'      }'
     *  ,'    }'
     *  ,'  }'
     *  ,'#end'
      ELSE
C       <A NAME="error08"></A><FONT COLOR="RED">SRFWRL-08</FONT>
        CALL ERROR('SRFWRL-08: No valid string in VRML')
C       Valid string specifying the form of the output file is:
C       VRML='VRML1' or 'VRML2' or 'POV'. Default and recommended
C       value is 'VRML2'.
      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.'pov') THEN
C       Writing the vertices with normals and values:
        IF(KOLNEG.NE.KOLPOS) THEN
C         <A NAME="error51"></A><FONT COLOR="RED">SRFWRL-51</FONT>
          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 61 I=1,NVRTX,NQ
       WRITE(LU2,FORMAT) 'VRTX(',(RAM(I1),',',I1=I,I+5),RAM(I+6),')'
   61   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 62 I=4,NVRTX,NQ
            WRITE(LU2,FORMAT) RAM(I),' ',RAM(I+1),' ',RAM(I+2),','
   62     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 63 I=4,NVRTX,NQ
           WRITE(LU2,FORMAT) -RAM(I),' ',-RAM(I+1),' ',-RAM(I+2),','
   63     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         <A NAME="error02"></A><FONT COLOR="RED">SRFWRL-02</FONT>
          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           <A NAME="error03"></A><FONT COLOR="RED">SRFWRL-03</FONT>
            WRITE(TEXT,'(A,I6)')'SRFWRL-03: Wrong vertex index:',IRAM(I)
            CALL ERROR(TEXT(1:LENGTH(TEXT)))
          END IF
   83   CONTINUE
C         <A NAME="error04"></A><FONT COLOR="RED">SRFWRL-04</FONT>
          CALL ERROR('SRFWRL-04: Too many vertices in polygons')
   84   CONTINUE
        IF(N.LT.3) THEN
C         <A NAME="error52"></A><FONT COLOR="RED">SRFWRL-52</FONT>
          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           <A NAME="error05"></A><FONT COLOR="RED">SRFWRL-05</FONT>
            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.'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             <A NAME="error06"></A><FONT COLOR="RED">SRFWRL-06</FONT>
              CALL ERROR('SRFWRL-06: 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)') '}'
      END IF
c$$$      CLOSE(LU2)
      WRITE(*,'(A)') '+INIWRL: Done.                 '
      return
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     <A HREF="../../forms/error.for">error.for</A>
      INCLUDE 'sep.for'
C     <A HREF="../../forms/sep.for">sep.for</A>
      INCLUDE 'length.for'
C     <A HREF="../../forms/length.for">length.for</A>
      INCLUDE 'forms.for'
C     <A HREF="../../forms/forms.for">forms.for</A>
      INCLUDE 'colors.for'
C     <A HREF="../../forms/colors.for">colors.for</A>
      INCLUDE 'wrl.for'
C     <A HREF="../../forms/wrl.for">wrl.for</A>
C
C=======================================================================
C                                                                 </PRE>
