C GRAAM1    SOURCE    CHAT      05/01/13    00:19:22     5004           
C GRAAM1    SOURCE    WP        23/08/94                
C      SUBROUTINE GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
************************************************************************        
*                                                                               
*                                GRAMM1                                       
*                               --------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     ORTHONORMALISER UN 'CHPOINT' PAR RAPPORT A UNE SUITE DE 'CHPOINT'.
*     MEME CHOSE QUE ORTH1, MAIS PLUS SIMPLE. CE PROGRAMME SERA MODIFIE
*     DE FACON A REDUIRE LE NOMBRE D'OPERATIONS.        
*
* MODE D'APPEL:                                 
* -------------                                                                 
*                                                                               
*     CALL GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*                                                                               
*     IPCHNO  ENTIER    (E)  POINTEUR SUR L'OBJET 'CHPOINT' DEVANT
*                            ETRE ORTHOGONALISE.
*
*     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' PAR
*                            RAPPORT AUQUEL ON ORTHOGONALISE.
*
*     IPLSO   ENTIER    (E)  POINTEUR SUR L'OBJET 'LISTCHPO' CONTENANT
*                            LA SUITE DE 'CHPOINT' OTHOGONAUX PAR
*                            RAPPORT AUXQUELS 'CHNO' EST ORTHOGONALISE.
*
*     IPCHO   ENTIER    (S)  POINTEUR SUR L'OBJET 'CHPOINT' CONTENANT
*                            LE 'CHPOINT' SOLUTION.
*
*
* MODE DE FONCTIONNEMENT:                                                       
* -----------------------                                                       
*                                                                               
*     PROCEDE D'ORTHOGONALISATION DE GRAAM-SCHMITT.                                  
*
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     A.M. JOLIVALT, W. PASILLAS     06 / 07 / 94. 
*
************************************************************************

      SUBROUTINE GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC  CCOPTIO

******
*     -- ARGUMENTS --
***                                                   
      INTEGER IPCHNO, IPRIGI, IPLSO, IPCHO

******
*     -- VARIABLES LOCALES --
***
      INTEGER  IPUI, IPCHO1, IB100, ILDIM
      REAL*8   ALPHA, UTMUI, UITMUI 
      
      CALL DIMEN2 ( IPLSO, ILDIM )
      IF ( IERR .NE. 0 ) RETURN
      CALL COPIE2 ( IPCHNO, IPCHO )
      IF ( IERR .NE. 0 ) RETURN
      IF ( ILDIM .GT. 0 ) THEN
         DO 100 IB100 = 1, ILDIM
            CALL EXTRA4 ( IPLSO, IB100, IPUI )
            IF ( IERR .NE. 0 ) RETURN
            CALL YTMX   ( IPCHNO, IPUI, IPRIGI, UTMUI )
            IF ( IERR .NE. 0 ) RETURN
            CALL XTMX   ( IPUI, IPRIGI, UITMUI )
            IF ( IERR .NE. 0 ) RETURN
            ALPHA = ( -1.D0 * UTMUI ) / UITMUI
            CALL COMBI2( IPCHO, 1.D0, IPUI, ALPHA, IPCHO1 )
            IF ( IERR .NE. 0 ) RETURN
            CALL DTCHPO( IPCHO )
            IF ( IERR .NE. 0 ) RETURN
            IPCHO = IPCHO1
 100     CONTINUE
      ENDIF

      RETURN
      END