C
C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     LFN_LIST_PROFS      **
C*****************************
C
CD-Routine: Write Spot Profiles - LFN_LIST_PROFS
C This routine is used to write a spot profile or set of spot profiles
C calculated by a profile determining pass of the routine LFN_SAINT.
CD-end
CD-Fortran:
      SUBROUTINE LFN_LIST_PROFS (IUN, ITERM, IPROF, NPL, MAXLIN, 
     +                           NSEP, NBLANK, IERR, ERRSTR)
CD-end
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: Write out profiles calculated by LFN_SAINT
C 
C AUTHOR: J.W. Campbell 
C
C ARGUMENTS:
C
      INTEGER IUN
      INTEGER ITERM
      INTEGER IPROF
      INTEGER NPL
      INTEGER MAXLIN
      INTEGER NSEP
      INTEGER NBLANK
      INTEGER IERR
      CHARACTER*(*) ERRSTR
CD-Parameters:
C   IUN       i (R)  Unit number for listing (0=no printing)
C   ITERM     i (R)  =1 output to a terminal, =0 output to a file
C   IPROF     i (R)  Bin no. of profile to be listed, 0=all
C   NPL       i (R)  No. of profiles to o/p per line (if 0 then will
C                    be calculated from MAXLIN). Will be reduced to
C                    that calculated from MAXLIN if it exceeds that.
C                    (Only relevant if IPROF=0)
C   MAXLIN    i (R)  Maximum length for o/p line (up to 132) (note if 
C                    the width of a single profile exceeds this then the 
C                    line length will also exceed this).
C                    (Only relevant if IPROF=0)
C   NSEP      i (R)  No. of separating spaces between profile o/p on
C                    same line (>=1) (Only relevant if IPROF=0)
C   NBLANK    i (R)  No. of blank lines between rows of profiles (>=1)
C                    (Only relevant if IPROF=0)
C   IERR      i (W)  Error flag =0 OK
C                               =1 Requested profile bin out of range
C   ERRSTR    c (W)  Error message string (max 80 chars) set if IERR is 
C                    non-zero
CD-end
C
C====== Parameter statements
C 
      INCLUDE 'saint_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'lfn_saint.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER IX
      INTEGER IY
      INTEGER IWID
      INTEGER ISEP
      INTEGER MXLEN
      INTEGER NBL
      INTEGER NPROFS
      INTEGER NPOSS
      INTEGER NPERLIN
      INTEGER NROWS
      INTEGER IROW
      INTEGER ICOL
      INTEGER IPROF_MIN
      INTEGER IPROF_MAX
      INTEGER KPROF
      INTEGER K
      INTEGER IS
      INTEGER II
      INTEGER INUM
      REAL ANG
      REAL PFMAX
      REAL SC_PROF(MAX_PRBIN)
      CHARACTER*(MAX_PRLIN) LIN
      CHARACTER*(MAX_PRLIN) STR
      CHARACTER*1 NUMCH(16)

C     INTEGER I                 !Temp/loop variable
C     INTEGER IX                !Loop over 'x' pixels (offsets)
C     INTEGER IY                !Loop over 'y' pixels (offsets)
C     INTEGER IWID              !Width required for o/p of profile
C     INTEGER ISEP              !Separation between profiles on same line
C     INTEGER MXLEN             !Maximum requested line length (max 132)
C     INTEGER NBL               !No. of blank lines between rows of profiles
C     INTEGER NPROFS            !No. of profiles to o/p
C     INTEGER NPOSS             !No. of profiles possible on one line
C     INTEGER NPERLIN           !No. (actual) to o/p per line
C     INTEGER NROWS             !No. of rows of profiles
C     INTEGER IROW              !Loop through rows of profiles
C     INTEGER ICOL              !Loop through columns of profiles
C     INTEGER IPROF_MIN         !Minimum profile no. to o/p
C     INTEGER IPROF_MAX         !Maximum profile no. to o/p
C     INTEGER KPROF             !Current profile number
C     INTEGER K                 !Character position in STR
C     INTEGER IS                !Position in o/p line
C     INTEGER II                !Index to profile arrays
C     INTEGER INUM              !Profile value scaled to range 0-15
C     REAL ANG                  !Angle at start/end of profile bin 
C     REAL PFMAX                !Maximum value in current profiles
C     REAL SC_PROF(MAX_PRBIN)   !Scale factors to scale profiles in range 0-15
C     CHARACTER*(MAX_PRLIN) LIN !Output line
C     CHARACTER*(MAX_PRLIN) STR !Entry to add to output line
C     CHARACTER*1 NUMCH(16)     !Character equivalents of numbers 0-15

      DATA NUMCH/'0','1','2','3','4','5','6','7','8','9',
     +           'A','B','C','D','E','F'/
C
C------------------------------------------------------------------------------- 
C
      IERR = 0
      ERRSTR = ' '
      IF (IUN.LE.0) RETURN
      IF (IPROF.LT.0.OR.IPROF.GT.NPROF_BIN) THEN
         IERR = 1
         ERRSTR = 'Profile was not calculated for bin'
         CALL STR_ADDI (ERRSTR, IPROF, 1)
         RETURN
      END IF
      ISEP = NSEP
      IF (ISEP.LT.1) ISEP = 1
C
C====== Get width required for a profile
C
      IWID = 2*NPR_HALF + 1
      IF (IWID.LT.13) IWID = 13
      MXLEN = MAXLIN
      IF (MXLEN.GT.132) MXLEN = 132
      NPOSS = (MXLEN+ISEP)/(IWID+ISEP)
      IF (NPOSS.LT.1) NPOSS = 1
      NPERLIN = NPOSS
      IF (NPL.GT.0.AND.NPL.LT.NPOSS) NPERLIN = NPL
      NPROFS = 1
      IF (IPROF.EQ.0) NPROFS = NPROF_BIN
      NROWS = (NPROFS-1)/NPERLIN + 1
      IPROF_MIN = IPROF
      IPROF_MAX = IPROF
      IF (IPROF.EQ.0) THEN
         IPROF_MIN = 1
         IPROF_MAX = NPROF_BIN
      END IF
      NBL = NBLANK
      IF (NBL.LT.1) NBL = 1
C
C====== Get factors to scale profiles to 15.0
C
      DO 20 KPROF = IPROF_MIN, IPROF_MAX
         PFMAX = 0.0
         SC_PROF(KPROF) = 1.0
         DO 10 I = 1, NUM_IN_PROF
            IF (PROF(I,KPROF).GT.PFMAX) PFMAX = PROF(I,KPROF)
 10      CONTINUE
         IF (PFMAX.GT.0.0) SC_PROF(KPROF) = 15.0/PFMAX
 20   CONTINUE
C
C====== Loop through no. of rows of profiles
C====== ------------------------------------
C
      DO 200 IROW = 1, NROWS
         IF (IROW.GT.1) THEN
            DO 30 I = 1, NBL
               IF (ITERM.EQ.1) THEN
                  CALL TTSEND (IUN,' ',1)
               ELSE
                  WRITE(IUN,1001)
               END IF
 30         CONTINUE
         END IF
C
C====== Header line
C
         LIN = ' '
         DO 100 ICOL = 1, NPERLIN
            KPROF = IPROF_MIN + (IROW-1)*NPERLIN + ICOL - 1
            IF (KPROF.GT.IPROF_MAX) GO TO 100
            STR = 'Profile'
            CALL STR_ADDI (STR, KPROF, 1)
            IS = (ICOL-1)*(IWID+ISEP) + 1
            LIN(IS:) = STR 
 100     CONTINUE
         IF (ITERM.EQ.1) THEN
            CALL TTSEND (IUN,LIN(1:LENSTR(LIN)),1)
         ELSE
            WRITE(IUN,1000) LIN(1:LENSTR(LIN))
         END IF
C
C====== Angle ranges line
C
         DO 110 ICOL = 1, NPERLIN
            KPROF = IPROF_MIN + (IROW-1)*NPERLIN + ICOL - 1
            IF (KPROF.GT.IPROF_MAX) GO TO 110
            STR = '('
            ANG = (KPROF-1)*360.0/FLOAT(NPROF_BIN)
            CALL STR_ADDF (STR, ANG, 1, 0)
            CALL STR_ADDS (STR, '-', 0)
            ANG = KPROF*360.0/FLOAT(NPROF_BIN)
            CALL STR_ADDF (STR, ANG, 1, 0)
            CALL STR_ADDS (STR, ')', 0)
            IS = (ICOL-1)*(IWID+ISEP) + 1
            LIN(IS:) = STR 
 110     CONTINUE
         IF (ITERM.EQ.1) THEN
            CALL TTSEND (IUN,LIN(1:LENSTR(LIN)),1)
         ELSE
            WRITE(IUN,1000) LIN(1:LENSTR(LIN))
         END IF
C
C====== Profile data lines
C
         DO 150 IY = NPR_HALF, -NPR_HALF, -1
            DO 140 ICOL = 1, NPERLIN
               KPROF = IPROF_MIN + (IROW-1)*NPERLIN + ICOL - 1
               IF (KPROF.GT.IPROF_MAX) GO TO 140
               STR = ' '
               DO 130 IX = -NPR_HALF, NPR_HALF
                  K = IX + NPR_HALF + 1
                  STR(K:K) = '.'
                  IF (INDXPR(IX,IY).GT.0) THEN
                     II = INDXPR(IX,IY)
                     IF (SHAPE_PROF(II).LT.0) THEN
                        STR(K:K) = '*'
                     ELSE
                        INUM = NINT (SC_PROF(KPROF)*PROF(II,KPROF))
                        IF (INUM.LT.0) INUM = 0
                        IF (INUM.GT.15) INUM = 15
                        STR(K:K) = NUMCH(INUM+1)
                     END IF
                  END IF
 130           CONTINUE
               IS = (ICOL-1)*(IWID+ISEP) + 1
               LIN(IS:) = STR 
 140        CONTINUE
            IF (ITERM.EQ.1) THEN
               CALL TTSEND (IUN,LIN(1:LENSTR(LIN)),1)
            ELSE
               WRITE(IUN,1000) LIN(1:LENSTR(LIN))
            END IF
 150     CONTINUE
 200  CONTINUE
      RETURN
C
C====== Format statements
C
1000  FORMAT(A)
1001  FORMAT(' ')
      END
