C CONREL    SOURCE    CHAT      05/01/12    22:18:30     5004           
C     SUBROUTINE CONREL (MATRED, ILDIM, CONVRG,I )
************************************************************************        
*                                                                               
*                                CONREL                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     REALISE LE CRITERE DE CONVERGENCE DE L'ITERATION DANS LE CAS DE
*     VALEURS PROPRES REELLES. 
*
* MODE D'APPEL:                                 
* -------------
*                                                                               
*     CALL CONREL (MATRED, ILDIM , CONVRG)
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*
*     MATRED  TABLEAU   (E)  TABLEAU CONTENANT LES COORDONNEES
*                            DU SYSTEME REDUIT, ET CELLES DES 
*                            VECTEURS DE DEUX ITERATIONS SUCCESSIVES.
* 
*
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*   C. LE BIDEAU  09 / 2001  ( FORTRAN + ESOPE )                                       
*
***********************************************************************

      SUBROUTINE CONREL (MATRED, ILDIM, CONVRG,I )
                      
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC  CCOPTIO
-INC  SMLCHPO
-INC  SMLREEL

******
*     -- ARGUMENTS --
***
      INTEGER  ILDIM, CONVRG
      SEGMENT MATRED
         REAL*8 MATVEC (N, N),MATVE1(N,N), XMAT(N, N)
      END SEGMENT
      SEGMENT INTER
         REAL*8 RES(N4,N4)
      END SEGMENT
******
*     INITIALISATION 
***
      CONVRG = 0
      N4 =ILDIM
      SEGINI INTER
******
*     DIFFERENCE DES VECTEURS
*     ET NORME DE LA DIFFERENCE
***
      DO 100 IB100 = 1, ILDIM
      XN1=0.D0
      XN2=0.D0
      XS =0.D0
      XD =0.D0
         DO 200 IB200 = 1, ILDIM
            XS=MATVEC(IB200,IB100)+MATVE1(IB200,IB100)
            XD=MATVEC(IB200,IB100)-MATVE1(IB200,IB100)
            XN1=XN1+(XD)**2
            XN2=XN2+(XS)**2
 200     CONTINUE
         IF (XN1 .GT. 1.D-15.AND.
     &   XN2 .GT. 1.D-15) THEN
******
*   test dimension vecteur ib100: si complexe dimension 2
***
       DO 300 IB300 = 1, ILDIM
               XX=0.D0
               XP=0.D0
               DO 350 IB350= 1, ILDIM
                  XP=XMAT(IB300, IB350)*MATVEC(IB350, IB100)
                  XX = XX+ XP
 350           CONTINUE
               RES(ib300,ib100)=XX
 300        CONTINUE
******
*   DECOMPOSITION SUR LES DEUX ITERES PRECEDENTS
***
            XN=0.D0
            DO 1000 IB1000 = 1, ILDIM
               XN  = XN  + MATVE1(IB1000, IB100)**2
 1000       CONTINUE
            DO 1500 IB1500 = 1, ILDIM
            MATVE1(IB1500,IB100)= MATVE1(IB1500,IB100)/SQRT(XN) 
 1500       CONTINUE     
            XP = 0.D0
            DO 400 IB400=1, ILDIM
               XP=XP+MATVEC(IB400,IB100)*
     &         MATVE1(IB400,IB100)
 400        CONTINUE
            DO 5000 IB5000=1,ILDIM
               MATVEC(IB5000,IB100)=MATVEC(IB5000,IB100)
     &         -XP*MATVE1(IB5000,IB100)
               XN=XN+MATVEC(IB5000,IB100)**2
 5000       CONTINUE
            DO 600 IB600=1, ILDIM
                  MATVEC(IB600,IB100)=MATVEC(IB600,IB100)
     &            /SQRT(XN)
 600        CONTINUE
            XP1=0.D0
            XP2=0.D0
            DO 4000 IB4000=1, ILDIM
               XP1=XP1+RES(IB4000,IB100)*
     &         MATVE1(IB4000,IB100)
               XP2=XP2+RES(IB4000,IB100)*
     &         MATVEC(IB4000,IB100)       
 4000       CONTINUE
            XN=0.D0
            DO 6000 IB6000=1,ILDIM
               RES(IB6000,IB100)=RES(IB6000,IB100)
     &        -XP1*MATVE1(IB6000,IB100)
     &        -XP2*MATVEC(IB6000,IB100)
               XN=XN+RES(IB6000,IB100)**2
 6000       CONTINUE
*            WRITE(6,*)'CRITERE CONV', XN
            IF(XN.GT.1E-10) CONVRG = CONVRG + 1
         END IF
         
 100  CONTINUE
 
 
      SEGSUP INTER
      END