C
C Program INIWRL to initialize a virtual reality description file
C
C Version: 5.50
C Date: 2001, January 7
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@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     Persistence of Vision scene description language, version 3.1
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     WRLINI='string'... Name of the file to be copied to the beginning
C             of the output file.  If the filename is blank (default),
C             the output file is initialized from its beginning.
C             File WRLINI may contain the user-coded description in the
C             corresponding VRML language.  The default value is mostly
C             appropriate.
C             Default: WRLINI=' '
C     CAMERA='string'... Name of the file with cameras (viewpoints).
C             May or may not be specified.  The default initial view
C             of a VRML viewer is in the direction of the -X3 half-axis.
C             Description of file CAMERA
C             Not used if VRML='GOCAD'.
C             Default: CAMERA=' '
C     DLIGHT='string'... Name of the file with directional lights.
C             Description of file DLIGHT
C             If not specified, the viewer will use its default
C             illumination.
C             Not used if VRML='GOCAD'.
C             Default: DLIGHT=' '
C     PLIGHT='string'... Name of the file with point lights.
C             Description of file PLIGHT
C             Often need not be specified.
C             Not used if VRML='GOCAD'.
C             Default: PLIGHT=' '
C Data specifying the output file:
C     WRL='string'... Name of the output file.  It is recommended to
C             specify it rather than to use the default name.
C             Default: WRL='out.wrl'
C Data specifying the form of the output file:
C     VRML='string'... Virtual reality scene description language.
C             The case of the characters does not matter.
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), curves
C                           (PLine) and surfaces (TSurf).
C             VRML='POV':   POV (Persistence Of Vision) scene
C                           description language, version 3.1.
C             Default: VRML='VRML2' (recommended)
C Data specifying the illumination and background (not used if
C VRML='GOCAD'):
C     UP1=real, UP2=real, UP3=real... Components of a vector pointing
C             upwards.  It is used to properly rotate the camera.
C             Note that VRML uses right-handed Cartesian coordinates.
C             If the model coordinates are left-handed, all objects
C             will be seen mirrored.
C             Defaults: UP1=0, UP2=0, UP3=1 (X3 axis pointing up)
C     AMBIENT=real... Float number between 0 and 1 specifying the
C             intensity of the ambient light.  The colour of the ambient
C             light is assumed white.
C             If VRML='vrml1', the implicit ambient light has intensity
C               1.00 and parameter AMBIENT is applied directly to the
C               material of the surface objects by subsequent programs.
C             If VRML='vrml2', the ambient light is the first light,
C               followed by directional lights and point lights.
C             Default:  AMBIENT=0.20 (default for VRML materials)
C     R=real, G=real, B=real... Float numbers between 0 and 1 specifying
C             the colour of the background.
C             Not applied if VRML='vrml1' or VRML='gocad' .
C             Defaults: R=0, G=0, B=0 (black background)
C
C                                                  
C Input file CAMERA with the cameras (viewpoints):
C (1) None to several strings terminated by / (a slash)
C (2) For each camera data (2.1):
C (2.1) 'NAME',X1,X2,X3,T1,T2,T3,WIDTH,HEIGHT,/
C     'NAME'... Name of the viewpoint.  Will be used by VRML viewers to
C             refer the viewpoint.
C     X1,X2,X3... Coordinates of the viewpoint (camera).
C     T1,T2,T3... Coordinates of the target point.
C             Defaults: T1=0, T2=0, T3=0
C     WIDTH,HEIGHT... Width and height of the rectangle around the
C             target point to fit in the display window.
C             If specified, the width and height should be positive.
C             Otherwise, the results may be browser-dependent.
C             For VRML='vrml1': HEIGHT fits into the vertical window
C               dimension.  The aspect ratio is proportional.
C             For VRML='vrml2': Square of side max(HEIGHT,WIDTH*3/4)
C               is maximized in the display window.  The aspect ratio is
C               proportional.
C               Note that VRML uses right-handed Cartesian coordinates.
C               If the model coordinates are left-handed, all objects
C               will be seen mirrored.
C             For VRML='pov': Rectangle of sides HEIGHT and WIDTH fills
C               the display window.  The aspect ratio depends on the
C               dimensions of the display window.
C             Defaults if one of the values is given: WIDTH=HEIGHT*4/3,
C               HEIGHT=WIDTH*3/4.
C             Defaults if none of them is given: HEIGHT=distance between
C               the camera and the target point, WIDTH=HEIGHT*4/3
C (3) / or end of file.
C
C                                                  
C Input file DLIGHT with the directional lights:
C (1) None to several strings terminated by / (a slash)
C (2) For each light data (2.1):
C (2.1) 'NAME',X1,X2,X3,VALUE,/
C     'NAME'... Name of the light.  Not considered.  May be blank.
C     X1,X2,X3... Directional vector towards the light.
C     VALUE...Intensity of the light source, possibly supplemented by
C             the minus sign if the light should be initially switched
C             off.  The colour of the light is assumed white.
C             Default:  VALUE=0.80 (default for VRML materials)
C (3) / or end of file.
C
C                                                  
C Input file PLIGHT with the point lights:
C (1) None to several strings terminated by / (a slash)
C (2) For each light data (2.1):
C (2.1) 'NAME',X1,X2,X3,VALUE,/
C     'NAME'... Name of the light.  Not considered.  May be blank.
C     X1,X2,X3... Coordinates of the light.
C     VALUE...Intensity of the light source, possibly supplemented by
C             the minus sign if the light should be initially switched
C             off.  The colour of the light is assumed white.
C             Default:  VALUE=0.80 (default for VRML materials)
C (3) / or end of file.
C
C=======================================================================
C
C     External functions and subroutines:
      EXTERNAL LENGTH,ERROR,RSEP1,RSEP3T,RSEP3R
      INTEGER  LENGTH
C
C     Filenames and parameters:
      CHARACTER*80 FILE1,FILE2
      INTEGER LU1,LU2
      REAL UNDEF
      PARAMETER (LU1=1,LU2=2,UNDEF=-999999.)
C
C     Other variables:
      CHARACTER*5   VRML
      CHARACTER*255 TEXT
      INTEGER I,J
      REAL UP1,UP2,UP3,RED,GREEN,BLUE
      REAL X1,X2,X3,T1,T2,T3,R1,R2,R3,R4,W,H,C,S,DIST,AUX
      REAL R11,R21,R31,R12,R22,R32,R13,R23,R33
      REAL S11,S21,S31,S12,S22,S32,S13,S23,S33
C
C.......................................................................
C
C     Reading main input data:
      WRITE(*,'(A)') '+INIWRL: Enter input filename: '
      FILE1=' '
      READ(*,*) FILE1
      IF(FILE1.EQ.' ') THEN
C       INIWRL-01
        CALL ERROR('INIWRL-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,FILE1)
      WRITE(*,'(A)') '+INIWRL: Working...            '
C
C     Reading the form of the output file:
      CALL RSEP3T('VRML',VRML ,'vrml2'  )
      CALL LOWER(VRML)
      IF(VRML.NE.'vrml1'.AND.
     *   VRML.NE.'vrml2'.AND.
     *   VRML.NE.'pov'  .AND.
     *   VRML.NE.'gocad') THEN
C       INIWRL-02
        CALL ERROR('INIWRL-02: No valid string in VRML')
C       Valid string specifying the form of the output file is:
C       VRML='VRML1' or 'VRML2' or 'POV' or 'GOCAD'.
C       Default and recommended value is 'VRML2'.
      END IF
C
C     Opening the output file and writing its beginning:
      CALL RSEP3T('WRLINI',FILE1,' ')
      CALL RSEP3T('WRL'   ,FILE2,'out.wrl')
      CALL WRL1(LU1,LU2,FILE1,FILE2,VRML,0)
C
C.......................................................................
C
C     Cameras (viewpoints):
C
      CALL RSEP3T('CAMERA',FILE1,' ')
      CALL RSEP3R('UP1',UP1,0.)
      CALL RSEP3R('UP2',UP2,0.)
      CALL RSEP3R('UP3',UP3,1.)
      IF(FILE1.NE.' ') THEN
        OPEN(LU1,FILE=FILE1,STATUS='OLD')
        READ(LU1,*) (TEXT,I=1,20)
C
C       Loop over viewpoints
   20   CONTINUE
          TEXT='$'
          X1=0.
          X2=0.
          X3=0.
          T1=0.
          T2=0.
          T3=0.
          W=UNDEF
          H=UNDEF
          READ(LU1,*,END=29) TEXT,X1,X2,X3,T1,T2,T3,W,H
          IF(TEXT.EQ.'$') THEN
            GO TO 29
          END IF
C
C         Camera back unit vector
          R13=X1-T1
          R23=X2-T2
          R33=X3-T3
          DIST=SQRT(R13*R13+R23*R23+R33*R33)
          IF(DIST.EQ.0.) THEN
C           INIWRL-03
            CALL ERROR('INIWRL-03: Zero distance from camera to model')
          END IF
          R13=R13/DIST
          R23=R23/DIST
          R33=R33/DIST
C
C         Viewing frame
          IF(W.EQ.UNDEF.AND.H.EQ.UNDEF) THEN
            H=DIST*2.*(SQRT(2.)-1.)
            W=H*4./3.
          ELSE IF(W.EQ.UNDEF) THEN
            W=H*4./3.
          ELSE IF(H.EQ.UNDEF) THEN
            H=W*3./4.
          END IF
C
          IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
C           Camera top unit vector
            AUX=UP1*R13+UP2*R23+UP3*R33
            R12=UP1-R13*AUX
            R22=UP2-R23*AUX
            R32=UP3-R33*AUX
            AUX=SQRT(R12*R12+R22*R22+R32*R32)
            IF(AUX.GE.0.00025) THEN
              R12=R12/AUX
              R22=R22/AUX
              R32=R32/AUX
            ELSE IF(ABS(R13).LE.ABS(R23).AND.ABS(R13).LE.ABS(R33)) THEN
              AUX=SQRT(R23*R23+R33*R33)
              R12=0.
              R22= R33/AUX
              R32=-R23/AUX
            ELSE IF(ABS(R23).LE.ABS(R33)) THEN
              AUX=SQRT(R13*R13+R33*R33)
              R12= R33/AUX
              R22=0.
              R32=-R13/AUX
            ELSE
              AUX=SQRT(R13*R13+R23*R23)
              R12= R23/AUX
              R22=-R13/AUX
              R32=0.
            END IF
C
C           Camera right unit vector
            R11=R22*R33-R32*R23
            R21=R32*R13-R12*R33
            R31=R12*R23-R22*R13
C
C           Rotation axis vector
            C=R11+R22+R33-1.
            R11=R11-1.
            R22=R22-1.
            R33=R33-1.
            S11=R22*R33-R32*R23
            S21=R32*R13-R12*R33
            S31=R12*R23-R22*R13
            S12=R23*R31-R33*R21
            S22=R33*R11-R13*R31
            S32=R13*R21-R23*R11
            S13=R21*R32-R31*R22
            S23=R31*R12-R11*R32
            S33=R11*R22-R21*R12
            IF(S11.LE.0..AND.S22.LE.0..AND.S33.LE.0.) THEN
              R1=0.
              R2=0.
              R3=1.
              R4=0.
            ELSE IF(S33.GE.S22.AND.S33.GE.S11) THEN
              R1=S13+S31
              R2=S23+S32
              R3=S33+S33
            ELSE IF(S22.GE.S11) THEN
              R1=S12+S21
              R2=S22+S22
              R3=S32+S23
            ELSE
              R1=S11+S11
              R2=S21+S12
              R3=S31+S13
            END IF
            AUX=SQRT(R1*R1+R2*R2+R3*R3)
            R1=R1/AUX
            R2=R2/AUX
            R3=R3/AUX
            S=R1*(R32-R23)+R2*(R13-R31)+R3*(R21-R12)
            R4=ATAN2(S,C)
C
            IF(VRML.EQ.'vrml1') THEN
              AUX=2.*ATAN(H/DIST/2.)
              WRITE(LU2,'(A)')
     *         'PerspectiveCamera {'
              WRITE(LU2,'(A,F8.6)')
     *         '  heightAngle ',AUX
              WRITE(LU2,'(A,G15.6)')
     *         '  focalDistance ',DIST
            ELSE
              AUX=2.*ATAN(AMAX1(W*3./4.,H)/DIST/2.)
              WRITE(LU2,'(A)')
     *         'Viewpoint {'
              WRITE(LU2,'(3A)')
     *         '  description "',TEXT(1:LENGTH(TEXT)),'"'
              WRITE(LU2,'(A,F8.6)')
     *         '  fieldOfView ',AUX
            END IF
            WRITE(LU2,'(3(A,G15.6))')
     *       '  position ',X1,' ',X2,' ',X3
            WRITE(LU2,'(4(A,F9.6))')
     *       '  orientation ',R1,' ',R2,' ',R3,' ',R4
            WRITE(LU2,'(A)')
     *       '}'
C
          ELSE IF(VRML.EQ.'pov') THEN
            WRITE(LU2,'(A)')
     *       'camera {'
     *      ,'  perspective'
            WRITE(LU2,'(A,3(G15.6,A))')
     *       '  right     <',-W ,',', 0.,',', 0. ,'>'
     *      ,'  up        <', 0.,',', H ,',', 0. ,'>'
     *      ,'  direction <', 0.,',', 0.,',',DIST,'>'
     *      ,'  sky       <',UP1,',',UP2,',',UP3 ,'>'
     *      ,'  location  <', X1,',', X2,',', X3 ,'>'
     *      ,'  look_at   <', T1,',', T2,',', T3 ,'>'
            WRITE(LU2,'(A)')
     *       '}'
C
          END IF
        GO TO 20
C       End of the loop over viewpoints
C
   29   CONTINUE
        CLOSE(LU1)
      END IF
C
C.......................................................................
C
C     Ambient light:
C
      CALL RSEP3R('AMBIENT',W,0.20)
C     VRML 1.0 has an implicit ambient light of intensity 1.00
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'NavigationInfo {'
     *  ,'  headlight FALSE'
     *  ,'}'
     *  ,'DirectionalLight {'
     *  ,'  color 1.00 1.00 1.00'
     *  ,'  intensity 0.00'
        WRITE(LU2,'(A,F4.2)')
     *   '  ambientIntensity ',W
        WRITE(LU2,'(A)')
     *   '  on TRUE'
     *  ,'}'
      ELSE IF(VRML.EQ.'pov') THEN
        WRITE(LU2,'(A,3(F4.2,A))')
     *   'global_settings { ambient_light rgb <',W,',',W,',',W,'> }'
      END IF
C
C.......................................................................
C
C     Directional and point lights:
C
      DO 39 J=1,2
        IF(J.EQ.1) THEN
C         Directional lights
          CALL RSEP3T('DLIGHT',FILE1,' ')
        ELSE
C         Point lights
          CALL RSEP3T('PLIGHT',FILE1,' ')
        END IF
        IF(FILE1.NE.' ') THEN
          OPEN(LU1,FILE=FILE1,STATUS='OLD')
          READ(LU1,*) (TEXT,I=1,20)
C
C         Loop over lights
   30     CONTINUE
            TEXT='$'
            X1=0.
            X2=0.
            X3=0.
            W =0.80
            READ(LU1,*,END=38) TEXT,X1,X2,X3,W
            IF(TEXT.EQ.'$') THEN
              GO TO 38
            END IF
C
            IF(VRML.EQ.'vrml1'.OR.VRML.EQ.'vrml2') THEN
              IF(J.EQ.1) THEN
                WRITE(LU2,'(A)')
     *           'DirectionalLight {'
                AUX=SQRT(X1*X1+X2*X2+X3*X3)
                X1=-X1/AUX
                X2=-X2/AUX
                X3=-X3/AUX
                WRITE(LU2,'(3(A,F9.6))')
     *           '  direction ',X1,' ',X2,' ',X3
              ELSE
                WRITE(LU2,'(A)')
     *           'PointLight {'
                WRITE(LU2,'(3(A,G15.6))')
     *           '  location ',X1,' ',X2,' ',X3
                WRITE(LU2,'(A)')
     *           '  radius 999999'
              END IF
              WRITE(LU2,'(A)')
     *         '  color 1.00 1.00 1.00'
              WRITE(LU2,'(A,F4.2)')
     *         '  intensity ',ABS(W)
              IF(VRML.EQ.'vrml2') THEN
                WRITE(LU2,'(A)')
     *           '  ambientIntensity 0.00'
              END IF
              IF(W.GT.0.) THEN
                WRITE(LU2,'(A)')
     *           '  on TRUE'
              ELSE
                WRITE(LU2,'(A)')
     *           '  on FALSE'
              END IF
              WRITE(LU2,'(A)')
     *         '}'
            ELSE IF(VRML.EQ.'pov') THEN
              WRITE(LU2,'(A)')
     *         'light_source {'
              WRITE(LU2,'(A,3(G15.6,A))')
     *         '  <',X1,',',X2,',',X3,'>'
              WRITE(LU2,'(A,3(F4.2,A))')
     *         '  rgb <',W,',',W,',',W,'>'
              WRITE(LU2,'(A)')
     *         '}'
            END IF
          GO TO 30
C         End of the loop over directional lights
C
   38     CONTINUE
          CLOSE(LU1)
        END IF
   39 CONTINUE
C
C.......................................................................
C
C     Background colour:
C
      CALL RSEP3R('R',RED  ,0.)
      CALL RSEP3R('G',GREEN,0.)
      CALL RSEP3R('B',BLUE ,0.)
C     VRML 1.0 has no background node
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A,3(F4.2,A))')
     *    'Background { skyColor ',RED,' ',GREEN,' ',BLUE,' }'
      ELSE IF(VRML.EQ.'pov') THEN
        WRITE(LU2,'(A,3(F4.2,A))')
     *    'background { color rgb <',RED,',',GREEN,',',BLUE,'> }'
      END IF
C
C.......................................................................
C
C     Separating the header by a blank line
      IF (VRML.NE.'gocad') THEN
        WRITE(LU2,'(A)')
      END IF
C
C.......................................................................
C
C     Subroutine for surfaces:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO Surface ['
     *  ,'  exposedField SFNode  appearance NULL'
     *  ,'  field        MFVec3f point      []'
     *  ,'  exposedField SFNode  normalPos  NULL'
     *  ,'  exposedField SFNode  normalNeg  NULL'
     *  ,'  exposedField SFNode  colorPos   NULL'
     *  ,'  exposedField SFNode  colorNeg   NULL'
     *  ,'  field        MFInt32 coordIndex []'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    children ['
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry IndexedFaceSet {'
     *  ,'          ccw TRUE # positive surface side'
     *  ,'          coord DEF SurfaceCoord Coordinate {'
     *  ,'            point    IS point'
     *  ,'          }'
     *  ,'          normal     IS normalPos'
     *  ,'          color      IS colorPos'
     *  ,'          coordIndex IS coordIndex'
     *  ,'        }'
     *  ,'      }'
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry IndexedFaceSet {'
     *  ,'          ccw FALSE # negative surface side'
     *  ,'          coord USE SurfaceCoord'
     *  ,'          normal     IS normalNeg'
     *  ,'          color      IS colorNeg'
     *  ,'          coordIndex IS coordIndex'
     *  ,'        }'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      END IF
C
C.......................................................................
C
C     Subroutine for lines:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO Line ['
     *  ,'  exposedField SFNode  appearance NULL'
     *  ,'  field        MFVec3f point      []'
     *  ,'  exposedField SFNode  color      NULL'
     *  ,'  field        MFInt32 coordIndex []'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    children ['
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry IndexedLineSet {'
     *  ,'          coord Coordinate {'
     *  ,'            point    IS point'
     *  ,'          }'
     *  ,'          color      IS color'
     *  ,'          coordIndex IS coordIndex'
     *  ,'        }'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      ELSE IF (VRML.EQ.'pov') THEN
        WRITE(LU2,'(A)')
     *   '#declare LINERADIUS = 0.1;'
     *  ,' '
     *  ,'#macro LINE(X1,X2,X3,X4,Y1,Y2,Y3,Y4)'
     *  ,'  #local X=;'
     *  ,'  #local Y=;'
     *  ,'  #local VD=X4-Y4;'
     *  ,'  #local VY=   Y4;'
     *  ,'  #if (VD=0)'
     *  ,'    #local VD=VPER/999999;'
     *  ,'  #end'
     *  ,'  #local G0=(X-Y)*VPER/VD;'
     *  ,'  cylinder {'
     *  ,'    X Y LINERADIUS'
     *  ,'    texture {'
     *  ,'      pigment {'
     *  ,'        gradient x'
     *  ,'        translate ((VREF-V3)/VPER-CREF-100)*x'
     *  ,'        matrix '
     *  ,'        translate Y'
     *  ,'      }'
     *  ,'    }'
     *  ,'  }'
     *  ,'#end'
     *  ,' '
      END IF
C
C.......................................................................
C
C     Subroutine for points:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO Point ['
     *  ,'  exposedField SFNode  appearance NULL'
     *  ,'  field        MFVec3f point      []'
     *  ,'  exposedField SFNode  color      NULL'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    children ['
     *  ,'      Shape {'
     *  ,'        appearance IS appearance'
     *  ,'        geometry PointSet {'
     *  ,'          coord Coordinate {'
     *  ,'            point    IS point'
     *  ,'          }'
     *  ,'          color      IS color'
     *  ,'        }'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      END IF
C
C.......................................................................
C
C     Subroutine for texts:
C
      IF(VRML.EQ.'vrml2') THEN
        WRITE(LU2,'(A)')
     *   'PROTO text ['
     *  ,'  exposedField SFNode   appearance NULL'
     *  ,'  exposedField SFVec3f  point      0 0 0'
     *  ,'  exposedField MFString string     []'
     *  ,'  exposedField SFNode   fontStyle  NULL'
     *  ,']{'
     *  ,'  Transform {'
     *  ,'    translation IS point'
     *  ,'    children ['
     *  ,'      Billboard {'
        AUX=SQRT(UP1*UP1+UP2*UP2+UP3*UP3)
        R1=UP1/AUX
        R2=UP2/AUX
        R3=UP3/AUX
        WRITE(LU2,'(3(A,F6.3))')
     *   '        axisOfRotation ',R1,' ',R2,' ',R3
        AUX=SQRT(UP2*UP2+UP3*UP3)
        WRITE(LU2,'(A)')
     *   '        children ['
     *  ,'          Transform {'
        AUX=SQRT(UP1*UP1+UP3*UP3)
        IF(AUX.NE.0.) THEN
          R1=UP3/AUX
          R2=0.
          R3=-UP1/AUX
          R4=ATAN2(AUX,UP2)
        ELSE
          R1=1.
          R2=0.
          R3=0.
          IF(UP2.GE.0.) THEN
            R4=0.
          ELSE
            R4=3.141593
          END IF
        END IF
        WRITE(LU2,'(3(A,F6.3),A,F9.6)')
     *   '            rotation ',R1,' ',R2,' ',R3,' ',R4
        WRITE(LU2,'(A)')
     *   '            children ['
     *  ,'              Shape {'
     *  ,'                appearance IS appearance'
     *  ,'                geometry Text {'
     *  ,'                  string IS string'
     *  ,'                  fontStyle IS fontStyle'
     *  ,'                }'
     *  ,'              }'
     *  ,'            ]'
     *  ,'          }'
     *  ,'        ]'
     *  ,'      }'
     *  ,'    ]'
     *  ,'  }'
     *  ,'}'
      END IF
C
C.......................................................................
C
      CLOSE(LU2)
      WRITE(*,'(A)') '+INIWRL: 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 'wrl.for'
C     wrl.for
C
C=======================================================================
C