C
C Program PTSWRL to convert points into Virtual Reality Modeling C Language C C Version: 5.40 C Date: 2000, February 7 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 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 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 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 points (VSet). C Default: VRML='VRML2' (recommended) C NAME='string'... String containing the GOCAD name of the set of C points. 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 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 Not used if VRML='GOCAD'. C Default: KOLPTS=0 C PROPERTIES='string'... String containing names of properties C corresponding to optional values V1,...,VN (see file C PTS) which may be used to control the C colour of the point. 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 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 point. 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,MQ REAL UNDEF PARAMETER (LU1=1,LU2=2,IUNDEF=-999999,UNDEF=-999999.,MQ=30) 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(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)') '+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)') * ' }' * ,' }' * ,'}' * ,' ' ELSE IF (VRML.EQ.'gocad') THEN WRITE(LU2,'(A)') * 'GOCAD VSet' CALL RSEP3T('NAME',TEXT,' ') IF (TEXT.NE.' ') THEN I=LENGTH(TEXT) WRITE(LU2,'(2A)') * 'HDR name:',TEXT(1:I) ELSE C PTSWRL-04 CALL ERROR('PTSWRL-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) KOLPTS=4 DO 11 I=1,I-2 IF (TEXT(I:I).NE.' '.AND.TEXT(I+1:I+1).EQ.' ') THEN KOLPTS=KOLPTS+1 END IF 11 CONTINUE ELSE KOLPTS=0 END IF 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(VRML.EQ.'gocad') THEN NQ=KQ ELSE IF(KOLPTS.EQ.0) THEN NQ=3 ELSE NQ=4 END IF IF(NQ.GT.MQ) THEN C PTSWRL-04 CALL ERROR('PTSWRL-04: Too small arrays OUTMIN and OUTMAX') 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 DO 71 I=1,KQ RAM(NVRTX+I)=0. 71 CONTINUE 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 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 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.'gocad') THEN FORMAT='(A,I0,A,' FORMAT(5:5)=CHAR(ICHAR('1')+INT(ALOG10(FLOAT(NVRTX/NQ)+0.5))) CALL FORM2(NQ,OUTMIN(1),OUTMAX(1),FORMAT(9:8+8*NQ)) IF (KOLPTS.EQ.0) THEN DO 82 I=1,NVRTX,NQ WRITE(LU2,FORMAT) 'VRTX ',I/NQ+1,(' ',RAM(J),J=I,I+NQ-1) 82 CONTINUE ELSE DO 83 I=1,NVRTX,NQ WRITE(LU2,FORMAT) 'PVRTX ',I/NQ+1,(' ',RAM(J),J=I,I+NQ-1) 83 CONTINUE END IF ELSE IF (VRML.EQ.'pov') THEN C Writing the vertices with values: C *** END IF C Writing the trailor for the point: 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 84 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,',' 84 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 point set: IF (VRML.EQ.'vrml1') THEN WRITE(LU2,'(A)') 'PointSet { }' WRITE(LU2,'(A)') '}' ELSE IF (VRML.EQ.'vrml2') THEN WRITE(LU2,'(A)') '}' ELSE IF (VRML.EQ.'gocad') THEN WRITE(LU2,'(A)') 'END' END IF CLOSE(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