*DECK TLMPNT
      SUBROUTINE TLMPNT(IPMAT ,IFTRK ,IPRINT,NSKTRK,NBTR  ,NDIM  ,
     >                  NREG  ,NSUR  ,MXSUB ,MXSEG ,NANGL ,NBDR  ,
     >                  NPLOTS,IPLOT ,IPLP  ,DANGLT,DVNOR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To generate the Matlab instruction for drawing the
* external surface intersection points.
*
*Copyright:
* Copyright (C) 2006 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s):
* C. Plamondon, G. Marleau
*
*Parameters: input
* IPMAT   pointer to Matlab -m file.
* IFTRK   pointer to the TRACKING file.
* IPRINT  print level.
* NSKTRK  number of records to skip on track file before tracking
*         lines can be extracted.
* NBTR    numbre of tracks.
* NDIM    number of dimensions for problem.
* NREG    number of regions for problem.
* NSUR    number of outer surfaces for problem.
* MXSUB   maximum number of subtracks in a line.
* MXSEG   maximum number of segments in a line.
* NANGL   number of direction for tracking.
* NBDR    number of direction for volume normalization.
* NPLOTS  number of plots.
* IPLOT   plot number being processed.
* IPLP    integer plot parameters.
* DANGLT  track directions.
* DVNOR   track normalization factor for regional volumes.
*
*----------
*
      IMPLICIT         NONE
*----
*  Subroutine arguments
*----
      INTEGER          IPMAT,IFTRK
      INTEGER          IPRINT,NSKTRK,NBTR,NDIM,NREG,NSUR,MXSUB,MXSEG,
     >                 NANGL,NBDR,NPLOTS,IPLOT
      INTEGER          IPLP(6,NPLOTS)
      DOUBLE PRECISION DANGLT(NDIM,NANGL),
     >                 DVNOR(NREG,NBDR)
*----
*  Local parameters
*----
      INTEGER          IOUT
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NAMSBR='TLMPNT')
*----
*  Local variables for tracking file
*----
      INTEGER          ILINE,IDUM,NBSEG,NTLINE,ISEG,KSEG,
     >                 IPLANE,IPTA2,IPTA3,NSUB,ISUB,II
      DOUBLE PRECISION WEIGHT
*----
*  Other local variables
*----
      INTEGER          ISUR,IFACE,IDIR,ISV,IENTER
      DOUBLE PRECISION DXYZ(3),FLEN
      CHARACTER        TITLE*36
*----
*  Allocatable arrays
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: NUMERO,KANGL
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: LENGTH
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: TORIG
*----
*  Data
*----
      CHARACTER        ACOL(0:6)*2
      DATA             ACOL /'b.','g.','r.','c.','m.','y.','k.'/
*----
*  Scratch storage allocation
*   NUMERO  region/surface identification number for segment.
*   LENGTH  segment length.
*----
      ALLOCATE(NUMERO(MXSEG),LENGTH(MXSEG))
      ALLOCATE(KANGL(MXSUB),TORIG(NDIM,MXSUB))
*----
*  Processing starts:
*  print routine opening header if required
*  and initialize various parameters.
*----
      IF(IPRINT .GE. 1) THEN
        WRITE(IOUT,6000) NAMSBR
      ENDIF
*----
* Print IPMAT header
*----
      WRITE(TITLE,'(A18,18X)') 'Points on surfaces'
      WRITE(IPMAT,7000) NAMSBR,TITLE
*----
* Identify points associated with each surface
*----
      DO ISUR=1,NSUR
        IF(IPRINT .GE. 10) THEN
          WRITE(IOUT,6002) ISUR
        ENDIF
        DO ILINE=1,NSKTRK
          READ(IFTRK) IDUM
        ENDDO
        IFACE=0
*----
*  Scan over lines
*----
        DO ILINE=1,NBTR
          READ(IFTRK) NSUB,NBSEG,WEIGHT,
     >                (KANGL(II),II=1,NSUB),
     >                (NUMERO(ISEG),ISEG=1,NBSEG),
     >                (LENGTH(ISEG),ISEG=1,NBSEG),
     >                NTLINE,IPLANE,IPTA2,IPTA3,
     >                ((TORIG(IDIR,ISUB),IDIR=1,NDIM),ISUB=1,NSUB)
*----
*  Find line segment location
*----
          ISUB=0
          IENTER=-1
          DO ISEG=1,NBSEG
            ISV=NUMERO(ISEG)
            IF(ISV .EQ. -ISUR) THEN
              IF(IENTER .EQ. -1) THEN
                ISUB=ISUB+1
                IF(ISUB.GT.NSUB) THEN
                  WRITE(IOUT,9000) ILINE
                  WRITE(IOUT,9001)
     >            (NUMERO(KSEG),LENGTH(KSEG),KSEG=1,NBSEG)
                  CALL XABORT(NAMSBR//': Invalid tracking line')
                ENDIF
                DO IDIR=1,NDIM
                  DXYZ(IDIR)=TORIG(IDIR,ISUB)
                ENDDO
              ENDIF
              IENTER=-IENTER
              IFACE=IFACE+1
              IF(IFACE .EQ. 1) THEN
                WRITE(IPMAT,7002) ISUR
              ENDIF
              WRITE(IPMAT,7004) (DXYZ(IDIR),IDIR=1,NDIM),ILINE
            ELSE IF(ISV .GT. 0) THEN
              IF(NBDR.EQ.1) THEN
                FLEN=LENGTH(ISEG)/DVNOR(ISV,1)
              ELSE
                FLEN=LENGTH(ISEG)/DVNOR(ISV,KANGL(1)+1)
              ENDIF
              DO IDIR=1,NDIM
                DXYZ(IDIR)=DXYZ(IDIR)+
     >          DANGLT(IDIR,KANGL(1))*FLEN
              ENDDO
            ENDIF
          ENDDO
        ENDDO
*----
*  Write Matlab commands to print points
*----
        IF(IFACE .GE. 1) THEN
          WRITE(IPMAT,7003)
          IF(NDIM .EQ. 2) THEN
            WRITE(IPMAT,7010) ISUR,ACOL(MOD(ISUR,7))
          ELSE
            WRITE(IPMAT,7011) ISUR,ACOL(MOD(ISUR,7))
          ENDIF
          WRITE(IPMAT,7090)
          IF(IPLP(1,IPLOT) .GT. 0) WRITE(IPMAT,7091)
        ENDIF
        REWIND IFTRK
      ENDDO
      WRITE(IPMAT,7093)
      IF(IPLP(1,IPLOT) .LT. 0) WRITE(IPMAT,7091)
*----
*  Processing finished, return
*----
      IF(IPRINT .GE. 1) THEN
        WRITE(IOUT,6001) NAMSBR
      ENDIF
*----
*  Scratch storage deallocation
*----
      DEALLOCATE(KANGL,TORIG)
      DEALLOCATE(LENGTH,NUMERO)
      RETURN
*----
*  Output formats
*----
 6000 FORMAT('(* Output from --',A6,'-- follows ')
 6001 FORMAT('   Output from --',A6,'-- completed *)')
 6002 FORMAT(' Processing points for surface = ',I8)
*----
*  Matlab .m file format
*----
 7000 FORMAT('%'/'% Output from ',A6/'%'/'%hold on;'/
     >7Htitle(',A36,3H');)
 7002 FORMAT('% Points for Surface ',I10/
     >       'TLMSurfacePoints=[')
 7003 FORMAT(12X,'];')
 7004 FORMAT(3F18.10,2X,I10)
 7010 FORMAT('% Plot surface ',I10/
     >       'plot(TLMSurfacePoints(:,1),',
     >            'TLMSurfacePoints(:,2),',1H',A2,3H');)
 7011 FORMAT('% Plot surface ',I10/
     >       'plot3(TLMSurfacePoints(:,1),',
     >             'TLMSurfacePoints(:,2),',
     >             'TLMSurfacePoints(:,3),',1H',A2,3H');)
 7090 FORMAT('clear TLMSurfacePoints;')
 7091 FORMAT('pause ;')
 7093 FORMAT('hold off ;')
*----
*  Errors
*----
 9000 FORMAT(' ***** Error **** '/
     >       ' Number of track cycles exceeded for line ', I10)
 9001 FORMAT(1P,4(1X,I10,E20.10))
      END
