Télécharger la plaquette Cast3M


fr en

Télécharger sespa4.eso

Retour à la liste

Numérotation des lignes : 

sespa4

  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. *
  17. *     CALL SESPA4 ( IPLVEC, IPMPHI )
  18. *
  19. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  20. * -----------
  21. *
  22. *     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  23. *                       (S)  LA SUITE DE 'CHPOINT' X(i)
  24. *
  25. *     IPMPHI  ENTIER    (E)  POINTEUR SUR L'OBJET 'MATRIX'   PHI
  26. *
  27. *
  28. * AUTEUR, DATE DE CREATION:
  29. * -------------------------
  30. *
  31. *   A.M. JOLIVALT,  W. PASILLAS  29 / 07 / 94.    ( ESOPE )
  32. *
  33. ************************************************************
  34.  
  35.       SUBROUTINE SESPA4 ( IPLVEC, IPMPHI )
  36.  
  37.       IMPLICIT INTEGER(I-N)
  38.       IMPLICIT REAL*8 (A-H,O-Z)
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC  SMLCHPO
  43.  
  44.       SEGMENT ,MATRIX
  45.         REAL*8 A(N,N)
  46.       ENDSEGMENT
  47.  
  48. ******
  49. *     -- ARGUMENTS --
  50. ***
  51.       POINTEUR IPLVEC.MLCHPO
  52.       POINTEUR IPMPHI.MATRIX
  53.  
  54.  
  55. ******
  56. *     -- VARIABLES LOCALES --
  57. ***
  58.       POINTEUR IPLVE1.MLCHPO
  59.       INTEGER  ILDIM, IPCHP1, IPCHPO, IPCHP2
  60.       REAL*8   ALPHA
  61.  
  62.  
  63. ******
  64. *     -- CHAQUE VECTEUR DE IPLVE1 EST UNE COMBINAISON
  65. *     LINEAIRE DES VECTEURS DE IPLVEC, PONDEREE PAR
  66. *     LES COEFFICIENTS DE IPMPHI --
  67. ***
  68.       N1 = 0
  69.       SEGINI ,IPLVE1
  70.  
  71.       SEGACT ,IPLVEC ,IPMPHI
  72.  
  73.       ILDIM = IPLVEC.ICHPOI(/1)
  74.       DO 100 IB100 = 1, ILDIM
  75.          ALPHA  = IPMPHI.A( 1, IB100 )
  76.          IPCHP1 = IPLVEC.ICHPOI( 1 )
  77.          CALL MUCHPO ( IPCHP1, ALPHA, IPCHPO, 1 )
  78.          IF ( IERR .NE. 0 ) RETURN
  79.          IPLVE1.ICHPOI(**) = IPCHPO
  80.          DO 200 IB200 = 2, ILDIM
  81.             ALPHA  = IPMPHI.A( IB200, IB100 )
  82.             IPCHP1 = IPLVE1.ICHPOI( IB100 )
  83.             IPCHP2 = IPLVEC.ICHPOI( IB200 )
  84.             CALL COMBI2 ( IPCHP1, 1.D0, IPCHP2, ALPHA, IPCHPO )
  85.             IF ( IERR .NE. 0 ) RETURN
  86.             IPLVE1.ICHPOI( IB100 ) = IPCHPO
  87.             CALL DTCHPO ( IPCHP1 )
  88.             IF ( IERR .NE. 0 ) RETURN
  89.  200     CONTINUE
  90.  100  CONTINUE
  91.  
  92. ******
  93. *     -- ON DETRUIT IPLVEC --
  94. ***
  95.       DO 300 IB300 = 1, ILDIM
  96.          IPCHPO = IPLVEC.ICHPOI( IB300 )
  97.          CALL DTCHPO( IPCHPO )
  98.          IF ( IERR .NE. 0 ) RETURN
  99.  300  CONTINUE
  100.       CALL DTLCHP ( IPLVEC )
  101.       IF ( IERR .NE. 0 ) RETURN
  102.  
  103. ******
  104. *     -- ON RETOURNE IPLVEC --
  105. ***
  106.       IPLVEC = IPLVE1
  107.  
  108.       SEGDES ,IPLVEC, IPMPHI
  109.  
  110.       SEGSUP ,IPMPHI
  111.  
  112.       RETURN
  113.       END
  114.  
  115.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales