Télécharger massmo.eso

Retour à la liste

Numérotation des lignes :

  1. C MASSMO SOURCE PV 07/11/23 21:17:48 5978
  2. SUBROUTINE MASSMO
  3. C=======================================================================
  4. C APPELE PAR MASSE POUR L'ANALYSE MODALE
  5. C
  6. C SYNTAXES POSSIBLES : MAS2 = MASSE M ;
  7. C MAS3 = MASSE P S ;
  8. C MAS4 = MASSE M P S ;
  9. C MAS5 = MASSE B ;
  10. C M : OBJET SOLUTION DE SOUS TYPE MODE
  11. C P : OBJET SOLUTION DE SOUS TYPE SOLU STAT
  12. C S : OBJET STRUCTURE
  13. C B : OBJET BASE MODALE
  14. C MAS2 : MASSE DUE AUX MODES SEULS ( MN )
  15. C MAS3 : MASSE DUE AU COUPLAGE DES SOLUTIONS STATIQUES SUR UNE STRUCTUR
  16. C MAS4 : MASSE DUE AU COUPLAGE DES SOLUTIONS STATIQUES ET DES MODES
  17. C MAS5 : CALCUL AUTOMATIQUE DE MAS2, MAS3 ET MAS4.
  18. C
  19. C PROGRAMMEUR FARVACQUE
  20. C VERSION JUIN 84
  21. C
  22. C L. VIVAN, le 22/03/91 : ajout de l'option TABLE
  23. C
  24. C=======================================================================
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. logical l0,l1
  28. character*4 charre
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMBASEM
  33. -INC SMSOLUT
  34. -INC SMSTRUC
  35. *
  36. * La base modale est donn{e sous forme d'une TABLE
  37. *
  38. CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU)
  39. IF (IRETOU.NE.0) THEN
  40. CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',L0,IP0,
  41. & 'TABLE',I1,X1,CHARRE,L1,ITMOD)
  42. itbas = itmod
  43. ENDIF
  44. CALL LIRTAB('LIAISONS_STATIQUES',ITBST,0,IRETO1)
  45. if (ireto1.ne.0) then
  46. call lirobj('RIGIDITE',ir1,1,iretou)
  47. if (ierr.ne.0) return
  48. * call utmu(ir1,itbst)
  49. call prmu(ir1,itbst)
  50. if (ierr.ne.0) return
  51. endif
  52. IF (IRETOU.NE.0.or.ireto1.ne.0) THEN
  53. CALL RIGTAB(ITBAS,itbst,1,KRIGI)
  54. IF(KRIGI.EQ.0) GOTO 666
  55. GOTO 800
  56. ENDIF
  57. *
  58. * La base modale est donn{e sous forme d'un objet SOLUTION, ...
  59. *
  60. IMODE=0
  61. ISOLS=0
  62. 706 CALL LIROBJ ('SOLUTION',IPOI1,0,IRT1)
  63. IF(IRT1.EQ.0) GO TO 701
  64. MSOLUT=IPOI1
  65. SEGACT MSOLUT
  66. C
  67. C **** EST CE UN MODE ?
  68. C
  69. IF(ITYSOL.NE.'MODE ') GO TO 703
  70. IF(IMODE.EQ.0) GO TO 704
  71. MOTERR(1:8)='SOLUTION'
  72. MOTERR(9:16)='MODE'
  73. CALL ERREUR(130)
  74. SEGDES MSOLUT
  75. GO TO 666
  76. 704 CONTINUE
  77. IMODE=MSOLUT
  78. SEGDES MSOLUT
  79. IF(ISOLS.EQ.0) GO TO 706
  80. GO TO 701
  81. C
  82. C **** EST CE UN SOLSTA ?
  83. C
  84. 703 CONTINUE
  85. IF(ITYSOL.NE.'SOLUSTAT') GO TO 708
  86. IF(ISOLS.EQ.0) GO TO 710
  87. MOTERR(1:8)='SOLUTION'
  88. MOTERR(9:16)='SOLUSTAT'
  89. CALL ERREUR(130)
  90. SEGDES MSOLUT
  91. GO TO 666
  92. 710 CONTINUE
  93. ISOLS=MSOLUT
  94. SEGDES MSOLUT
  95. IF(IMODE.EQ.0) GO TO 706
  96. GO TO 701
  97. 708 CONTINUE
  98. MOTERR(1:8)='SOLUTION'
  99. MOTERR(9:16)=ITYSOL
  100. CALL ERREUR(131)
  101. SEGDES MSOLUT
  102. GO TO 666
  103. C
  104. 701 CONTINUE
  105. IF(ISOLS.EQ.0. AND .IMODE.EQ.0) GO TO 723
  106. IF(ISOLS.EQ.0) GO TO 720
  107. CALL LIROBJ('STRUCTUR',IPOI2,1,IRT2)
  108. IF(IERR.NE.0) GO TO 666
  109. MSTRUC=IPOI2
  110. SEGACT MSTRUC
  111. IF(LISTRU(/1).EQ.1) GO TO 721
  112. MOTERR(1:8)='STRUCTUR'
  113. CALL ERREUR(132)
  114. SEGDES MSTRUC
  115. GO TO 666
  116. 721 ISTRU=LISTRU(1)
  117. SEGDES MSTRUC
  118. IF(IMODE.EQ.0) GO TO 725
  119. CALL RGLIMO(IMODE,ISOLS,ISTRU,1,KRIGI)
  120. IF(KRIGI.EQ.0) GO TO 666
  121. GO TO 800
  122. C
  123. 725 CONTINUE
  124. CALL RGLILI(ISOLS,ISTRU,1,KRIGI)
  125. IF(KRIGI.EQ.0) GO TO 666
  126. GO TO 800
  127. C
  128. 720 CONTINUE
  129. CALL RIGMOD(IMODE,1,KRIGI)
  130. IF(KRIGI.EQ.0) GO TO 666
  131. GO TO 800
  132. C
  133. 723 CONTINUE
  134. CALL LIROBJ('BASEMODA',IPOI2,1,IRT2)
  135. IF(IERR.NE.0) GO TO 666
  136. CALL RGBASE(IPOI2,1,KRIGI)
  137. IF(KRIGI.EQ.0) GO TO 666
  138. C
  139. 800 CONTINUE
  140. CALL ECROBJ('RIGIDITE',KRIGI)
  141. 666 CONTINUE
  142. RETURN
  143. END
  144.  
  145.  
  146.  
  147.  

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