LOCAL INCLUDE 'CHEBI.INC'
C                                       Local include for CHEBI
      INCLUDE 'INCS:ZPBUFSZ.INC'
      INCLUDE 'INCS:PUVD.INC'
      HOLLERITH XOUTFL(12)
      REAL      APARM(10)
      INTEGER   NNCHEB, NCHEB(10), SCRTCH(256)
      CHARACTER OUTFIL*48
      COMMON /INPARM/ APARM, XOUTFL
      COMMON /CHARPM/ OUTFIL
      COMMON /CHEBIC/ NNCHEB, NCHEB, SCRTCH
C                                       End local include for CHEBI
LOCAL END
      PROGRAM CHEBI
C-----------------------------------------------------------------------
C! Write Chebysev polynomial values to text file for PLOTR
C# Utility Plot
C-----------------------------------------------------------------------
C;  Copyright (C) 2023
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C   CHEBI computes a polarized point source model with polarized
C   antennas.
C   Inputs:
C      AIPS adverb  Prg. name.          Description.
C      APARM          APARM         Chebyshev orders
C      OUTFILE        OUTFIL        Output file name
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER  IRET
      INCLUDE 'CHEBI.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      DATA PRGM /'CHEBI '/
C-----------------------------------------------------------------------
C                                       Get input parameters and
C                                       create output file if nec.
      CALL CHEBII (PRGM, IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Call routine that sends data
C                                       to the user routine.
      CALL CHEBID (IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Close down files, etc.
 990  CALL DIE (IRET, SCRTCH)
C
 999  STOP
      END
      SUBROUTINE CHEBII (PRGN, JERR)
C-----------------------------------------------------------------------
C   CHEBII gets input parameters for CHEBI and creates an output file
C   if necessary.
C   Inputs:
C      PRGN    C*6  Program name
C   Output:
C      JERR    I    Error code: 0 => ok
C                                5 => catalog troubles
C                                8 => can't start
C-----------------------------------------------------------------------
      INTEGER   JERR
      CHARACTER PRGN*6
C
      INTEGER   IROUND, NPARM, I, IERR
      INCLUDE 'CHEBI.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
C-----------------------------------------------------------------------
C                                       Init for AIPS, disks, ...
      CALL ZDCHIN (.TRUE.)
      CALL VHDRIN
C                                       Initialize /CFILES/
      NSCR = 0
      NCFILE = 0
      JERR = 0
C                                       Get input parameters.
      NPARM = 22
      CALL GTPARM (PRGN, NPARM, RQUICK, APARM, SCRTCH, IERR)
      IF (IERR.NE.0) THEN
         RQUICK = .TRUE.
         JERR = 8
         IF (IERR.EQ.1) GO TO 999
            WRITE (MSGTXT,1000) IERR, 'OBTAINING INPUT PARAMETERS'
            CALL MSGWRT (8)
         END IF
C                                       Restart AIPS
      IF (RQUICK) CALL RELPOP (JERR, SCRTCH, IERR)
      IF (JERR.NE.0) GO TO 999
      JERR = 5
C                                       Crunch input parameters.
      CALL H2CHR (48, 1, XOUTFL, OUTFIL)
      NNCHEB = 0
      CALL FILL (10, 0, NCHEB)
      DO 10 I = 1,10
         NCHEB(I) = IROUND (APARM(I))
         NCHEB(I) = MIN (NCHEB(I), 99)
         IF (NCHEB(I).GT.0) THEN
            NNCHEB = NNCHEB + 1
         ELSE
            GO TO 990
            END IF
 10      CONTINUE
C
 990  IF (NNCHEB.GT.0) THEN
         JERR = 0
         WRITE (MSGTXT,1010) NNCHEB, NCHEB
         CALL MSGWRT (3)
      ELSE
         MSGTXT = 'NO CHEBYSHEV PLOTS REQUESTED'
         CALL MSGWRT (8)
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('CHEBII: ERROR',I3,' ON',A)
 1010 FORMAT ('Read',I3,' Chebyshevs',10I3)
      END
      SUBROUTINE CHEBID (IRET)
C-----------------------------------------------------------------------
C   CHEBID writes the text FILE
C   Output
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'CHEBI.INC'
      INTEGER   I, J, N, JTRIM, TXLUN, TXIND, K, NX
      DOUBLE PRECISION DA, DB, X, DCHEB(101)
      CHARACTER ALINE*132
      REAL      COL, DC, DX
      INCLUDE 'INCS:DMSG.INC'
      DATA TXLUN /3/
C-----------------------------------------------------------------------
C                                       create output text file
      CALL ZTXOPN ('WRIT', TXLUN, TXIND, OUTFIL, .FALSE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CREATE OUTPUT TEXT FILE'
         GO TO 990
         END IF
C                                       initial lines
      ALINE = 'Chebyshev polynomial values'
      J = JTRIM (ALINE)
      CALL ZTXIO ('WRIT', TXLUN, TXIND, ALINE(:J), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'WRITE TEXT FILE'
         GO TO 980
         END IF
      WRITE (ALINE,1010) (NCHEB(I), I = 1,NNCHEB)
      J = JTRIM (ALINE)
      CALL ZTXIO ('WRIT', TXLUN, TXIND, ALINE(:J), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'WRITE TEXT FILE'
         GO TO 980
         END IF
      ALINE = ' '
      J = 1
      CALL ZTXIO ('WRIT', TXLUN, TXIND, ALINE(:J), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'WRITE TEXT FILE'
         GO TO 980
         END IF
      ALINE = 'X'
      CALL ZTXIO ('WRIT', TXLUN, TXIND, ALINE(:J), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'WRITE TEXT FILE'
         GO TO 980
         END IF
      ALINE = 'Chebyshev value'
      J = JTRIM (ALINE)
      CALL ZTXIO ('WRIT', TXLUN, TXIND, ALINE(:J), IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'WRITE TEXT FILE'
         GO TO 980
         END IF
C                                       now the values
      DA = 0.0D0
      DB = 1.0D0
      DC = 1.0 / (NNCHEB + 1)
      DO 100 K = 1,NNCHEB
         N = NCHEB(K)
         COL = K * DC
         IF (N.LT.7) THEN
            DX = 0.02
         ELSE IF (N.LT.12) THEN
            DX = 0.01
         ELSE
            DX = 0.005
            END IF
         NX = 1 / DX
         DO 90 I = 0,NX
            X = I * DX
            CALL CHEBY (DA, DB, X, DCHEB, N, IRET)
            IF (IRET.EQ.0) THEN
               IF (NNCHEB.GT.1) THEN
                  WRITE (ALINE,1020) X, DCHEB(N+1), K, COL
               ELSE
                  WRITE (ALINE,1020) X, DCHEB(N+1), K
                  END IF
               J = JTRIM (ALINE)
               CALL ZTXIO ('WRIT', TXLUN, TXIND, ALINE(:J), IRET)
               IF (IRET.NE.0) THEN
                  WRITE (MSGTXT,1000) IRET, 'WRITE TEXT FILE'
                  GO TO 980
                  END IF
               END IF
 90         CONTINUE
 100     CONTINUE
      CALL ZTXCLS (TXLUN, TXIND, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSE TEXT FILE'
         GO TO 990
         END IF
      GO TO 999
C                                       errors
 980  CALL MSGWRT (8)
      CALL ZTXCLS (TXLUN, TXIND, I)
      IF (I.EQ.0) GO TO 999
      WRITE (MSGTXT,1000) I, 'CLOSE TEXT FILE'
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('CHEBID ERROR',I4,' ON ',A)
 1010 FORMAT ('Chebyshev orders',10I3)
 1020 FORMAT (F8.4,F9.4,I4,F7.3)
      END

