!++
!**********  ELMNTDEF_01  **********
!
      SUBROUTINE ElmntDef_01(TEST)
!
!  Define an Element Type using a dialog box.  Check unit 1 for initial 
!    values, or use defaults if unit 1 is blank.  Write the results as a
!    file on unit 1, using namelist output.
!
!     ENTRY ElmntBuild_01(TEST)
!
!  Build an instance of an Element Type.  Read a file from unit 1 with the 
!    parameters entered by a user of NISP_Win, and generate information to 
!    be combined with other elements in the Instrument Geometry File. 
! 
!     ENTRY ElmntView_01(TEST)
!
!  Generate VRML/X3D <Shape> block for the Element Type.  Read parameters
!    from unit 1 and write the Shape on unit 9.
!
!  P.A.Seeger, 19 May, 1998
!    07 Aug 1998: 1.1 Z1 and Z2 are offsets from Z [PAS]
!    11 Jul 2001: 1.2 2nd region may be type 92 instead of 91 [PAS]
!    02 Sep 2002: 1.2 restructured for program NISP_Win [PAS]
!    10 Sep 2002: 1.3, fixed-source Brightness and Polarization [PAS]
!    21 Sep 2002: 1.3 restructured to use CASE and link to HELP [PAS]
!    16 Dec 2002: 1.4, always compute Emin, Emax for .tbl file [PAS]
!    01 May 2004: 1.4 added View entry [PAS]
!    08 Jul 2006: 1.5, protect against no '.' in FileName [PAS]
!    30 Jul 2006: 2.0, add sum of Maxwellians [PAS]
!    29 Aug 2006: 2.1, had neglected to multiply Maxwellian T by k [PAS]
!    04 Nov 2009: 2.2, allow polarization for all but .mon files [PAS]
!    14 Sep 2018: 2.3, change to Intel Fortran 18.3, USE IFxxxx 
!                      TYPE FILE$INFO%LENGTH is I*8 for Intel64 [PAS]
!
      USE      IFQWIN
      USE      IFLOGM
      USE      IFPORT
      IMPLICIT NONE
!
!  Specify element type: number, name, version/date/author
      INTEGER   ElNo
      CHARACTER*(*) ELEMENT, VERSION
      PARAMETER (ElNo=1,                                                &
     &           ELEMENT='Source (Plane)',                              &
     &           VERSION='Version 2.4, 08 Sep 2018, P.A.Seeger')
!
      INCLUDE  'mc_geom.inc'
      INCLUDE  'mc_elmnt.inc'
      INCLUDE  'constant.inc'
      INCLUDE  'BuildData.inc'
	LOGICAL  TEST
      EXTERNAL DialogHelp
!
!  Extrinsic variables 
      INTEGER   NEXTRIN
      PARAMETER (NEXTRIN=4)
      REAL*8    X, Y, Z, Tilt
      NAMELIST /EXTRINSIC/ X, Y, Z, Tilt
!
!  Intrinsic variables
      INTEGER   NINTRIN
	PARAMETER (NINTRIN=25)
      REAL*8    Width, Height, Z1, Y1, D1, DelY1, Z2, Y2, D2, DelY2,    &
     &          Gravity, Frequency, PulseWidth, lammin, lammax,         &
     &          RelProb(20), T(20), Bright, lam0, fwhmlam, Px, Py, Pz 
      INTEGER   numberW
!     40-character FileName must be split in two for NAMELIST
      CHARACTER FileName*40, FileName1*20, FileName2*20
      NAMELIST /INTRINSIC/ Width,Height,Z1,Y1,D1,DelY1,Z2,Y2,D2,DelY2,  &
     &                     Gravity,Frequency,PulseWidth,FileName1,      &
     &                     FileName2,lammin,lammax,numberW,RelProb,T,   &
     &                     Bright,lam0,fwhmlam,Px,Py,Pz
!
!  Values, classes, and descriptors for all variables, in order as on page
      REAL*8    RVAL(NEXTRIN+NINTRIN)
      INTEGER*4 IVAL(NEXTRIN+NINTRIN)
      CHARACTER CVAL*10(NEXTRIN+NINTRIN), CLS*10(NEXTRIN+NINTRIN),      &
     &          STR*40(NEXTRIN+NINTRIN)
!     Define arrays as needed
      REAL*8    AVAL(20,22:23)
!  Classes are: 'R' for REAL*8,
!               'F' for a REAL*8 Fraction , 0.0 - 1.0
!               'A' for Array of 20 REAL*8
!               'I' for INTEGER*4,
!               'M' for a CHARACTER*10 Material identifier (unit 7)
!               'X' for a CHARACTER*10 X'tal identifier (unit 8)
!               'K' for a CHARACTER*40 Scattering Kernel file
!               'P' for a CHARACTER*40 Powder file
!               'S' for a CHARACTER*40 Source (.tbl or .mon file),
!               'C' for multiple Choice (radio buttons)
!               'Y' for Yes/No options (check boxes)
!  Extrinsic
      DATA RVAL(1),CLS(1),STR(1)/0.,'R','Center of Plane Source, X (mm)'&
     &/
      DATA RVAL(2),CLS(2),STR(2)/0.,'R','Y (mm)'/
      DATA RVAL(3),CLS(3),STR(3)/0.,'R','Z (m)'/
      DATA RVAL(4),CLS(4),STR(4)/0.,'R','Horizontal Tilt of normal from &
     &Z-axis (&deg;)'/
!  Intrinsic
      DATA RVAL(5),CLS(5),STR(5)/0.,'R','Source Area, Width (mm)'/
      DATA RVAL(6),CLS(6),STR(6)/0.,'R','Height (mm)'/
      DATA RVAL(7),CLS(7),STR(7)/0.,'R','Phase-space aperture 1:  Distan&
     &ce (m)'/
      DATA RVAL(8),CLS(8),STR(8)/0.,'R','Elevation (mm)'/
      DATA RVAL(9),CLS(9),STR(9)/0.,'R','Diameter or Width (mm)'/
      DATA RVAL(10),CLS(10),STR(10)/0.,'R','Height (if rectangular) (mm)&
     &'/
      DATA RVAL(11),CLS(11),STR(11)/1.,'R','Phase-space aperture 2:  Dis&
     &tance (m)'/
      DATA RVAL(12),CLS(12),STR(12)/0.,'R','Elevation (mm)'/
      DATA RVAL(13),CLS(13),STR(13)/0.,'R','Diameter or Width (mm)'/
      DATA RVAL(14),CLS(14),STR(14)/0.,'R','Height (if rectangular) (mm)&
     &'/
      DATA RVAL(11),CLS(15),STR(15)/0.,'R','Gravity-focus extension (mm)&
     &'/
      DATA RVAL(16),CLS(16),STR(16)/20.,'R','Proton Pulse Frequency (Hz)&
     &'/
      DATA RVAL(17),CLS(17),STR(17)/0.,'R','Pulse width (&micro;s)'/
      DATA CVAL(18),CLS(18),STR(18)/'','S','Select File: Source Name'/
      DATA RVAL(19),CLS(19),STR(19)/1.,'R','Minimum wavelength (&Aring;)&
     &'/
      DATA RVAL(20),CLS(20),STR(20)/20.,'R','Maximum wavelength for File&
     & or Maxwellian (&Aring)'/
      DATA IVAL(21),CLS(21),STR(21)/0,'I','Sum of Maxwellians: Number (1&
     &-20)'/
      DATA (AVAL(J,22),J=1,20)/20*0./,                                  &
     &     CLS(22),STR(22)/'A','Rel. Prob.'/
      DATA (AVAL(J,23),J=1,20)/20*0./,                                  &
     &     CLS(23),STR(23)/'A','T (K)'/
      DATA RVAL(24),CLS(24),STR(24)/1.d16,'R','Brightness (Maxwellian or&
     & fixed) (n/ster/m²/MJ)'/
      DATA RVAL(25),CLS(25),STR(25)/4.,'R','Fixed Source:               &
     &        Wavelength (Aring;)'/
      DATA RVAL(26),CLS(26),STR(26)/0.,'R','Width of distribution (fwhm,&
     & +triangle or -square)'/
      DATA RVAL(27),CLS(27),STR(27)/0.,'R','Polarization (all but .mon),&
     & Px'/
      DATA RVAL(28),CLS(28),STR(28)/0.,'R','Py'/
      DATA RVAL(29),CLS(29),STR(29)/0.,'R','Pz'/
!--
!  Local (temporary) variables
      INTEGER   I, J, K, LNAME, NDX, NEXTINDX, I1, I2, N, ISTAT
      LOGICAL   FLAG
      CHARACTER STRING*40
      TYPE(dialog) DBOX
!
!***** Type-Dependent Specifications Block
!
      CHARACTER LongString*255
      REAL*8    sinTilt, cosTilt, PSQ, SUM
      CHARACTER Extension*4, SourcePath*60
      INTEGER   LenPath
      REAL*4    dX, dY, dZ
      CHARACTER*11 Xstring,Ystring,Zstring,Xleft,Xright,Yup,Ydown,      &
     &             ZZleft,ZZright
      INTEGER   kX,kY,kZ,kXleft,kXright,kYup,kYdown,kZleft,kZright
      TYPE(FILE$INFOI8) DIR_INFO
      INTEGER*8 hndl8
      INTEGER*4 NN
      DATA SourcePath, LenPath/' ', 0/
      SAVE SourcePath, LenPath
!
!***** End of Type-Dependent Specifications Block
!
      READ (1,'(A)') NAME(0)
	IF (NAME(0) .NE. ' ') THEN
!        Check for code revision
         STRING = ' '
         DO WHILE (STRING(1:7) .NE. 'Version')
            READ (1,'(A)',ERR=710) STRING
         END DO
         IF (STRING .NE. VERSION)                                       &
     &      PRINT *, '** NOTICE: New Version of ',ELEMENT
!        Obtain initial values from input file
         READ (1, NML=EXTRINSIC)
         RVAL(1)  = X
         RVAL(2)  = Y
         RVAL(3)  = Z
         RVAL(4)  = Tilt
         READ (1, NML=INTRINSIC)
         RVAL(5)  = Width
         RVAL(6)  = Height
         RVAL(7)  = Z1
         RVAL(8)  = Y1
         RVAL(9)  = D1
         RVAL(10) = DelY1
         RVAL(11) = Z2
         RVAL(12) = Y2
         RVAL(13) = D2
         RVAL(14) = DelY2
         RVAL(15) = Gravity
         RVAL(16) = Frequency
         RVAL(17) = PulseWidth
         STR(18)  = FileName1//FileName2
         RVAL(19) = lammin
         RVAL(20) = lammax
         IVAL(21) = numberW
         DO I=1,numberW
            AVAL(I,22) = RelProb(I)
            AVAL(I,23) = T(I)
         END DO
         DO I=numberW+1,20
            AVAL(I,22) = 0.d0
            AVAL(I,23) = 0.d0
         END DO
         RVAL(24) = Bright
         RVAL(25) = lam0
         RVAL(26) = fwhmlam
         RVAL(27) = Px
         RVAL(28) = Py
         RVAL(29) = Pz
	ELSE
!        Start with same values as previous instance
         NAME(0) = ELEMENT
      END IF
!
!     Generate dialog box specfific to this element type
!     Note: it is important that real-number edit boxes include a
!       decimal point.  Use a special version of DIGITS8
      FLAG = DLGINIT(100+ElNo, DBOX)
      FLAG = DLGSET(DBOX, 1000, NAME(0))
      DO I=1,NEXTRIN+NINTRIN
         SELECT CASE(CLS(I))
         CASE ('R', 'F')
            CALL DIGITS8(RVAL(I), STRING, K)
            FLAG = DLGSET(DBOX, 1000+I, STRING(1:K))
         CASE ('I')
            WRITE (STRING,'(I10)') IVAL(I)
            K = 1
            DO WHILE (STRING(K:K) .EQ. ' ')
               K = K + 1
            END DO
            FLAG = DLGSET(DBOX, 1000+I, STRING(K:10))
!     Include 'A', 'C', 'K', 'M', 'P', 'S', 'X', 'Y' only as needed 
         CASE ('A')
!           Encode an Array
            LongString = ' '
            J = 0
            DO N=1,20
               CALL DIGITS8(AVAL(N,I), STRING, K)
               LongString(J+1:) = STRING(1:K)//', '
               J = J + K + 2
            END DO
            FLAG = DLGSET(DBOX, 1000+I, LongString(1:J-2))
         CASE ('S')
            SourcePath = DataPath(1:LEN_TRIM(DataPath))//'Tables\'
            LenPath = LEN_TRIM(SourcePath)
            FLAG = DLGSET(DBOX, 1000+I, 100, DLG_NUMITEMS)
            N = 0
!           Loop to find all possible Source Table (*.tbl) files
            hndl8 = FILE$FIRST
            DO WHILE (hndl8.NE.FILE$LAST .AND. hndl8.NE.FILE$ERROR)
               NN = GETFILEINFOQQ(SourcePath(1:LenPath)//'*.tbl',
     &                            DIR_INFO, hndl8)
               IF (NN .GT. 0) THEN
!                 Add file name to a COMBOBOX for possible selection
                  N = N + 1
                  FLAG = DLGSET(DBOX, 1000+I, DIR_INFO%NAME(1:NN), N)
               END IF
            END DO
!           Also look in working directory for possible .mon files
            hndl8 = FILE$FIRST
            DO WHILE (hndl8.NE.FILE$LAST .AND. hndl8.NE.FILE$ERROR)
               NN = GETFILEINFOQQ('.\*.mon', DIR_INFO, hndl8)
               IF (NN .NE. 0) THEN
                  N = N + 1
                  FLAG = DLGSET(DBOX, 1000+I, DIR_INFO%NAME(1:NN), N)
               END IF
            END DO
            FLAG = DLGSET(DBOX, 1000+I, N, DLG_NUMITEMS)
            FLAG = DLGSET(DBOX, 1000+I, STR(I), DLG_STATE)
         END SELECT
      END DO
!
!     Set callback routine for all Help buttons
      DO I=0,NEXTRIN+NINTRIN
         FLAG = DLGSETSUB(DBOX, 1200+I, DialogHelp)
      END DO
!
!     Activate the box and wait for "OK"
      ISTAT = DLGMODAL(DBOX)
      TEST = ISTAT .EQ. IDOK
      IF (TEST) THEN
!        Record the revised parameters
         FLAG = DLGGET(DBOX, 1000, NAME(0))
         DO I=1,NEXTRIN+NINTRIN
            ISTAT = 0
            SELECT CASE(CLS(I))
            CASE('R', 'F')
               FLAG = DLGGET(DBOX, 1000+I, STRING)
               READ (STRING,*,IOSTAT=ISTAT) RVAL(I)
               IF (CLS(I).EQ.'F') RVAL(I) = MAX(0.d0,MIN(1.d0,RVAL(I)))
            CASE ('I')
               FLAG = DLGGET(DBOX, 1000+I, STRING)
               READ (STRING,*,IOSTAT=ISTAT) IVAL(I)
            CASE ('M', 'X')
               FLAG = DLGGET(DBOX, 1000+I, CVAL(I))
            CASE ('K', 'P', 'S')
               FLAG = DLGGET(DBOX, 1000+I, STR(I))
!        Options 'A', 'C', 'Y' should be included only as needed
            CASE ('A')
               FLAG = DLGGET(DBOX, 1000+I, LongString)
               READ (LongString,*,IOSTAT=ISTAT) (AVAL(J,I),J=1,20)
            END SELECT
            IF (.NOT.FLAG .OR. ISTAT.GT.0) THEN
               PRINT *,'** Data-entry error on line',INT2(I),','
               PRINT *,'   ',STR(I)
            END IF
         END DO
!
         REWIND 1
         WRITE (1,'(A)') NAME(0), ELEMENT, VERSION
         X     = RVAL(1)
         Y     = RVAL(2)
         Z     = RVAL(3)
         Tilt  = RVAL(4)
         WRITE (1, NML=EXTRINSIC)
         Width      = RVAL(5)
         Height     = RVAL(6)
         Z1         = RVAL(7)
         Y1         = RVAL(8)
         D1         = RVAL(9)
         DelY1      = RVAL(10)
         Z2         = RVAL(11)
         Y2         = RVAL(12)
         D2         = RVAL(13)
         DelY2      = RVAL(14)
         Gravity    = RVAL(15)
         Frequency  = RVAL(16)
         PulseWidth = RVAL(17)
         FileName1  = STR(18)(1:20)
         FileName2  = STR(18)(21:40)
         lammin     = RVAL(19)
         lammax     = RVAL(20)
         numberW    = IVAL(21)
         DO I=1,numberW
            RelProb(I) = AVAL(I,22)
            T(I)       = AVAL(I,23)
         END DO
         DO I=numberW+1,20
            RelProb(I) = 0.d0
            T(I)       = 0.d0
         END DO
         Bright     = RVAL(24)
         lam0       = RVAL(25)
         fwhmlam    = RVAL(26)
         Px         = RVAL(27)
         Py         = RVAL(28)
         Pz         = RVAL(29)
         WRITE (1, NML=INTRINSIC)
      END IF
!
      CALL DLGUNINIT(DBOX)
      Zleft = MIN(Zleft, Z)
      Zright = MAX(Zright, Z)
      RETURN
!
!**********  ELMNTBUILD_01  **********
!
      ENTRY ElmntBuild_01(TEST)
!
!  Read values from input file
      READ (1,'(A)') NAME(0)
      READ (1, NML=EXTRINSIC)
      READ (1, NML=INTRINSIC)
      Zleft = MIN(Zleft, Z)
      Zright = MAX(Zright, Z)
!
!  Surfaces   
!
!***** FOLLOWING CODE MUST DEFINE ALL SURFACES FOR THIS ELEMENT TYPE,
!      INCLUDING FLAG FOR CONNECTIVITY
!
      sinTilt = DSIND(Tilt)
      cosTilt = DCOSD(Tilt)
!
!     Surface 1
      SURF(1)%B  = -sinTilt
      SURF(1)%F  = cosTilt
      SURF(1)%G  = -Z*cosTilt + X*sinTilt/1000.
      ICONNCT(1) = +OUTPUT
      NSURF = 1
!
!***** End of Element-Dependent Surface Definitions
!
!  Regions
      LNAME = LEN_TRIM(NAME(0))
      NEXTINDX = 1
!
!***** FOLLOWING CODE MUST DEFINE ALL REGIONS FOR THIS ELEMENT TYPE,
!      INCLUDING NAME, SURFACE RELATIONSHIPS, INDEX, AND PARAMETERS
!
      FileName  = FileName1//FileName2
      Extension = ' '
      I = INDEX(FileName,'.',.TRUE.)
      IF (I .GT. 0) Extension = FileName(I: ) 
!
!     Region 1
      NAME(1) = NAME(0)
      REG(1,1) = -1
      NDX = NEXTINDX
      INDX(1) = NDX
      PARAM(NDX) = 90.d0
!     Special cases:
      IF (DelY1 .NE. 0.d0)            PARAM(NDX) = PARAM(NDX) + 0.1d0
      IF (DelY2 .NE. 0.d0)            PARAM(NDX) = PARAM(NDX) + 0.2d0
      IF (Y1.NE.0.d0 .OR. Y2.NE.0.d0) PARAM(NDX) = PARAM(NDX) + 0.4d0
      PARAM(NDX+MOD_XMIN) = (X - cosTilt*Width/2.d0) / 1000.d0
      PARAM(NDX+MOD_XMAX) = (X + cosTilt*Width/2.d0) / 1000.d0
      PARAM(NDX+MOD_YMIN) = (Y - Height/2.d0) / 1000.d0
      PARAM(NDX+MOD_YMAX) = (Y + Height/2.d0) / 1000.d0
      PARAM(NDX+APTR1_Z)  = Z + Z1
      PARAM(NDX+APTR1_R)  = D1 / 2000.d0
      PARAM(NDX+APTR1_Y)  = DelY1 / 2000.d0
      PARAM(NDX+APTR1_Y_OFFSET) = Y1 / 1000.d0
      PARAM(NDX+APTR2_Z)  = Z + Z2
      PARAM(NDX+APTR2_R)  = D2 / 2000.d0
      PARAM(NDX+APTR2_Y)  = DelY2 / 2000.d0
      PARAM(NDX+APTR2_Y_OFFSET) = Y2 / 1000.d0
      PARAM(NDX+G_DELY2)  = Gravity / 1000.d0
      IF (Frequency .NE. 0.d0) PARAM(NDX+S_PERIOD) = 1.d6/Frequency
      PARAM(NDX+S_WIDTH)  = PulseWidth
      IF (Extension.EQ.'.TBL' .OR. Extension.EQ.'.tbl') THEN
         IF (lammax .NE. 0.d0) PARAM(NDX+S_EMIN) = HSQOV2M/lammax**2
         IF (lammin .NE. 0.d0) PARAM(NDX+S_EMAX) = HSQOV2M/lammin**2
      END IF
      PARAM(NDX+E_OFFSET) = NUMBER_90
      NEXTINDX = NEXTINDX + NUMBER_90
!
!     Region 2
      NAME(2) = FileName
      REG(1,2) = -1
      NDX = NEXTINDX
      INDX(2) = NDX
      IF (Extension.EQ.'.TBL' .OR. Extension.EQ.'.tbl') THEN
         PARAM(NDX) = 91.d0
         IF (LenPath .EQ. 0) THEN
            SourcePath = DataPath(1:LEN_TRIM(DataPath))//'Tables\'
            LenPath = LEN_TRIM(SourcePath)
         END IF
         OPEN (91, FILE=SourcePath(1:LenPath)//FileName, STATUS='OLD',  &
     &         ERR=701)
         READ (91, '(A4,1X,A40)') String(1:4), NAME(2)
         IF (String(1:4).EQ.'SPLI' .OR. String(1:4).EQ.'spli')          &
     &       PARAM(NDX) = 92.d0
         READ (91, *, ERR=701) (PARAM(NDX+I),I=1,NUMBER_91-1)
         String = '    '
         DO WHILE (String(1:4) .NE. 'DATA') 
            READ (91,'(A4)',ERR=701)  String(1:4)
         END DO
!        Check for space available in the PARAM block
         J = MIN(NUMBER_91 + NINT(PARAM(NDX+N_E_TABLE)), NP + 1 - NDX)
         PARAM(NDX+N_E_TABLE) = J - NUMBER_91
         READ (91, *, ERR=701) (PARAM(NDX+I),I=NUMBER_91,J-1)
         CLOSE (91)
         NEXTINDX = NEXTINDX + J
      ELSE IF (Extension.EQ.'.MON' .OR. Extension.EQ.'.mon') THEN
         PARAM(NDX) = 95.d0
         NEXTINDX = NEXTINDX + NUMBER_95
      ELSE 
!        No input file, so either Maxwellians or fixed source
         PARAM(NDX)             = 91.d0
         PARAM(NDX+N_E_TABLE)   = 1
         PARAM(NDX+S_BRIGHT)    = Bright
         PARAM(NDX+TAU_TH1)     = 0.d0
         IF (numberW .GT. 0) THEN
!           Sum of Maxwellians
            PARAM(NDX+CENT_TABLE)  = 0.d0
            PARAM(NDX+SIGMA_TABLE) = numberW
            IF (numberW .GT. 1) THEN
!              Accumulate relative probabilities
               DO I=2,numberW
                  RelProb(I) = RelProb(I-1) + RelProb(I)
               END DO
!              Normalize and copy to output
               DO I=1,numberW-1
                  PARAM(NDX+E_TABLE+2*I-2) = RelProb(I)/RelProb(numberW)
                  PARAM(NDX+E_TABLE+2*I-1) = BOLTZMN*T(I)               
               END DO
            END IF
            PARAM(NDX+E_TABLE+2*numberW-2) = 1.00001d0
            PARAM(NDX+E_TABLE+2*numberW-1) = BOLTZMN*T(numberW)               
            NEXTINDX = NEXTINDX + E_TABLE + 2*numberW
         ELSE
!           Fixed source
            PARAM(NDX+CENT_TABLE)  = HOVERM/lam0
            PARAM(NDX+SIGMA_TABLE) = fwhmlam
            NEXTINDX = NEXTINDX + NUMBER_91
         END IF
      END IF
!
!     Most sources allow polarazation to be appended to table
      IF (PARAM(NDX) .NE. 95.d0) THEN
         PSQ = Px**2 + Py**2 + Pz**2
         IF (PSQ .GT. 1.d-6) THEN
!           Source is polarized
            PARAM(NDX) = PARAM(NDX) + 0.1d0
            IF (PSQ .GT. 1.d0) THEN
               PARAM(NEXTINDX  ) = Px/DSQRT(PSQ)
               PARAM(NEXTINDX+1) = Py/DSQRT(PSQ)
               PARAM(NEXTINDX+2) = Pz/DSQRT(PSQ)
            ELSE   
               PARAM(NEXTINDX  ) = Px
               PARAM(NEXTINDX+1) = Py
               PARAM(NEXTINDX+2) = Pz
            END IF
            NEXTINDX = NEXTINDX + 3
         END IF
      END IF
      NREG = 2
!
!***** End of Element-Dependent Region Definitions
!
      NPARAM = NEXTINDX - 1
      TEST = .TRUE.
      RETURN
!
!**********  ELMNTVIEW_01  **********
!
      ENTRY ElmntView_01(TEST)
!
!  Read values from input file
      READ (1,'(A)') NAME(0)
      READ (1, NML=EXTRINSIC)
      READ (1, NML=INTRINSIC)
      Zleft = MIN(Zleft, Z)
      Zright = MAX(Zright, Z)
!  Relevant parameters are X, Y, Z, Tilt, Width, Height
      dX = Width/2000.d0*DCOSD(Tilt)
      dY = Height/2000.d0
      dZ = -Width/2000.d0*DSIND(Tilt)
!  Calculate strings
      Xstring = ' '
      CALL Digits4(SNGL(X)/1000., Xstring, kX)
      Ystring = ' '
      CALL Digits4(SNGL(Y)/1000., Ystring, kY)
      CALL Digits4(-SNGL(Z), Zstring, kZ)
      STRING = Xstring(1:kX+1)//Ystring(1:kY+1)//Zstring(1:kZ)
      K = kX + kY + kZ + 2
      CALL Digits4(SNGL(X)/1000.-dX, Xleft, kXleft)
      kXleft = kXleft + 1
      Xleft(kXleft:) = ' '
      CALL Digits4(SNGL(X)/1000.+dX, Xright, kXright)
      kXright = kXright + 1
      Xright(kXright:) = ' '
      CALL Digits4(SNGL(Y)/1000.-dY, Ydown, kYdown)
      kYdown = kYdown + 1
      Ydown(kYdown:) = ' '
      CALL Digits4(SNGL(Y)/1000.+dY, Yup, kYup)
      kYup = kYup + 1
      Yup(kYup:) = ' '
      CALL Digits4(-SNGL(Z)-dZ, ZZleft, kZleft)
      CALL Digits4(-SNGL(Z)+dZ, ZZright, kZright)
!  Write the output
      WRITE (9,'(A)') '<!-- '//NAME(0)//' -->'      
      WRITE (9,'(A)') '    <PointLight color="1 0.8 0.8"'
      WRITE (9,'(A)') '                location="'//STRING(1:K)//'"'
      WRITE (9,'(A)') '                radius="30"'
      WRITE (9,'(A)') '                attenuation="1 0.1 0" />'
      WRITE (9,'(A)') '    <Shape>'      
      WRITE (9,'(A)') '      <IndexedFaceSet'      
      WRITE (9,'(A)') '           coordIndex="0 1 2 3 -1 3 2 1 0"'      
      WRITE (9,'(A)') '           colorIndex="0 1"'      
      WRITE (9,'(A)') '           colorPerVertex="false" >'      
      WRITE (9,'(A)') '        <Color color="1 1 1 0.3 0.3 0.3" />'      
      WRITE (9,'(A)') '        <Coordinate point="'
      STRING = Xleft(1:kXleft)//Yup(1:kYup)//ZZleft(1:kZleft)
      WRITE (9,'(12X,A)') STRING
      STRING = Xright(1:kXright)//Yup(1:kYup)//ZZright(1:kZright)
      WRITE (9,'(12X,A)') STRING
      STRING = Xright(1:kXright)//Ydown(1:kYdown)//ZZright(1:kZright)
      WRITE (9,'(12X,A)') STRING
      STRING = Xleft(1:kXleft)//Ydown(1:kYdown)//ZZleft(1:kZleft)//'"'
      WRITE (9,'(12X,A)') STRING
      WRITE (9,'(A)') '        />'      
      WRITE (9,'(A)') '      </IndexedFaceSet>'      
      WRITE (9,'(A)') '    </Shape>'  
      RETURN    
!
!***** Element-Dependent Error Messages
!
701   PRINT *, '*** Failed to read ',SourcePath//FileName
      GO TO 999
710   PRINT *, '*** Failed to find Version number for ',ELEMENT
      GO TO 999!
999   TEST = .FALSE.
      RETURN
      END
