Télécharger la plaquette Cast3M


fr en

Télécharger sespc4.eso

Retour à la liste

Numérotation des lignes : 

sespc4

  1. C SESPC4    SOURCE    PV090527  26/04/30    21:16:26     12529          
  2. C     SUBROUTINE SESPA4 ( IPLVEC, IPMPHI )
  3. ************************************************************************
  4. *
  5. *                                SESPC4 inspiré de SESPA4
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *      CALCUL D'UNE APPROXIMATION DES VECTEURS PROPRES, A PARTIR
  12. *      DE LEUR PROJECTION IPMPHI SUR LE SOUS-ESPACE IPLVEC.
  13. *
  14. * MODE D'APPEL:
  15. *
  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 SESPC4 ( IPLVEC, IPMPHI, ILAMBI )
  35.  
  36.       IMPLICIT INTEGER(I-N)
  37.       IMPLICIT REAL*8 (A-H,O-Z)
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC  SMLCHPO
  42.  
  43. *      SEGMENT ,MATRIX
  44. *        REAL*8 A(N,N)
  45. *      ENDSEGMENT
  46. -INC  SMRIGID
  47. -INC SMLREEL
  48.  
  49. ******
  50. *     -- ARGUMENTS --
  51. ***
  52.       POINTEUR IPLVEC.MLCHPO
  53. *      POINTEUR IPMPHI.MATRIX
  54.       POINTEUR IPMPHI.XMATRI
  55. cbp      POINTEUR ILAMBI.XMATRI
  56.       POINTEUR ILAMBI.MLREEL
  57.  
  58.  
  59. ******
  60. *     -- VARIABLES LOCALES --
  61. ***
  62.       POINTEUR IPLVE1.MLCHPO
  63.       INTEGER  ILDIM, IPCHP1, IPCHPO, IPCHP2
  64.       REAL*8   ALPHA,XVALPI
  65.       CHARACTER*(LOCOMP) MOTCLE
  66.       LOGICAL  MODC
  67.  
  68.  
  69. ******
  70. *     -- CHAQUE VECTEUR DE IPLVE1 EST UNE COMBINAISON
  71. *     LINEAIRE DES VECTEURS DE IPLVEC, PONDEREE PAR
  72. *     LES COEFFICIENTS DE IPMPHI --
  73. ***
  74.       MODC = .false.
  75.       CALL MOTS1( IPLMOT, MOTCLE )
  76.       N1 = 0
  77.       SEGINI ,IPLVE1
  78.  
  79.       SEGACT ,IPLVEC ,IPMPHI
  80. c       SEGACT ,ILAMBI
  81.  
  82.       ILDIM = IPLVEC.ICHPOI(/1)
  83.  
  84. ***** on construit le IB100^ieme mode ********************************
  85.       DO 100 IB100 = 1, ILDIM
  86.  
  87.          ALPHA  = IPMPHI.RE( 1, IB100,1 )
  88.          IPCHP1 = IPLVEC.ICHPOI( 1 )
  89.          CALL MUCHPO ( IPCHP1, ALPHA, IPCHPO, 1 )
  90.          IF ( IERR .NE. 0 ) RETURN
  91.          IPLVE1.ICHPOI(**) = IPCHPO
  92.  
  93. *------  on somme les contributions des vecteurs ib200=1,ildim
  94.          DO 200 IB200 = 2, ILDIM
  95.             ALPHA  = IPMPHI.RE( IB200, IB100,1 )
  96.             IPCHP1 = IPLVE1.ICHPOI( IB100 )
  97.             IPCHP2 = IPLVEC.ICHPOI( IB200 )
  98.             CALL COMBI2 ( IPCHP1, 1.D0, IPCHP2, ALPHA, IPCHPO )
  99.             IF ( IERR .NE. 0 ) RETURN
  100.             IPLVE1.ICHPOI( IB100 ) = IPCHPO
  101.             CALL DTCHPO ( IPCHP1 )
  102.             IF ( IERR .NE. 0 ) RETURN
  103.  
  104.  200     CONTINUE
  105.  
  106. *------- Normalisation
  107. *        on a deja construit les parties Reelles et Imaginaires du vecteur
  108.          if(MODC) goto 90
  109.  
  110. c          XVALPI = ILAMBI.RE(1, IB100,1)
  111.          XVALPI = ILAMBI.PROG(IB100)
  112.  
  113.          if(XVALPI .eq. 0.D0) then
  114. *        il s agit d un mode Réel'
  115.             MODC = .false.
  116.             call NORMA1( IPCHPO, IPLMOT, MOTCLE, IPCHP1 )
  117.             IPLVE1.ICHPOI( IB100 ) = IPCHP1
  118.             CALL DTCHPO ( IPCHPO )
  119.  
  120. *        il s'agit d'un mode Complexe => on stocke le vecteur Reel,
  121. *        on calule le vecteur imaginaire, puis on normalise ce vecteur Complexe
  122. *        enfin on les ecrit, avant de passer au(x) suivant(s)
  123.          else
  124. *        il s agit d un mode Complexe'
  125.              MODC = .true.
  126.              ICHP1R = IPCHPO
  127.          endif
  128.  
  129.          goto 100
  130.  
  131.  90      CONTINUE
  132.          call NORM1C(ICHP1R,IPCHPO,IPLMOT,MOTCLE,ICHP2R,ICHP2I)
  133.          IPLVE1.ICHPOI( IB100 - 1 ) = ICHP2R
  134.          IPLVE1.ICHPOI( IB100     ) = ICHP2I
  135.          MODC = .false.
  136.  
  137.  100  CONTINUE
  138. ***** fin de boucle sur les modes ************************************
  139.  
  140.  
  141. ******
  142. *     -- ON DETRUIT IPLVEC --
  143. ***
  144.       DO 300 IB300 = 1, ILDIM
  145.          IPCHPO = IPLVEC.ICHPOI( IB300 )
  146.          CALL DTCHPO( IPCHPO )
  147.          IF ( IERR .NE. 0 ) RETURN
  148.  300  CONTINUE
  149.       CALL DTLCHP ( IPLVEC )
  150.       IF ( IERR .NE. 0 ) RETURN
  151.  
  152. ******
  153. *     -- ON RETOURNE IPLVEC --
  154. ***
  155.       IPLVEC = IPLVE1
  156.       SEGDES ,IPLVEC, IPMPHI
  157.       SEGSUP ,IPMPHI
  158.  
  159.       RETURN
  160.       END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  

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