C @(#)tddspfit.for	19.1 (ESO-DMD) 02/25/03 14:11:16
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
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 ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  11:40 - 15 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C  900219  KB, throw out SX calls
C
C
C.IDENTIFICATION        TDDSPFIT.FOR
C.KEYWORDS           TABLE, APPLICATIONS
C.ENVIRONMENT  MIDAS
C
C------------------------------------------------------------------
      SUBROUTINE TDRDIS(CPAR,IPAR,RPAR,DPAR,ISTAT)
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.PURPOSE
C      IMPLICIT NONE
C
C DISPLAY STANDARD FIT RESULTS
C
C------------------------------------------------------------------
      CHARACTER*20 CPAR         !   IN : METHOD 
      INTEGER IPAR(*)           !   IN : INTEGER INFO
      REAL RPAR(*)              !   IN : SINGLE PRECISION INFO
      DOUBLE PRECISION DPAR(*)  !   IN : DOUBLE PRECISION INFO
      INTEGER ISTAT             !   OUT: STATUS

      CHARACTER*4 METHOD
C
C BRANCH TO THE CORRESPONDING ROUTINE
C
      METHOD = CPAR(17:20)
      IF (METHOD(1:4).EQ.'LINE') 
     .    CALL TDRDS1(CPAR,IPAR,RPAR,DPAR,ISTAT)
      IF (METHOD(1:4).EQ.'MULT') 
     .    CALL TDRDS2(CPAR,IPAR,RPAR,DPAR,ISTAT)
      RETURN

      END

      SUBROUTINE TDRDS1(CPAR,IPAR,RPAR,DPAR,ISTAT)
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.PURPOSE
C
C DISPLAY STANDARD RESULTS OF THE DISPERSION ANALYSIS
C
C------------------------------------------------------------------
C      IMPLICIT NONE
      CHARACTER*20 CPAR         ! IN  : METHOD
      INTEGER IPAR(*)           ! IN  : INTEGER INFO 
      REAL RPAR(*)              ! IN  : SINGLE PRECISION INFO
      DOUBLE PRECISION DPAR(*)  ! IN  : DOUBLE PRECISION INFO
      INTEGER ISTAT             ! OUT : STATUS
C
      INTEGER I
      CHARACTER*80 FREG01
      CHARACTER*80 FREG02
      CHARACTER*80 FREG03
      CHARACTER*80 FREG04
      CHARACTER*80 FREG05
      CHARACTER*80 FREG06
      CHARACTER*80 FREG07
      DATA FREG01/
     +  ' REGRESSION          Input Table :            Type :          '
     +             /
      DATA FREG02/
     +  ' N.Cases    :         ; N.Ind.Vars   :                        '
     +             /
      DATA FREG03/
     +  ' Dependent variable  :   column #                             '
     +             /
      DATA FREG04/
     +  ' Conf.level:                        Std.Error  :              '
     +             /
      DATA FREG05/
     +  '   Var. Column           Coefficient          Std.Err         '
     +             /
      DATA FREG06/
     +  '         #                                                    '
     +             /
      DATA FREG07/
     +  '   Constant Term                                              '
     +             /
C
      FREG01(15:18) = CPAR(1:4)
      FREG01(37:44) = CPAR(9:16)
      FREG01(54:62) = ' '
      IF (CPAR(17:20).EQ.'LINE') FREG01(54:59) = 'LINEAR'
      IF (CPAR(17:20).EQ.'POWE') FREG01(54:58) = 'POWER'
      IF (CPAR(17:20).EQ.'NONL') FREG01(54:62) = 'NONLINEAR'
      CALL STTPUT(FREG01,ISTAT)
      CALL STTPUT(' ',ISTAT)
      WRITE (FREG02(15:21),9000) IPAR(1)
      WRITE (FREG02(40:42),9020) IPAR(2)
      CALL STTPUT(FREG02,ISTAT)
      WRITE (FREG03(35:37),9020) IPAR(3)
      CALL STTPUT(FREG03,ISTAT)
      WRITE (FREG04(15:27),9010) RPAR(1)
      WRITE (FREG04(50:62),9010) RPAR(2)
C CALL STTPUT(FREG04,ISTAT)
      CALL STTPUT(' ',ISTAT)
      CALL STTPUT(FREG05,ISTAT)
      DO 10 I = 1,IPAR(2)
          WRITE (FREG06(4:6),9020) I
          WRITE (FREG06(12:14),9020) IPAR(I+3)
          WRITE (FREG06(21:41),9030) DPAR(I+1)
          WRITE (FREG06(45:57),9010) RPAR(I+3)
          CALL STTPUT(FREG06,ISTAT)
   10 CONTINUE
      WRITE (FREG07(21:41),9030) DPAR(1)
      WRITE (FREG07(45:57),9010) RPAR(3)
      CALL STTPUT(' ',ISTAT)
      CALL STTPUT(FREG07,ISTAT)
      RETURN

 9000 FORMAT (I7)
 9010 FORMAT (G13.7)
 9020 FORMAT (I3)
 9030 FORMAT (G20.12)
      END

      SUBROUTINE TDRDS2(CPAR,IPAR,RPAR,DPAR,ISTAT)
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.PURPOSE
C
C DISPLAY STANDARD RESULTS OF THE POLYNOMIAL FIT
C
C------------------------------------------------------------------
C      IMPLICIT NONE
      CHARACTER*20 CPAR         ! IN  : METHOD
      INTEGER IPAR(*)           ! IN  : INTEGER INFO
      REAL RPAR(*)              ! IN  : SINGLE PRECISION INFO
      DOUBLE PRECISION DPAR(*)  ! IN  : DOUBLE PRECISION INFO
      INTEGER ISTAT             ! OUT : STATUS
C
      INTEGER I,I1,J
      REAL XX
      CHARACTER*132 FREG01
      CHARACTER*132 FREG02
      CHARACTER*132 FREG03
      CHARACTER*132 FREG04
      CHARACTER*132 FREG05
      CHARACTER*132 FREG06
      CHARACTER*132 FREG07
C
      DATA FREG01/
     +  ' POLYNOMIALS         Input Table :            Type :          '
     +             /
      DATA FREG02/
     +  ' N.Cases    :         ; N.Ind.Vars   :                        '
     +             /
      DATA FREG03/
     +  ' Dependent variable  :   column #                             '
     +             /
      DATA FREG04/
     +  ' Independent variable:   column #           degree :          '
     +             /
      DATA FREG05/
     +  '  degree                                                      '
     +             /
      DATA FREG06/
     +  '                                                              '
     +             /
      DATA FREG07/
     +  '          R.M.S error    :                                    '
     +             /
C
      FREG01(15:18) = CPAR(1:4)
      FREG01(37:44) = CPAR(9:16)
      FREG01(54:62) = 'MUL L-S'
      CALL STTPUT(FREG01,ISTAT)
      CALL STTPUT(' ',ISTAT)
      WRITE (FREG02(15:21),9000) IPAR(1)
      WRITE (FREG02(40:42),9020) IPAR(2)
      CALL STTPUT(FREG02,ISTAT)
      WRITE (FREG03(35:37),9020) IPAR(3)
      CALL STTPUT(FREG03,ISTAT)
      WRITE (FREG04(35:37),9020) IPAR(4)
      WRITE (FREG04(54:56),9020) IPAR(6)
      CALL STTPUT(FREG04,ISTAT)
      WRITE (FREG04(35:37),9020) IPAR(5)
      WRITE (FREG04(54:56),9020) IPAR(7)
      IF (IPAR(2).GT.1) CALL STTPUT(FREG04,ISTAT)
      CALL STTPUT(' ',ISTAT)
      CALL STTPUT(FREG05,ISTAT)
      DO 10 I = 1,IPAR(6) + 1
          I1     = (I-1)* (IPAR(7)+1) + 1
          WRITE (FREG06(4:),9030) I - 1, (DPAR(J),J=I1,I1+IPAR(7))
          CALL STTPUT(FREG06,ISTAT)
   10 CONTINUE
      XX     = RPAR(5)
      XX     = SQRT((XX*XX)/IPAR(1))
      WRITE (FREG07(31:43),9010) XX
      CALL STTPUT(' ',ISTAT)
      CALL STTPUT(FREG07,ISTAT)
      RETURN

 9000 FORMAT (I7)
 9010 FORMAT (G13.7)
 9020 FORMAT (I3)
 9030 FORMAT (I3,1P10E12.4)
      END
