C
C Subroutine file 'wrl.for' to facilitate writing VRML, GOCAD or POV
C files
C
C Version: 5.50
C Date: 2000, December 14
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' has not been specified
C 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' 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
C history file.
END IF
END IF
END IF
END IF
GO TO 11
12 CONTINUE
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
C 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