Télécharger la plaquette Cast3M


fr en

Télécharger sespa1.eso

Retour à la liste

Numérotation des lignes : 

sespa1

  1. C SESPA1    SOURCE    PV        22/04/15    13:20:12     11344          
  2. C SESPA1    SOURCE    WP        23/08/94
  3. C     SUBROUTINE SESPA1 ( IPLSO, IPRIGI, IPMASS )
  4. ************************************************************************
  5. *
  6. *                                SESPA1
  7. *                             -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. *     FAIRE UN PAS D'ITERATION DE SOUS-ESPACE: K X(i+1) = M X(i)
  13. *     SUIVI D'UNE ORTHOGONALISATION:             X(i+1) = GRAAMO X(i+1)
  14. *
  15. * MODE D'APPEL:
  16. *
  17. *     CALL SESPA1 ( IPLSO, IPRIGI, IPLSO1 )
  18. *
  19. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  20. * -----------
  21. *
  22. *     IPLSNO  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  23. *                            LA SUITE DE 'CHPOINT' X(i)
  24. *
  25. *     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' K
  26. *     IPMASS  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' M
  27. *
  28. * AUTEUR, DATE DE CREATION:
  29. * -------------------------
  30. *
  31. *  A.M. JOLIVALT, W. PASILLAS  12 / 07 / 94.  ( ESOPE )
  32. *
  33. ************************************************************
  34.  
  35.       SUBROUTINE SESPA1 ( IPLSO, IPRIGI, IPMASS )
  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. -INC CCHAMP
  44. -INC CCREEL
  45.  
  46.       SEGMENT IPLIST(0)
  47.  
  48. ******
  49. *     -- ARGUMENTS --
  50. ***
  51.       POINTEUR IPLSO.MLCHPO
  52.       INTEGER  IPRIGI, IPMASS
  53.  
  54. ******
  55. *     -- VARIABLES LOCALES --
  56. ***
  57. *     SEGMENT IPLIST(0)
  58.       INTEGER IPCHPO, IPCHP1, IPCHP2
  59.       INTEGER IB100, IB200, IB300, ILDIM
  60.       CHARACTER*(LOCOMP) MOTCLE
  61.  
  62.       xspetl = xspeti
  63.       SEGINI ,IPLIST
  64.       SEGDES ,IPLIST
  65.  
  66.  
  67. ******
  68. *     -- ON VA FAIRE POINTER LES ELEMENTS DE IPLIST VERS LES 'CHPOINTS'
  69. *     CONTENUS DANS IPLSO. LES MODIFICATIONS EFFECTUEES SUR LES 'CHPO'
  70. *     DE IPLIST SERONT DONC EFFECTUEES AUSSI SUR CEUX DE IPLSO. --
  71. ***
  72.       SEGACT ,IPLSO
  73.       ILDIM = IPLSO.ICHPOI(/1)
  74.       SEGDES ,IPLSO
  75.  
  76.       SEGACT IPLIST*MOD
  77.       SEGACT IPLSO
  78.       DO 100 IB100 = 1, ILDIM
  79.          IPLIST(**) = IPLSO.ICHPOI( IB100 )
  80.  100  CONTINUE
  81.       SEGDES ,IPLIST, IPLSO
  82.  
  83. ******
  84. *     -- ON MULTIPLIE LES 'CHPOINT' DE IPLIST PAR IPMASS.
  85. *     ET ON ANNULLE LES TERMES EN PI ( POUR LES ELEMENTS LIQUIDES ) --
  86. ***
  87.       SEGACT IPLIST*MOD
  88.       DO 200 IB200 = 1, ILDIM
  89.          IPCHPO = IPLIST( IB200 )
  90.          CALL MUCPRI ( IPCHPO, IPMASS, IPCHP1 )
  91.          IF ( IERR .NE. 0 ) RETURN
  92.          CALL DTCHPO( IPCHPO )
  93.          IF ( IERR .NE. 0 ) RETURN
  94.          CALL ANCHPO( IPCHP1, NOMDU(15), IPCHP2 )
  95.          IF ( IERR .NE. 0 ) RETURN
  96.          CALL DTCHPO( IPCHP1 )
  97.          IF ( IERR .NE. 0 ) RETURN
  98.          IPLIST( IB200 ) = IPCHP2
  99.  200  CONTINUE
  100.       SEGDES ,IPLIST
  101.  
  102.  
  103. ******
  104. *     -- ON RESOUD LE SYSTEME K X(i+1) = M X(i) --
  105. ***
  106.       CALL RESOU1 ( IPRIGI, IPLIST, 0, 1 ,xspetl,0,0)
  107.       IF ( IERR .NE. 0 ) THEN
  108.  
  109.             WRITE ( IOIMP, 1000 )
  110.  
  111.  1000       FORMAT(/,'    La matrice d''iteration (K-W2M) est singulière
  112.      1 (a la precision',/,' machine près). Essayez de decaller la fréque
  113.      3nce fournie a VIBR',/)
  114.  
  115.  
  116.             RETURN
  117.       ENDIF
  118.  
  119. ******
  120. *     -- ON REMET DANS LSO, EN NORMANT AVEC LA NORME DU MAX. --
  121. ***
  122.       CALL MOTS1( IPLMOT, MOTCLE )
  123.       IF ( IERR .NE. 0 ) RETURN
  124.       SEGACT ,IPLIST
  125.       SEGACT IPLSO*MOD
  126.       DO 300 IB300 = 1, ILDIM
  127.          IPCHPO = IPLIST( IB300 )
  128.          CALL NORMA1 ( IPCHPO, IPLMOT, MOTCLE, IPCHP1 )
  129.          IF ( IERR .NE. 0 ) RETURN
  130.          CALL DTCHPO ( IPCHPO )
  131.          IF ( IERR .NE. 0 ) RETURN
  132.          IPLSO.ICHPOI( IB300 ) = IPCHP1
  133.  300  CONTINUE
  134.       SEGDES ,IPLIST, IPLSO
  135.  
  136.       SEGSUP ,IPLIST
  137.  
  138.       RETURN
  139.       END
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  

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