C
C Program LINWRL to convert lines into the Virtual Reality Modeling C Language or GOCAD representation C C Version: 6.10 C Date: 2006, October 10 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 http://sw3d.cz/staff/klimes.htm C http://sw3d.cz/staff/bucha.htm 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 C COLORS C Default: COLORS='hsv.dat' C Input/output file: C WRL='string'... Name of the file to be supplemented with lines 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. 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 KOLLIN 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 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 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. 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 KOLLIN is positive. C If KOLLIN is 1, 2 or 3, the last name is assumed to denote C the KOLLINth coordinate instead of the quantity in the C corresponding 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 lines if KOLLIN=0. C Defaults: R=1, G=1, B=1 (white) C Optional parameters specifying the form of the real quantities C written in the output formatted files: C MINDIG,MAXDIG=positive integers ... See the description in file C forms.for. 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, * UARRAY REAL UARRAY INTEGER LENGTH C C Filenames and parameters: CHARACTER*80 FSEP,FLIN,FIN,FOUT INTEGER LU1,LU2,LU3,IUNDEF,MQ REAL UNDEF PARAMETER (LU1=1,LU2=2,LU3=3,IUNDEF=-999999,MQ=30) C C Other variables: CHARACTER*(8+8*MQ) FORMAT CHARACTER*5 VRML CHARACTER*255 NAME,TEXT INTEGER KOLLIN,KQ,NQ INTEGER MVRTX,NVRTX,IVRTX,I0,I1,I2,I REAL SHIFT1,SHIFT2,SHIFT3,RED,GREEN,BLUE,TRANSP REAL OUTMIN(MQ),OUTMAX(MQ),R,G,B,AUX,AUXA(1) C UNDEF=UARRAY() C C....................................................................... C C Reading main input data: WRITE(*,'(A)') '+LINWRL: Enter input filename: ' FSEP=' ' READ (*,*) FSEP IF(FSEP.EQ.' ') THEN C LINWRL-01 CALL ERROR('LINWRL-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)') '+LINWRL: Working... ' C C Reading input and output filenames: CALL RSEP3T('LIN' ,FLIN ,'lin.out') 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('KOLLIN',KOLLIN,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 lines (part 1): 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 CALL RSEP3T('NAME',NAME,' ') C Subroutine WRL has already checked that NAME is not blank. WRITE(LU2,'(A)') * 'GOCAD PLine 1.0' WRITE(LU2,'(2A)') * 'HDR name:',NAME(1:LENGTH(NAME)) WRITE(LU2,'(A)') * 'HDR *atoms:false' * ,'HDR *visible:true' 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.KOLLIN.OR.(1.LE.KOLLIN.AND.KOLLIN.LE.3)) THEN I1=I0 I2=I END IF END IF 11 CONTINUE IF (KOLLIN.LE.0) THEN WRITE(LU2,'(3(A,F4.2))') * 'HDR *line*color: ',RED,' ',GREEN,' ',BLUE ELSE IF (KQ.LT.KOLLIN.OR.KQ.LT.4) THEN C SRFWRL-02 CALL ERROR('SRFWRL-02: GOCAD property name not specified') C If KOLLIN is not zero, list PROPERTIES of property names C must contain MAX(1,KOLLIN-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 (KOLLIN.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 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' 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,KOLLIN) IF(KOLLIN.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 LINWRL-04 CALL ERROR('LINWRL-04: Too small arrays OUTMIN and OUTMAX') END IF C C Determining the minima and maxima of quantities at line points: OPEN(LU1,FILE=FLIN,STATUS='OLD') READ(LU1,*) (TEXT,I=1,20) IVRTX=0 MVRTX=0 19 CONTINUE C Beginning of the line: NVRTX=0 TEXT='$' READ(LU1,*,END=39) TEXT,R,R,R IF(TEXT.EQ.'$') THEN C End of the file GO TO 39 END IF C Loop over the points of the line: 20 CONTINUE RAM(1)=UNDEF DO 21 I=2,KQ RAM(I)=0. 21 CONTINUE READ(LU1,*,END=29) (RAM(I),I=1,KQ) IF(RAM(1).EQ.UNDEF) THEN C End of the line GO TO 29 END IF C Relocating the values to be displayed IF(VRML.EQ.'gocad') THEN IF(1.LE.KOLLIN.AND.KOLLIN.LE.3) THEN RAM(KQ)=RAM(KOLLIN) END IF ELSE IF(KOLLIN.GT.0) THEN RAM(4)=RAM(KOLLIN) END IF END IF C Determining the minimum and maximum values IF(IVRTX.EQ.0) THEN DO 22 I=1,NQ OUTMIN(I)=RAM(I) OUTMAX(I)=RAM(I) 22 CONTINUE ELSE DO 23 I=1,NQ OUTMIN(I)=AMIN1(OUTMIN(I),RAM(I)) OUTMAX(I)=AMAX1(OUTMAX(I),RAM(I)) 23 CONTINUE END IF C Number of storage locations in RAM to be used for the points NVRTX=NVRTX+NQ MVRTX=MAX0(NVRTX+KQ,MVRTX+KQ) IF(MVRTX.GT.MRAM) THEN C LINWRL-05 CALL ERROR('LINWRL-05: Too small array RAM') END IF C Total number of points of all lines IVRTX=IVRTX+1 GO TO 20 29 CONTINUE GO TO 19 39 CONTINUE C C Determining the colour map: IF(KOLLIN.GT.0) THEN IF(VRML.EQ.'gocad') THEN CALL COLOR1(LU3,MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+1), * 1,OUTMIN(KOLLIN),OUTMAX(KOLLIN)) WRITE(LU2,'(2A)') * ' *colormap:',NAME(1:LENGTH(NAME)) FORMAT='(A,' CALL FORM2(1,OUTMIN(KOLLIN),OUTMAX(KOLLIN),FORMAT(4:11)) FORMAT(9:11)=') ' IF(OUTMAX(KOLLIN).GT.OUTMIN(KOLLIN)) THEN WRITE(LU2,FORMAT) * ' *low_clip: ',OUTMIN(KOLLIN) * ,' *high_clip:',OUTMAX(KOLLIN) ELSE WRITE(LU2,FORMAT) * ' *low_clip: ',OUTMIN(KOLLIN) * ,' *high_clip:',OUTMIN(KOLLIN)+1. END IF WRITE(LU2,'(4A)') * ' *colormap*',NAME(1:LENGTH(NAME)),'*colors: ',CHAR(92) AUX=(OUTMAX(KOLLIN)-OUTMIN(KOLLIN))/255. DO 31 I=0,255 AUXA(1)=OUTMIN(KOLLIN)+FLOAT(I)*AUX CALL COLOR2(MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+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)') * '}' ELSE 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),';' ELSE CALL COLOR1(LU3,MRAM-MVRTX,IRAM(MVRTX+1),RAM(MVRTX+1), * 1,OUTMIN(4),OUTMAX(4)) END IF END IF C C Writing the prolog for the lines (part 2): IF (VRML.EQ.'vrml1') THEN CONTINUE ELSE IF (VRML.EQ.'vrml2') THEN CONTINUE END IF C C Loop over lines: REWIND(LU1) READ(LU1,*) (TEXT,I=1,20) IVRTX=0 60 CONTINUE C Beginning of the line: NVRTX=0 TEXT='$' READ(LU1,*,END=90) TEXT,R,R,R IF(TEXT.EQ.'$') THEN C End of the file GO TO 90 END IF C C Reading the line points: 70 CONTINUE IF(NVRTX+KQ.GT.MVRTX) THEN C LINWRL-06 CALL ERROR('LINWRL-06: Strange error') C This error should not appear. Contact the author. END IF RAM(NVRTX+1)=UNDEF DO 71 I=NVRTX+2,NVRTX+KQ RAM(I)=0. 71 CONTINUE READ(LU1,*,END=79) (RAM(I),I=NVRTX+1,NVRTX+KQ) IF(RAM(NVRTX+1).EQ.UNDEF) THEN C End of the line GO TO 79 END IF C Relocating the values to be displayed IF(VRML.EQ.'gocad') THEN IF(1.LE.KOLLIN.AND.KOLLIN.LE.3) THEN RAM(NVRTX+KQ)=RAM(NVRTX+KOLLIN) END IF ELSE IF(KOLLIN.GT.0) THEN RAM(NVRTX+4)=RAM(NVRTX+KOLLIN) 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 within the line 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 C Number of storage locations in RAM used for the points NVRTX=NVRTX+NQ C Total number of points of all lines IVRTX=IVRTX+1 GO TO 70 79 CONTINUE IF(NVRTX/NQ.LT.2) THEN GO TO 60 END IF C C Writing the prolog for 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.'gocad') THEN WRITE(LU2,'(A)') * 'ILINE' C 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 I0=1,NVRTX,NQ WRITE(LU2,FORMAT) 'VRTX ',IVRTX-(NVRTX-I0)/NQ, * (' ',RAM(I),I=I0,I0+NQ-1) 82 CONTINUE ELSE DO 83 I0=1,NVRTX,NQ WRITE(LU2,FORMAT) 'PVRTX ',IVRTX-(NVRTX-I0)/NQ, * (' ',RAM(I),I=I0,I0+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) CLOSE(LU2) WRITE(*,'(A)') '+LINWRL: 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