Télécharger la plaquette Cast3M


fr en

Télécharger masse.eso

Retour à la liste

Numérotation des lignes : 

masse

  1. C MASSE     SOURCE    JK148537  23/11/20    21:15:07     11790          
  2.       SUBROUTINE MASSE(ILUMP)
  3. *
  4. *_______________________________________________________________________
  5. *
  6. *            operateurs masse et lump
  7. *
  8. *
  9. *           ILUMP : =1 indique si il s'agit de l'opérateur LUMP
  10. *
  11. *
  12. *_______________________________________________________________________
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15. *
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMCHAML
  20. -INC CCHAMP
  21. -INC SMCOORD
  22. c
  23.       character*4 mcle(1)
  24.       data mcle/'PRES'/
  25.       CHARACTER*4  CMOT
  26.  
  27. C
  28.       jlump = ilump
  29. * lecture eventuelle de 'PRES'
  30.       jpre = 0
  31.       call lirmot(mcle,1,jpre,0)
  32.       if (ierr.ne.0) return
  33.       if  (jpre.eq.1) jlump = 2
  34.  
  35. C     Lump d une matrice deja constituée ( formule initiale )
  36.       CALL LIROBJ('RIGIDITE',IRIG,0,IR1)
  37.       IF (IR1.NE.0) THEN
  38.       LMOT=0
  39.       CALL LIROBJ('LISTMOTS',LMOT,0,IR2)
  40.       IF (IERR.NE.0) RETURN
  41.       if (ir2.eq.0.and.ilump.eq.0) then
  42.        call ECROBJ('RIGIDITE',IRIG)
  43.        goto 10
  44.       endif
  45.  
  46. *
  47.       CALL LUMPIN(IRIG,LMOT,ILUM)
  48.       IF (IERR.NE.0) RETURN
  49. *
  50.       CALL ECROBJ('RIGIDITE',ILUM)
  51.       RETURN
  52.       END IF
  53. c
  54.       segact mcoord
  55. c
  56. c     lecture du modele
  57. c
  58.  10   IPCHE1=0
  59. c
  60.       CALL LIROBJ('MMODEL',IPMODL,0,IRT1)
  61.       IF(IRT1.NE.0) THEN
  62.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  63. c
  64. c        Cas de la matrice masse sur base element finis
  65. c        lecture du 1 ier mchaml
  66. c
  67.           CALL LIROBJ('MCHAML  ',IPCHE1,1,IRT2)
  68.           CALL ACTOBJ('MCHAML  ',IPCHE1,1)
  69. c
  70. c         si absent erreur
  71. c
  72.           IF (IRT2.EQ.0) THEN
  73.                MOTERR(1:16) ='CARACTERISTIQUE'
  74.                CALL ERREUR(565)
  75.                RETURN
  76.           ENDIF
  77.       call reduaf(ipche1,ipmodl,ipch,0,ir,ker)
  78.       if (ir.ne.1) call erreur(ker)
  79.       IF (IERR.NE.0) RETURN
  80.       ipche1=ipch
  81. c
  82. c     calcul de la masse
  83. c
  84.  
  85.           CALL MASSE1 (IPMODL,IPCHE1,IPMASS,IRET,JLUMP)
  86. c
  87. c     ecriture du resultat
  88. c
  89.           CALL ECROBJ('RIGIDITE',IPMASS)
  90.  
  91.       ELSE
  92.         IF (ILUMP .EQ. 0) THEN
  93. c
  94. c   cas des masses additionnelles
  95. c
  96.           CALL LIRCHA(CMOT,0,IRT1)
  97.           IF (IRT1.NE.0) THEN
  98.             CALL REFUS
  99.             CALL APPUI(2)
  100.           ELSE
  101. c
  102. c   cas de la masse sur base modale
  103. c
  104.             CALL MASSMO
  105.           ENDIF
  106.         ELSE
  107.           CALL ERREUR(26)
  108.         ENDIF
  109.       ENDIF
  110.       END
  111.  
  112.  
  113.  
  114.  
  115.  

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