Esope source files

   1 : C GRAAM1    SOURCE    CHAT      05/01/13    00:19:22     5004           
   2 : C GRAAM1    SOURCE    WP        23/08/94                
   3 : C      SUBROUTINE GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
   4 : ************************************************************************        
   5 : *                                                                               
   6 : *                                GRAMM1                                       
   7 : *                               --------                                       
   8 : *                                                                               
   9 : * FONCTION:                                                                     
  10 : * ---------                                                                     
  11 : *                                                                               
  12 : *     ORTHONORMALISER UN 'CHPOINT' PAR RAPPORT A UNE SUITE DE 'CHPOINT'.
  13 : *     MEME CHOSE QUE ORTH1, MAIS PLUS SIMPLE. CE PROGRAMME SERA MODIFIE
  14 : *     DE FACON A REDUIRE LE NOMBRE D'OPERATIONS.        
  15 : *
  16 : * MODE D'APPEL:                                 
  17 : * -------------                                                                 
  18 : *                                                                               
  18 : *     CALL GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
  19 : *                                                                               
  20 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  21 : * -----------                                                                   
  22 : *                                                                               
  23 : *     IPCHNO  ENTIER    (E)  POINTEUR SUR L'OBJET 'CHPOINT' DEVANT
  24 : *                            ETRE ORTHOGONALISE.
  25 : *
  26 : *     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' PAR
  27 : *                            RAPPORT AUQUEL ON ORTHOGONALISE.
  28 : *
  29 : *     IPLSO   ENTIER    (E)  POINTEUR SUR L'OBJET 'LISTCHPO' CONTENANT
  30 : *                            LA SUITE DE 'CHPOINT' OTHOGONAUX PAR
  31 : *                            RAPPORT AUXQUELS 'CHNO' EST ORTHOGONALISE.
  32 : *
  33 : *     IPCHO   ENTIER    (S)  POINTEUR SUR L'OBJET 'CHPOINT' CONTENANT
  34 : *                            LE 'CHPOINT' SOLUTION.
  35 : *
  36 : *
  37 : * MODE DE FONCTIONNEMENT:                                                       
  38 : * -----------------------                                                       
  39 : *                                                                               
  40 : *     PROCEDE D'ORTHOGONALISATION DE GRAAM-SCHMITT.                                  
  41 : *
  42 : *                                                                               
  43 : * AUTEUR, DATE DE CREATION:                                                     
  44 : * -------------------------                                                     
  45 : *                                                                               
  46 : *     A.M. JOLIVALT, W. PASILLAS     06 / 07 / 94. 
  47 : *
  48 : ************************************************************************
  49 : 
  50 :       SUBROUTINE GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
  51 : 
  52 :       IMPLICIT INTEGER(I-N)
  53 :       IMPLICIT REAL*8 (A-H,O-Z)
  54 : 
  55 : -INC  CCOPTIO

  56 : 
  57 : ******
  58 : *     -- ARGUMENTS --
  59 : ***                                                   
  60 :       INTEGER IPCHNO, IPRIGI, IPLSO, IPCHO
  61 : 
  62 : ******
  63 : *     -- VARIABLES LOCALES --
  64 : ***
  65 :       INTEGER  IPUI, IPCHO1, IB100, ILDIM
  66 :       REAL*8   ALPHA, UTMUI, UITMUI 
  67 :       
  67 :       CALL DIMEN2 ( IPLSO, ILDIM )
  68 :       IF ( IERR .NE. 0 ) RETURN
  68 :       CALL COPIE2 ( IPCHNO, IPCHO )
  69 :       IF ( IERR .NE. 0 ) RETURN
  70 :       IF ( ILDIM .GT. 0 ) THEN
  71 :          DO 100 IB100 = 1, ILDIM
  71 :             CALL EXTRA4 ( IPLSO, IB100, IPUI )
  72 :             IF ( IERR .NE. 0 ) RETURN
  72 :             CALL YTMX   ( IPCHNO, IPUI, IPRIGI, UTMUI )
  73 :             IF ( IERR .NE. 0 ) RETURN
  73 :             CALL XTMX   ( IPUI, IPRIGI, UITMUI )
  74 :             IF ( IERR .NE. 0 ) RETURN
  75 :             ALPHA = ( -1.D0 * UTMUI ) / UITMUI
  75 :             CALL COMBI2( IPCHO, 1.D0, IPUI, ALPHA, IPCHO1 )
  76 :             IF ( IERR .NE. 0 ) RETURN
  76 :             CALL DTCHPO( IPCHO )
  77 :             IF ( IERR .NE. 0 ) RETURN
  78 :             IPCHO = IPCHO1
  79 :  100     CONTINUE
  80 :       ENDIF
  81 : 
  82 :       RETURN
  83 :       END
  84 :