C
C Subroutine file 'wrl.for' to facilitate writing VRML, GOCAD or POV C files C C Version: 6.70 C Date: 2012, December 3 C C....................................................................... C C This file consists of the following external procedures: C WRL1... Subroutine designed to write the beginning of the output C VRML, GOCAD or POV file. C WRL1 C C======================================================================= C C C SUBROUTINE WRL1(LU1,LU2,FILE1,FILE2,VRML,ICHECK) INTEGER LU1,LU2,ICHECK CHARACTER*(*) FILE1,FILE2,VRML C C Subroutine designed to write the beginning of the output VRML, GOCAD C or POV file. C C Input: C LU1... Logical unit number to be used for a possible input. C LU2... Logical unit number connected to output file FILE2. C FILE1...Possible input filename. If FILE1 is blank, the header C will be written to FILE2. If FILE1 is equal to FILE2, C FILE2 will be positioned at its end. Otherwise, file C FILE1 will be opened, the content of file FILE1 will be C copied to the output file, and file FILE1 will be closed. C FILE2...Output filename. The file has to be open. C VRML... Form of the output file: either 'vrml1', 'vrml2', 'gocad' C or 'pov'. C ICHECK..ICHECK.EQ.0: No check of the GOCAD object name. C ICHECK.NE.0: Check of the GOCAD object name. C Used only if VRML='gocad'. C C No output. C C Date: 2000, December 14 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C External function: EXTERNAL LENGTH INTEGER LENGTH C C Other variables: CHARACTER*255 TEXT,NAME LOGICAL LNAME INTEGER I,J C TEXT... Used to copy lines from input WRL to output WRL file. C C....................................................................... C C Opening the output file: IF (FILE2.EQ.' ') THEN C WRL-01 CALL ERROR('WRL-01: No output virtual reality file') C Name of the output file of program C 'iniwrl.for', C 'ptswrl.for', C 'linwrl.for', C 'srfwrl.for' or C 'grdwrl.for' C has not been specified in the input SEP parameter file. END IF OPEN(LU2,FILE=FILE2) C C Checking the GOCAD object name: IF (VRML.EQ.'gocad'.AND.ICHECK.NE.0) THEN LNAME=.TRUE. ELSE LNAME=.FALSE. END IF IF (LNAME) THEN CALL RSEP3T('NAME',NAME,' ') IF (NAME.EQ.' ') THEN C WRL-02 CALL ERROR('WRL-02: No name of GOCAD object') C Name of each GOCAD object must be specified by input SEP C parameter NAME. C All objects within the GOCAD file must have different names, C specified by input SEP parameter NAME. C Please, check the values of parameter NAME for each execution C of programs C 'ptswrl.for', C 'linwrl.for', C 'srfwrl.for' or C 'grdwrl.for' C in the history file. END IF END IF C C Writing the output file: IF (FILE1.EQ.' ') THEN C Writing the beginning a new file: IF (VRML.EQ.'vrml1') THEN WRITE(LU2,'(A)') '#VRML V1.0 ascii' ELSE IF (VRML.EQ.'vrml2') THEN WRITE(LU2,'(A)') '#VRML V2.0 utf8' ELSE IF (VRML.EQ.'gocad') THEN WRITE(LU2,'(A)') * '#GOCAD format (generated by SW3D package FORMS)' ELSE IF (VRML.EQ.'pov') THEN WRITE(LU2,'(A)') '//POV 3.1' END IF ELSE IF (FILE1.EQ.FILE2) THEN C Output is appended to the input file: 11 CONTINUE READ(LU2,'(A)',END=12) TEXT IF (LNAME) THEN C Check for the uniqueness of the GOCAD object name I=INDEX(TEXT,'HDR name:') IF (I.GT.0) THEN J=INDEX(TEXT(I+9:),NAME(1:LENGTH(NAME))) IF (J.GT.0) THEN J=I+9+J+LENGTH(NAME) IF (TEXT(J:J).EQ.' ') THEN C WRL-03 CALL ERROR('WRL-03: Repeated GOCAD object name') C All objects within the GOCAD file must have different C names, specified by input SEP parameter NAME. C Please, check the values of parameter NAME for each C execution of programs C 'ptswrl.for', C 'linwrl.for', C 'srfwrl.for' or C 'grdwrl.for' in the history file. END IF END IF END IF END IF GO TO 11 12 CONTINUE BACKSPACE(LU2) ELSE C Copying input file to the output file: OPEN(LU1,FILE=FILE1,STATUS='OLD') 13 CONTINUE READ(LU1,'(A)',END=14) TEXT WRITE(LU2,'(A)') TEXT(1:LENGTH(TEXT)) IF (LNAME) THEN C Check for the uniqueness of the GOCAD object name I=INDEX(TEXT,'HDR name:') IF (I.GT.0) THEN J=INDEX(TEXT(I+9:),NAME(1:LENGTH(NAME))) IF (J.GT.0) THEN J=I+9+J+LENGTH(NAME) IF (TEXT(J:J).EQ.' ') THEN C WRL-04 CALL ERROR('WRL-04: Repeated GOCAD object name') C All objects within the GOCAD file must have different C names, specified by input SEP parameter NAME. C Please, check the values of parameter NAME for each C execution of programs C 'ptswrl.for', C 'linwrl.for', C 'srfwrl.for' or C 'grdwrl.for' in the history file. END IF END IF END IF END IF GO TO 13 14 CONTINUE CLOSE(LU1) END IF IF (FILE1.NE.' '.OR.VRML.NE.'gocad') THEN WRITE(LU2,'(A)') END IF RETURN END C C======================================================================= C