C 
C Program PTSWRL to convert points into Virtual Reality Modeling
C Language
C
C Version: 5.30
C Date: 1999, June 10
C
C Coded by: Vaclav Bucha
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: 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.......................................................................
C
C                                                    
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             Description of file SEP
C     No default, obligatory parameter.
C
C                                                     
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     PTS='string'... Name of the file with the points.
C             Description of file PTS
C             Default: PTS='pts.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 copied to the beginning
C             of the output file.  The default name of the output file
C             is equal to WRL.  If the filename is blank, output file
C             starts from a scratch.  It is recommended to specify WRL
C             rather than to use 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             Default: VRML='VRML2' (recommended)
C Optional data to shift the points:
C     SHIFT1=real, SHIFT2=real, SHIFT3=real... All points will be shifted
C             by vector (SHIFT1,SHIFT2,SHIFT3).  The shift may be
C             applied to the points 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     KOLPTS=integer... If zero, all points will have the same colour
C             given by parameters R, G, B.  If positive, the
C             values in KOLPTS-th column of input file PTS will be
C             colour coded at each point.
C             Default: KOLPTS=0
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 points if KOLPTS=0.
C             Defaults: R=1, G=1, B=1 (white)
C
C                                                     
C Input file PTS with the points:
C (1) None to several strings terminated by / (a slash)
C (2) For each point data:
C (2.1) 'NAME',X1,X2,X3,V1,...,VN,/
C     'NAME'... Name of the point.  Not considered.  May be blank.
C     X1,X2,X3... Coordinates of the point
C     V1,...,VN...Optional values which may be used to control the
C             colour of the line.
C     /...    Values must be terminated by a slash.
C (3) / 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,FPTS,FCOLS,FIN,FOUT
      INTEGER LU1,LU2,IUNDEF
      REAL UNDEF
      PARAMETER (LU1=1,LU2=2,IUNDEF=-999999,UNDEF=-999999.)
C
C     Other variables:
      CHARACTER*46  FORMAT
      CHARACTER*5   VRML
      CHARACTER*255 TEXT
      INTEGER KOLPTS,KQ,NQ
      INTEGER MVRTX,NVRTX,I
      REAL SHIFT1,SHIFT2,SHIFT3,RED,GREEN,BLUE
      REAL OUTMIN(8),OUTMAX(8),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)') '+PTSWRL: Enter input filename: '
      FSEP=' '
      READ (*,*) FSEP
      IF(FSEP.EQ.' ') THEN
C       PTSWRL-02
        CALL ERROR('PTSWRL-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)') '+PTSWRL: Working...            '
C
C     Reading input and output filenames:
      CALL RSEP1(LU1,FSEP)
      CALL RSEP3T('PTS'   ,FPTS ,'pts.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:
      OPEN(LU2,FILE=FOUT)
      CALL WRL1(LU1,LU2,FIN,FOUT,VRML)
C
C     Determining the colour map:
      CALL RSEP3I('KOLPTS',KOLPTS,0)
      CALL RSEP3R('R'     ,RED   ,1.00)
      CALL RSEP3R('G'     ,GREEN ,1.00)
      CALL RSEP3R('B'     ,BLUE  ,1.00)
      MVRTX=MRAM/2
      IF(KOLPTS.GT.0) THEN
        CALL COLOR1(LU1,MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+1),1,0.,0.)
        IF (VRML.EQ.'pov') THEN
C         ***
        END IF
      END IF
C
C     Writing the prolog for the points:
      IF (VRML.EQ.'vrml1') THEN
        IF(KOLPTS.LE.0) THEN
          WRITE(LU2,'(A)')
     *     'DEF PointMaterial 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 PointAppearance Appearance {'
     *  ,'    material Material {'
        IF(KOLPTS.LE.0) THEN
          WRITE(LU2,'(A,3(1X,F4.2))')
     *     '      emissiveColor',RED,GREEN,BLUE
        END IF
        WRITE(LU2,'(A)')
     *   '    }'
     *  ,'  }'
     *  ,'}'
     *  ,' '
C     ELSE IF (VRML.EQ.'pov') THEN
C       ***
      ELSE
C       PTSWRL-03
        CALL ERROR('PTSWRL-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 points:
      KQ=MAX0(3,KOLPTS)
C     Values to be displayed will be shifted to the 4th column
      IF(KOLPTS.EQ.0) THEN
        NQ=3
      ELSE
        NQ=4
      END IF
      OPEN(LU1,FILE=FPTS,STATUS='OLD')
      READ(LU1,*) (TEXT,I=1,20)
C     Writing the point:
      IF (VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)')
     *   'Separator {'
        IF(KOLPTS.GT.0) THEN
          WRITE(LU2,'(A)')
     *     'MaterialBinding { value PER_VERTEX }'
        ELSE
          WRITE(LU2,'(A)')
     *     'MaterialBinding { value OVERALL }'
     *    ,'USE PointMaterial'
        END IF
        WRITE(LU2,'(A)')
     *   'Coordinate3 { point ['
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'Point {'
     *  ,'appearance USE PointAppearance'
     *  ,'point ['
      END IF
C     Loop over points:
      NVRTX=0
C     Reading the points
   70 CONTINUE
        IF(NVRTX+KQ.GT.MVRTX) THEN
C         PTSWRL-01
          CALL ERROR('PTSWRL-01: Too small array RAM')
        END IF
        IF(KOLPTS.GT.3) THEN
          RAM(NVRTX+KOLPTS)=0.
        END IF
        TEXT='$'
        READ(LU1,*,END=80) TEXT,(RAM(I),I=NVRTX+1,NVRTX+KQ)
        IF(TEXT.EQ.'$') THEN
          GO TO 80
        END IF
C       Relocating the values to be displayed to the 4th column
        IF(KOLPTS.GT.0) THEN
          RAM(NVRTX+4)=RAM(NVRTX+KOLPTS)
        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 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 70
   80 CONTINUE
C
C     Writing the points:
      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.'pov') THEN
C       Writing the vertices with values:
C       ***
      END IF
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
C
C     Writing the colours of the points:
      IF(KOLPTS.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 83 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,','
   83     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 trailor for the line:
      IF (VRML.EQ.'vrml1') THEN
        WRITE(LU2,'(A)') 'PointSet { }'
        WRITE(LU2,'(A)') '}'
      ELSE IF (VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)') '}'
      END IF
C
   90 CONTINUE
      CLOSE(LU1)
      CLOSE(LU2)
      WRITE(*,'(A)') '+PTSWRL: 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