Esope source files

   1 : C SESPA4    SOURCE    CHAT      05/01/13    03:14:42     5004           
   2 : C SESPA4    SOURCE    WP        94/12/07                
   3 : C     SUBROUTINE SESPA4 ( IPLVEC, IPMPHI )
   4 : ************************************************************************        
   5 : *                                                                               
   6 : *                                SESPA4                                        
   7 : *                             -----------                                       
   8 : *                                                                               
   9 : * FONCTION:                                                                     
  10 : * ---------                                                                     
  11 : *                                                                               
  12 : *      CALCUL D'UNE APPROXIMATION DES VECTEURS PROPRES, A PARTIR
  13 : *      DE LEUR PROJECTION IPMPHI SUR LE SOUS-ESPACE IPLVEC.
  14 : *
  15 : * MODE D'APPEL:                                 
  16 : *                                                                               
  16 : *     CALL SESPA4 ( IPLVEC, IPMPHI )
  17 : *                                                                               
  18 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  19 : * -----------                                                                   
  20 : *                                                                               
  21 : *     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  22 : *                       (S)  LA SUITE DE 'CHPOINT' X(i)
  23 : *
  24 : *     IPMPHI  ENTIER    (E)  POINTEUR SUR L'OBJET 'MATRIX'   PHI
  25 : *
  26 : *
  27 : * AUTEUR, DATE DE CREATION:                                                     
  28 : * -------------------------                                                     
  29 : *                                                                               
  30 : *   A.M. JOLIVALT,  W. PASILLAS  29 / 07 / 94.    ( ESOPE )                                       
  31 : *                                                                               
  32 : ************************************************************
  33 : 
  34 :       SUBROUTINE SESPA4 ( IPLVEC, IPMPHI )
  35 : 
  36 :       IMPLICIT INTEGER(I-N)
  37 :       IMPLICIT REAL*8 (A-H,O-Z)
  38 : 
  39 : -INC  CCOPTIO

  40 : -INC  SMLCHPO

  41 : 
  42 :       SEGMENT ,MATRIX
  43 :         REAL*8 A(N,N)
  44 :       ENDSEGMENT
  45 :           
  46 : ******
  47 : *     -- ARGUMENTS --
  48 : ***
  49 :       POINTEUR IPLVEC.MLCHPO
  50 :       POINTEUR IPMPHI.MATRIX
  51 : 
  52 : 
  53 : ******
  54 : *     -- VARIABLES LOCALES --
  55 : ***
  56 :       POINTEUR IPLVE1.MLCHPO
  57 :       INTEGER  ILDIM, IPCHP1, IPCHPO, IPCHP2
  58 :       REAL*8   ALPHA
  59 : 
  60 : 
  61 : ******
  62 : *     -- CHAQUE VECTEUR DE IPLVE1 EST UNE COMBINAISON
  63 : *     LINEAIRE DES VECTEURS DE IPLVEC, PONDEREE PAR
  64 : *     LES COEFFICIENTS DE IPMPHI --
  65 : ***
  66 :       N1 = 0
  67 :       SEGINI ,IPLVE1
  68 : 
  69 :       SEGACT ,IPLVEC ,IPMPHI
  70 : 
  71 :       ILDIM = IPLVEC.ICHPOI(/1)
  72 :       DO 100 IB100 = 1, ILDIM
  73 :          ALPHA  = IPMPHI.A( 1, IB100 )
  74 :          IPCHP1 = IPLVEC.ICHPOI( 1 )
  74 :          CALL MUCHPO ( IPCHP1, ALPHA, IPCHPO, 1 )
  75 :          IF ( IERR .NE. 0 ) RETURN 
  76 :          IPLVE1.ICHPOI(**) = IPCHPO        
  77 :          DO 200 IB200 = 2, ILDIM
  78 :             ALPHA  = IPMPHI.A( IB200, IB100 )
  79 :             IPCHP1 = IPLVE1.ICHPOI( IB100 )
  80 :             IPCHP2 = IPLVEC.ICHPOI( IB200 )
  80 :             CALL COMBI2 ( IPCHP1, 1.D0, IPCHP2, ALPHA, IPCHPO )
  81 :             IF ( IERR .NE. 0 ) RETURN 
  82 :             IPLVE1.ICHPOI( IB100 ) = IPCHPO
  82 :             CALL DTCHPO ( IPCHP1 )
  83 :             IF ( IERR .NE. 0 ) RETURN 
  84 :  200     CONTINUE
  85 :  100  CONTINUE
  86 : 
  87 : ******
  88 : *     -- ON DETRUIT IPLVEC --
  89 : ***
  90 :       DO 300 IB300 = 1, ILDIM
  91 :          IPCHPO = IPLVEC.ICHPOI( IB300 )
  91 :          CALL DTCHPO( IPCHPO )
  92 :          IF ( IERR .NE. 0 ) RETURN 
  93 :  300  CONTINUE
  93 :       CALL DTLCHP ( IPLVEC )
  94 :       IF ( IERR .NE. 0 ) RETURN 
  95 : 
  96 : ******
  97 : *     -- ON RETOURNE IPLVEC --
  98 : ***
  99 :       IPLVEC = IPLVE1
 100 : 
 101 :       SEGDES ,IPLVEC, IPMPHI
 102 : 
 103 :       SEGSUP ,IPMPHI
 104 : 
 105 :       RETURN
 106 :       END
 107 :