C @(#)dcprin.for	19.1 (ES0-DMD) 02/25/03 13:17:29
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 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding 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
      SUBROUTINE DCPRIN(A,N,NDIM)                                               
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++                   
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,                  
C                                         all rights reserved                   
C                                                                               
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  17:25 - 13 JAN 1988                 
C                                                                               
C.LANGUAGE: F77+ESOext                                                          
C                                                                               
C.AUTHOR: J.D.PONZ                                                              
C                                                                               
C.IDENTIFICATION                                                                
C                                                                               
C  FITLIB.FOR   VERSION 1.0  27 MAR 1984                                        
C                                                                               
C.PURPOSE                                                                       
C                                                                               
C  INTERFACE ROUTINES FOR THE FITTING STRUCTURES                                
C                                                                               
C.ALGORITHM                                                                     
C                                                                               
C  USE MIDAS I/O INTERFACES TO FRAMES AND TABLES                                
C                                                                               
C.KEYWORDS                                                                      
C                                                                               
C  NON LINEAR FITTING                                                           
C                                                                               
C                                                                               
C----------------------------------------------------------------               
C                                                                               
C PRINT CORRELATION MATRIX                                                      
C      IMPLICIT NONE                                                            
C                                                                               
C INPUT PARAMS                                                                  
C A DBLE INPUT MATRIX (COVARIANCE)                                              
C N INTG NUMBER OF PARAMS                                                       
C NDIM INTG DIMENSION OF THE MATRIX                                             
C                                                                               
      INTEGER N,NDIM,K,ISTAT,I,J,II,IC(129)
      DOUBLE PRECISION A(NDIM,NDIM)                                             
      REAL C(129),B,D                                        
      CHARACTER*80 IGNR,TEXT*22
c      DATA ITEXT/1H-,1HI,1HH,1HG,1HF,1HE,1HD,1HC,1HB,1HA,1H0,1H1,1H2,           
c     +     1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H+,1H//                                 
                                                                                
      TEXT(1:) = '-IHGFEDCBA0123456789+/'
      IF (N.LT.2) RETURN                                                        
      K      = 5                                                                
      IF (N.GT.76) GO TO 120                                                    
      IF (N.GT.10) K      = 1                                                   
      IF (N.GT.15) K      = 2                                                   
      IF (N.GT.25) K      = 3                                                   
      IF (N.GT.38) K      = 4                                                   
      CALL STTPUT(' Estimated correlations matrix ',ISTAT)                      
      CALL STTPUT(' _____________________________ ',ISTAT)                      
      CALL STTPUT(' ',ISTAT)                                                    
      DO 110 I = 2,N                                                            
          B      = SNGL(A(I,I))                                                 
          II     = I - 100* (I/100)                                             
          DO 10 J = 1,I - 1                                                     
              D      = SNGL(A(J,J))*B                                           
              IF (D.LE.0.0) THEN                                                
                  C(J)   = 0.0                                                  
                                                                                
              ELSE                                                              
                  C(J)   = SNGL(A(I,J))/SQRT(D)                                 
                  IF (ABS(C(J)).GT.1.0) GO TO 130                               
              END IF                                                            
                                                                                
   10     CONTINUE                                                              
          GO TO (20,30,50,70,90),K                                              
                                                                                
   20     WRITE (IGNR,9010) I, (C(J),J=1,I-1)                                   
          GO TO 100                                                             
                                                                                
   30     DO 40 J = 1,I - 1                                                     
              IC(J)  = INT(100.0*C(J))                                          
   40     CONTINUE                                                              
          WRITE (IGNR,9020) I, (IC(J),J=1,I-1)                                  
          GO TO 100                                                             
                                                                                
   50     DO 60 J = 1,I - 1                                                     
              IC(J)  = INT(10.0*C(J))                                           
   60     CONTINUE                                                              
          WRITE (IGNR,9030) I, (IC(J),J=1,I-1)                                  
          GO TO 100                                                             
                                                                                
   70     DO 80 J = 1,I - 1                                                     
              IF (C(J).GT.99999.9) C(J)   = 1.1                                 
              IC(J)  = INT(10.0* (1.0+C(J))) + 1                                
   80     CONTINUE                                                              
cc          WRITE (IGNR,9040) II, (ITEXT(IC(J)),J=1,I-1)                          
          WRITE(IGNR,9040)II,(TEXT(IC(J):IC(J)),J=1,I-1)
          GO TO 100                                                             
                                                                                
   90     WRITE (IGNR,9000) I, (C(J),J=1,I-1)                                   
  100     CALL STTPUT(IGNR,ISTAT)                                               
  110 CONTINUE                                                                  
      CALL STTPUT(' ',ISTAT)                                                    
      RETURN                                                                    
                                                                                
  120 CALL STTPUT(' ',ISTAT)                                                    
      CALL STTPUT('*** WARN-CORR : Correlation matrix is too '//                
     +            'big ***',ISTAT)                                              
      RETURN                                                                    
                                                                                
  130 CALL STTPUT(' ',ISTAT)                                                    
      CALL STTPUT('*** ERR-CORR : Error in correlation matrix ***',             
     +            ISTAT)                                                        
      WRITE (*,*) I,J                                                           
      RETURN                                                                    
                                                                                
 9000 FORMAT (1X,I2,' |',10F7.4)                                                
 9010 FORMAT (1X,I2,' |',15F5.2)                                                
 9020 FORMAT (1X,I2,' |',25I3)                                                  
 9030 FORMAT (1X,I2,1X,38I2)                                                    
 9040 FORMAT (1X,I2,1X,A)                                                    
      END                                                                       
