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

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