Télécharger amor.eso

Retour à la liste

Numérotation des lignes :

  1. C AMOR SOURCE CB215821 18/09/21 21:15:07 9930
  2. SUBROUTINE AMOR
  3. C
  4. C***********************************************************************
  5. C *
  6. C Premiere option : *
  7. C *
  8. C FABRICATION DE LA MATRICE D'AMORTISSEMENT MODAL *
  9. C SYNTAXE : AMO1= AMOR BASE PROG ; *
  10. C AMO1 MATRICE D'AMORTISSEMENT *
  11. C BASE OBJET DE TYPE BASE MODALE *
  12. C PROG OBJET DE TYPE MLREEL LISTE DES *
  13. C COEFFICIENTS D'AMORTISSEMENT REDUITS (%) *
  14. C CREATION : 26/11/86 *
  15. C PROGRAMMEUR : GUILBAUD *
  16. C *
  17. C______________________________________________________________________*
  18. C *
  19. C Deuxieme option : calcule la matrice d'amortissement visqueux *
  20. C associee a la frontiere d'un maillage *
  21. C *
  22. C Syntaxe : *
  23. C -------- *
  24. C *
  25. C RIG1 = AMOR MODL1 MAT1 GEO1 ; *
  26. C *
  27. C RIG1 : matrice d'amortissement construite (TYPE rigidite) *
  28. C MODL1: objet MMODEL, modele du sol ou du fluide a modeliser *
  29. C MAT1 : objet MCHAML, caracteristiques materiau *
  30. C GEO1 : objet MELEME, maillage de la frontiere *
  31. C *
  32. C date de creation : 26/02/98 *
  33. C "programmeur" : Olivier ROCHET *
  34. C *
  35. C______________________________________________________________________*
  36. C *
  37. C Troisieme option : calcule la matrice d'amortissement *
  38. C d'un materiau viscoelastique *
  39. C *
  40. C Syntaxe : *
  41. C -------- *
  42. C *
  43. C RIG1 (RIG2) = AMOR MODL1 MAT1 ('COROTATIF') ; *
  44. C *
  45. C RIG1 : matrice d'amortissement construite (TYPE rigidite) *
  46. C MODL1: objet MMODEL, modele du sol ou du fluide a modeliser *
  47. C MAT1 : objet MCHAML, caracteristiques materiau *
  48. C L'option COROTATIF permet de calculer la matrice de rigidite *
  49. C antisymetrique d'un arbre tournant (elements de poutre uniquement) *
  50. C *
  51. C date de creation : 07/07/03 *
  52. C "programmeur" : Didier COMBESCURE *
  53. C *
  54. C***********************************************************************
  55. C
  56. IMPLICIT INTEGER(I-N)
  57. IMPLICIT REAL*8 (A-H,O-Z)
  58.  
  59. -INC CCOPTIO
  60. *
  61. PARAMETER (NPARAM = 1)
  62.  
  63. LOGICAL BASMUL
  64. CHARACTER*8 CTYP
  65. CHARACTER*4 LPARAM(NPARAM)
  66. *
  67. DATA LPARAM / 'CORO' /
  68. *
  69. iretou = 0
  70. *
  71. CALL LIROBJ('LISTREEL',IPRO,0,iretou)
  72. IF (IERR.NE.0) RETURN
  73. *
  74. * -----
  75. * Cas 1 - Amortissement modal
  76. * -----
  77. IF (iretou.EQ.1) THEN
  78. *
  79. ICAS = 1
  80. IPRIG = 0
  81. *
  82. IBASE = 0
  83. ITBAS = 0
  84. BASMUL = .FALSE.
  85. *
  86. CALL QUETYP(CTYP,1,iretou)
  87. IF (IERR.NE.0) RETURN
  88. IF (CTYP(1:8).EQ.'TABLE ') THEN
  89. CALL LIRTAB('BASE_MODALE',ITBAS,0,iretou)
  90. IF (IERR.NE.0) RETURN
  91. IF (iretou.EQ.0) THEN
  92. CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,1,iretou)
  93. IF (IERR.NE.0) RETURN
  94. BASMUL = .TRUE.
  95. ENDIF
  96. ELSE
  97. CALL LIROBJ('BASEMODA',IBASE,1,iretou)
  98. IF (IERR.NE.0) RETURN
  99. ENDIF
  100. *
  101. CALL AMORMO(IPRO,IBASE,ITBAS,BASMUL, IPRIG)
  102. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  103. *
  104. CALL ECROBJ('RIGIDITE',IPRIG)
  105. *
  106. * ----------
  107. * Cas 2 et 3 - Frontieres absorbantes et amortissement visqueux
  108. * ----------
  109. ELSE
  110. *
  111. IPMODL = 0
  112. IPCHE1 = 0
  113. IPMAIL = 0
  114. IPRIG = 0
  115. IPRIG2 = 0
  116. C
  117. C lecture du modele
  118. C
  119. CALL LIROBJ('MMODEL',IPMODL,1,iretou)
  120. IF (IERR.NE.0) RETURN
  121. CALL ACTOBJ('MMODEL ',IPMODL,1)
  122. C
  123. C lecture du mchaml de caracteristiques materiau
  124. C
  125. CALL LIROBJ('MCHAML',IPIN,1,iretou)
  126. IF (IERR.NE.0) RETURN
  127. CALL ACTOBJ('MCHAML ',IPIN,1)
  128. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  129. IF(IR .NE. 1) CALL ERREUR(KER)
  130. IF(IERR .NE. 0) RETURN
  131. C
  132. C lecture du maillage de la frontiere
  133. C
  134. CALL LIROBJ('MAILLAGE',IPMAIL,0,iretou)
  135. IF (IERR.NE.0) RETURN
  136. *
  137. IF (iretou.NE.0) THEN
  138. ICAS = 2
  139. ELSE
  140. ICAS = 3
  141. CALL LIRMOT(LPARAM,NPARAM,iretou,0)
  142. IF (IERR.NE.0) RETURN
  143. IF (iretou.EQ.1) ICAS = 4
  144. ENDIF
  145. C
  146. IF (ICAS.EQ.2) THEN
  147. C
  148. CALL FRVISQ(IPMODL,IPMAIL,IPCHE1, IPRIG)
  149. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  150. C
  151. ELSE IF (ICAS.EQ.3) THEN
  152. C
  153. CALL AMOR1(IPMODL,IPCHE1,1, IPRIG)
  154. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  155. C
  156. ELSE IF (ICAS.EQ.4) THEN
  157. C
  158. CALL AMOR1(IPMODL,IPCHE1,2, IPRIG)
  159. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  160. C
  161. CALL AMOR1(IPMODL,IPCHE1,1, IPRIG2)
  162. IF (IERR.NE.0 .OR. IPRIG2.LE.0) RETURN
  163. ENDIF
  164. C
  165. CALL ECROBJ('RIGIDITE',IPRIG)
  166. IF (ICAS.EQ.4) CALL ECROBJ('RIGIDITE',IPRIG2)
  167. C
  168. ENDIF
  169. C
  170. RETURN
  171. END
  172.  
  173.  
  174.  
  175.  
  176.  

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