C ORTVEC    SOURCE    CHAT      05/01/13    02:06:42     5004           
C     SUBROUTINE ORTVEC ( MATRED, ILDIM)
************************************************************************        
*                                                                               
*                               ORTVEC                                       
*                             ----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     REALISE L'ORTHONORMALISATION D'UNE FAMILLE DE VECTEURS ECRITE
*     SOUS FOMRE DE MATRICE
*
* MODE D'APPEL:                                 
* -------------
*                                                                               
*     CALL ORTVEC ( MATRED, ILDIM)
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*
*     MATRED  TABLEAU   (E)  TABLEAU CONTENANT LES COORDONNEES
*                            DES VECTEURS
*     MATRED  TABLEAU   (S)  TABLEAU CONTENANT LES COORDONNEES
*                            DE LA BASE
* 
*
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*   C. LE BIDEAU  09 / 2001  ( FORTRAN + ESOPE )                                       
*
***********************************************************************
      SUBROUTINE ORTVEC ( MATRED, ILDIM)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z) 
     
-INC  SMLREEL

******
*     -- ARGUMENTS --
***
      INTEGER  ILDIM
      SEGMENT MATRED
         REAL*8 MATVEC (N, N), MATVE1(N,N), XMAT(N, N)
      END SEGMENT
      
******
*     PREMIER VECTEUR DE BASE
***
         XN = 0.D0
      DO 100 IB100 = 1, ILDIM
         XN  = XN  + MATVEC(IB100, 1)**2
 100  CONTINUE
      IF (MATVEC(1,1) .GT. 0.) THEN
         DO 150 IB150 = 1, ILDIM
            MATVEC(IB150,1)= MATVEC(IB150,1)/SQRT(XN) 
 150     CONTINUE
      ELSE
         DO 160 IB160 = 1, ILDIM
            MATVEC(IB160,1)=-1.D0*MATVEC(IB160,1)/SQRT(XN)
 160     CONTINUE
      END IF
      
******
*     AUTRES VECTEURS DE BASE IB200
***  ** IF ILDIM SUP A 1 **
      DO 200 IB200 = 2, ILDIM 
         DO 300 IB300=1, IB200-1
******
*     ORTHONORME AVEC IB300
***
            XP=0.D0
            XN=0.D0
***PRODUIT SCALAIRE
            DO 400 IB400=1, ILDIM
               XP=XP+MATVEC(IB400,IB200)*
     &         MATVEC(IB400,IB300)
 400        CONTINUE
***ON SOUSTRAIT
            DO 500 IB500=1,ILDIM
               MATVEC(IB500,IB200)=MATVEC(IB500,IB200)
     &         -XP*MATVEC(IB500,IB300)
               XN=XN+MATVEC(IB500,IB200)**2
 500        CONTINUE
            


 300     CONTINUE
***ON NORME SELON LE SIGNE DE LA DIAGONALE
            IF (MATVEC(IB200,IB200).GT. 0.) THEN
               DO 600 IB600=1, ILDIM
                  MATVEC(IB600,IB200)=MATVEC(IB600,IB200)
     &            /SQRT(XN)
 600        CONTINUE
            ELSE
               DO 700 IB700 = 1, ILDIM   
                  MATVEC(IB700,IB200)=-1.D0*
     &            MATVEC(IB700,IB200)/(SQRT(XN))
 700           CONTINUE
            END IF
 200  CONTINUE  
 
      END