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    MB234859  26/06/25    21:15:22     12580          
  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.       INSYM=0
  107.       CALL RESOU1 ( IPRIGI, IPLIST, 0, 1 ,xspetl,0,0,INSYM,0)
  108.       IF ( IERR .NE. 0 ) THEN
  109.  
  110.             WRITE ( IOIMP, 1000 )
  111.  
  112.  1000       FORMAT(/,'    La matrice d''iteration (K-W2M) est singulière
  113.      1 (a la precision',/,' machine près). Essayez de decaller la fréque
  114.      3nce fournie a VIBR',/)
  115.  
  116.  
  117.             RETURN
  118.       ENDIF
  119.  
  120. ******
  121. *     -- ON REMET DANS LSO, EN NORMANT AVEC LA NORME DU MAX. --
  122. ***
  123.       CALL MOTS1( IPLMOT, MOTCLE )
  124.       IF ( IERR .NE. 0 ) RETURN
  125.       SEGACT ,IPLIST
  126.       SEGACT IPLSO*MOD
  127.       DO 300 IB300 = 1, ILDIM
  128.          IPCHPO = IPLIST( IB300 )
  129.          CALL NORMA1 ( IPCHPO, IPLMOT, MOTCLE, IPCHP1 )
  130.          IF ( IERR .NE. 0 ) RETURN
  131.          CALL DTCHPO ( IPCHPO )
  132.          IF ( IERR .NE. 0 ) RETURN
  133.          IPLSO.ICHPOI( IB300 ) = IPCHP1
  134.  300  CONTINUE
  135.       SEGDES ,IPLIST, IPLSO
  136.  
  137.       SEGSUP ,IPLIST
  138.  
  139.       RETURN
  140.       END
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  

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