'
* ,' 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
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
C VRML (Virtual Reality Modeling Language) version 1.0C
C
C VRML97 (Virtual Reality Modeling Language ISO/IEC 14772)
C
C GOCAD
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 LIN='string'... Name of the file with the polylines.
C Description of file LIN
C Default: LIN='lin.out'
C COLORS='string'... Name of the file containing the data describing
C the colour map.
C Description of file COLORS
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 LIN) 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 colors.for.
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
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 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,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 LINWRL-02
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 LINWRL-04
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 LINWRL-03
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 LINWRL-04
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 LINWRL-01
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
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
C VRML (Virtual Reality Modeling Language) version 1.0C
C
C VRML97 (Virtual Reality Modeling Language ISO/IEC 14772)
C
C Persistence of Vision scene description language, version 3.1
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 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.
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 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 colors.for.
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 iniwrl.for.
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
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
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
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 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
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 SRFWRL-07
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 SRFWRL-01
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=;'
* ,' #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'
ELSE
C SRFWRL-08
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 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 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 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.'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-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 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 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