C
C Program PTSWRL to convert points into the Virtual Reality Modeling C Language or GOCAD representation C C Version: 5.60 C Date: 2002, May 17 C C Coded by: Ludek Klimes & Vaclav Bucha C Department of Geophysics, Charles University Prague, C Ke Karlovu 3, 121 16 Praha 2, Czech Republic, C E-mails: klimes@seis.karlov.mff.cuni.cz C bucha@seis.karlov.mff.cuni.cz C C References: C C VRML (Virtual Reality Modeling Language) version 1.0C C C VRML97 (Virtual Reality Modeling Language ISO/IEC 14772) C C GOCAD C C....................................................................... 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 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. Be sure to select different names for all objects C within the GOCAD file. C The same name is used for the corresponding colour scale, C written if KOLPTS is positive. 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 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. The names are separated by blanks. C If the number of names is smaller than the number of C values, the leftmost values are considered. PROPERTIES C must be specified if VRML='GOCAD' and KOLPTS is positive. C If KOLPTS is 1, 2 or 3, the last name is assumed to denote C the KOLPTSth coordinate rather than the quantity in the C corresponding column, and the value of the coordinate C copied into that column. C If PROPERTIES=' ', no values are considered and GOCAD atom C VRTX is used for the vertices (otherwise, GOCAD atom PVRTX C is used). C Used only if VRML='GOCAD'. C Default: PROPERTIES=' ' C Data specifying the colour scale: C VADD=real, VMUL=real, VPER=real, VREF=real, CREF=real, CREF1=real, C CREF2=real, CREF3=real, etc... Refer to file C colors.for. C R=real, G=real, B=real... Float numbers between 0 and 1 specifying C the colour of the 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 NAME,TEXT INTEGER KOLPTS,KQ,NQ INTEGER NVRTX,I0,I1,I2,I REAL SHIFT1,SHIFT2,SHIFT3,RED,GREEN,BLUE REAL OUTMIN(MQ),OUTMAX(MQ),R,G,B,AUX,AUXA(1) C C....................................................................... C C Reading main input data: WRITE(*,'(A)') '+PTSWRL: Enter input filename: ' FSEP=' ' READ (*,*) FSEP IF(FSEP.EQ.' ') THEN C PTSWRL-01 CALL ERROR('PTSWRL-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 CALL RSEP1(LU1,FSEP) WRITE(*,'(A)') '+PTSWRL: Working... ' C C Reading input and output filenames: 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 Optional shift: CALL RSEP3R('SHIFT1',SHIFT1,0.00) CALL RSEP3R('SHIFT2',SHIFT2,0.00) CALL RSEP3R('SHIFT3',SHIFT3,0.00) C C Reading the data for colours: CALL RSEP3I('KOLPTS',KOLPTS,0) CALL RSEP3R('R' ,RED ,1.00) CALL RSEP3R('G' ,GREEN ,1.00) CALL RSEP3R('B' ,BLUE ,1.00) C C Opening the output file and writing its beginning: CALL WRL1(LU1,LU2,FIN,FOUT,VRML,1) C C Writing the prolog for the points (part 1): 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 CALL RSEP3T('NAME',NAME,' ') C Subroutine WRL has already checked that NAME is not blank. WRITE(LU2,'(A)') * 'GOCAD VSet 1.0' WRITE(LU2,'(2A)') * 'HDR name:',NAME(1:LENGTH(NAME)) WRITE(LU2,'(A)') * 'HDR *visible:true' * ,'HDR *atoms*symbol:point' * ,'HDR *atoms*size:3' CALL RSEP3T('PROPERTIES',TEXT,' ') I0=1 KQ=3 DO 11 I=1,LEN(TEXT)-1 IF (TEXT(I:I).EQ.' '.AND.TEXT(I+1:I+1).NE.' ') THEN I0=I+1 END IF IF (TEXT(I:I).NE.' '.AND.TEXT(I+1:I+1).EQ.' ') THEN KQ=KQ+1 IF (KQ.EQ.KOLPTS.OR.(1.LE.KOLPTS.AND.KOLPTS.LE.3)) THEN I1=I0 I2=I END IF END IF 11 CONTINUE IF (KOLPTS.LE.0) THEN WRITE(LU2,'(3(A,F4.2))') * 'HDR *atoms*color: ',RED,' ',GREEN,' ',BLUE ELSE IF (KQ.LT.KOLPTS.OR.KQ.LT.4) THEN C PTSWRL-02 CALL ERROR('PTSWRL-02: GOCAD property name not specified') C If KOLPTS is not zero, list PROPERTIES of property names C must contain MAX(1,KOLPTS-3) names at the least, see the C description of the input data. END IF WRITE(LU2,'(A)') * 'HDR *painted:true' WRITE(LU2,'(2A)') * 'HDR *painted*variable:',TEXT(I1:I2) END IF IF (KQ.GT.3) THEN WRITE(LU2,'(2A)') * 'PROPERTIES ',TEXT(1:LENGTH(TEXT)) END IF IF (KOLPTS.NE.0) THEN WRITE(LU2,'(2A)') * 'PROPERTY_CLASSES ',TEXT(1:LENGTH(TEXT)) WRITE(LU2,'(3A)') * 'PROPERTY_CLASS_HEADER ',TEXT(I1:I2),' {' C The output file now waits for the colour scale. END IF C KQ is the number of coordinates and properties at each point. 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' or 'GOCAD'. Default and recommended C value is 'VRML2'. END IF C C Determining number NQ of values stored at each point: IF(VRML.EQ.'gocad') THEN NQ=KQ ELSE KQ=MAX0(3,KOLPTS) IF(KOLPTS.EQ.0) THEN NQ=3 ELSE NQ=4 END IF C Values to be displayed will be shifted to the 4th column END IF IF(NQ.GT.MQ) THEN C PTSWRL-04 CALL ERROR('PTSWRL-04: Too small arrays OUTMIN and OUTMAX') END IF C C Reading points: OPEN(LU1,FILE=FPTS,STATUS='OLD') READ(LU1,*) (TEXT,I=1,20) NVRTX=0 20 CONTINUE IF(NVRTX+KQ.GT.MRAM) THEN C PTSWRL-05 CALL ERROR('PTSWRL-05: Too small array RAM') END IF TEXT='$' DO 21 I=NVRTX+1,NVRTX+KQ RAM(I)=0. 21 CONTINUE READ(LU1,*,END=29) TEXT,(RAM(I),I=NVRTX+1,NVRTX+KQ) IF(TEXT.EQ.'$') THEN GO TO 29 END IF C Relocating the values to be displayed IF(VRML.EQ.'gocad') THEN IF(1.LE.KOLPTS.AND.KOLPTS.LE.3) THEN RAM(NVRTX+KQ)=RAM(NVRTX+KOLPTS) END IF ELSE IF(KOLPTS.GT.0) THEN RAM(NVRTX+4)=RAM(NVRTX+KOLPTS) END IF 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 C Determining the minimum and maximum values IF(NVRTX.EQ.0) THEN DO 22 I=1,NQ OUTMIN(I)=RAM(NVRTX+I) OUTMAX(I)=RAM(NVRTX+I) 22 CONTINUE ELSE DO 23 I=1,NQ OUTMIN(I)=AMIN1(OUTMIN(I),RAM(NVRTX+I)) OUTMAX(I)=AMAX1(OUTMAX(I),RAM(NVRTX+I)) 23 CONTINUE END IF C Number of storage locations in RAM used for the points NVRTX=NVRTX+NQ GO TO 20 29 CONTINUE CLOSE(LU1) C NVRTX is the number of storage locations in RAM used for points C C Determining the colour map: IF(KOLPTS.GT.0) THEN IF(VRML.EQ.'gocad') THEN CALL COLOR1(LU1,MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1), * 1,OUTMIN(KOLPTS),OUTMAX(KOLPTS)) WRITE(LU2,'(2A)') * ' *colormap:',NAME(1:LENGTH(NAME)) FORMAT='(A,' CALL FORM2(1,OUTMIN(KOLPTS),OUTMAX(KOLPTS),FORMAT(4:11)) FORMAT(9:11)=') ' IF(OUTMAX(KOLPTS).GT.OUTMIN(KOLPTS)) THEN WRITE(LU2,FORMAT) * ' *low_clip: ',OUTMIN(KOLPTS) * ,' *high_clip:',OUTMAX(KOLPTS) ELSE WRITE(LU2,FORMAT) * ' *low_clip: ',OUTMIN(KOLPTS) * ,' *high_clip:',OUTMIN(KOLPTS)+1. END IF WRITE(LU2,'(4A)') * ' *colormap*',NAME(1:LENGTH(NAME)),'*colors: ',CHAR(92) AUX=(OUTMAX(KOLPTS)-OUTMIN(KOLPTS))/255. DO 31 I=0,255 AUXA(1)=OUTMIN(KOLPTS)+FLOAT(I)*AUX CALL COLOR2(MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1), * 1,AUXA,R,G,B) IF (I.LT.255) THEN WRITE(LU2,'(I5,3(1X,F4.2),2A)') * I,R,G,B,' ',CHAR(92) ELSE WRITE(LU2,'(I5,3(1X,F4.2),2A)') * I,R,G,B END IF 31 CONTINUE WRITE(LU2,'(A)') * '}' C ELSE IF (VRML.EQ.'pov') THEN C *** ELSE CALL COLOR1(LU1,MRAM-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+1), * 1,OUTMIN(4),OUTMAX(4)) END IF END IF C C Writing the prolog for the points (part 2): 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 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 I0=1,NVRTX,NQ WRITE(LU2,FORMAT) 'VRTX ',I0/NQ+1,(' ',RAM(I),I=I0,I0+NQ-1) 82 CONTINUE ELSE DO 83 I0=1,NVRTX,NQ WRITE(LU2,FORMAT) 'PVRTX ',I0/NQ+1,(' ',RAM(I),I=I0,I0+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-NVRTX,IRAM(NVRTX+1),RAM(NVRTX+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(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