Télécharger la plaquette Cast3M


fr en

Télécharger sespc1.eso

Retour à la liste

Numérotation des lignes : 

sespc1

  1. C SESPC1    SOURCE    CB215821  20/11/25    13:39:43     10792          
  2. C SESPA1    SOURCE    AM        08/02/14    21:30:15     6050
  3. C SESPA1    SOURCE    WP        23/08/94
  4. C     SUBROUTINE SESPC1 ( IPLSO, IPRIGI, IPMASS )
  5. ************************************************************************
  6. *
  7. *                                SESPC1    (inspiré de SESPA1 )
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     FAIRE UN PAS D'ITERATION DE SOUS-ESPACE: K X(i+1) = M X(i)
  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. *  Sespa1.eso:  A.M. JOLIVALT, W. PASILLAS  12 / 07 / 94.  ( ESOPE )
  32. *  Sespc1.eso:  Benoit PRBEL  mars 2009
  33. *
  34. ************************************************************
  35.  
  36.       SUBROUTINE SESPC1 ( IPLSO, IPRIGI, IPMASS )
  37.  
  38.  
  39.       IMPLICIT INTEGER(I-N)
  40.       IMPLICIT REAL*8 (A-H,O-Z)
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC  SMLCHPO
  45. -INC  CCHAMP
  46. -INC SMCHPOI
  47.  
  48.       SEGMENT IPLIST(0)
  49.  
  50. ******
  51. *     -- ARGUMENTS --
  52. ***
  53.       POINTEUR IPLSO.MLCHPO
  54.       INTEGER  IPRIGI, IPMASS
  55.  
  56. ******
  57. *     -- VARIABLES LOCALES --
  58. ***
  59. *     SEGMENT IPLIST(0)
  60.       INTEGER IPCHPO, IPCHP1, IPCHP2
  61.       INTEGER IB100, IB200, IB300, ILDIM
  62.       CHARACTER*(LOCOMP) MOTCLE
  63.  
  64.       SEGINI ,IPLIST
  65.       SEGDES ,IPLIST
  66.  
  67.  
  68. ******
  69. *     -- ON VA FAIRE POINTER LES ELEMENTS DE IPLIST VERS LES 'CHPOINTS'
  70. *     CONTENUS DANS IPLSO. LES MODIFICATIONS EFFECTUEES SUR LES 'CHPO'
  71. *     DE IPLIST SERONT DONC EFFECTUEES AUSSI SUR CEUX DE IPLSO. --
  72. ***
  73.       SEGACT ,IPLSO
  74.       ILDIM = IPLSO.ICHPOI(/1)
  75.       SEGDES ,IPLSO
  76.  
  77.       SEGACT IPLIST*MOD
  78.       SEGACT IPLSO
  79.       DO 100 IB100 = 1, ILDIM
  80.          IPLIST(**) = IPLSO.ICHPOI( IB100 )
  81.  100  CONTINUE
  82.       SEGDES ,IPLIST, IPLSO
  83.  
  84. ******
  85. *     -- ON MULTIPLIE LES 'CHPOINT' DE IPLIST PAR IPMASS.
  86. *     ET ON ANNULLE LES TERMES EN PI ( POUR LES ELEMENTS LIQUIDES ) --
  87. ***
  88.       SEGACT IPLIST*MOD
  89.       DO 200 IB200 = 1, ILDIM
  90.          IPCHPO = IPLIST( IB200 )
  91.          CALL MUCPRI ( IPCHPO, IPMASS, IPCHP1 )
  92.          IF ( IERR .NE. 0 ) RETURN
  93.          CALL DTCHPO( IPCHPO )
  94.          IF ( IERR .NE. 0 ) RETURN
  95.          CALL ANCHPO( IPCHP1, NOMDU(15), IPCHP2 )
  96.          IF ( IERR .NE. 0 ) RETURN
  97.          CALL DTCHPO( IPCHP1 )
  98.          IF ( IERR .NE. 0 ) RETURN
  99.          IPLIST( IB200 ) = IPCHP2
  100.  200  CONTINUE
  101.       SEGDES ,IPLIST
  102.  
  103.  
  104. ******
  105. *     -- ON RESOUD LE SYSTEME K X(i+1) = M X(i) --
  106. ***
  107.       CALL LDMT ( IPRIGI, IPLIST, 0, 1 ,1D-15,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.  

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