Télécharger amor.eso

Retour à la liste

Numérotation des lignes :

  1. C AMOR SOURCE CB215821 16/12/05 21:15:01 9237
  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. C
  122. C lecture du mchaml de caracteristiques materiau
  123. C
  124. CALL LIROBJ('MCHAML',IPIN,1,iretou)
  125. IF (IERR.NE.0) RETURN
  126. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  127. IF(IR .NE. 1) CALL ERREUR(KER)
  128. IF(IERR .NE. 0) RETURN
  129. C
  130. C lecture du maillage de la frontiere
  131. C
  132. CALL LIROBJ('MAILLAGE',IPMAIL,0,iretou)
  133. IF (IERR.NE.0) RETURN
  134. *
  135. IF (iretou.NE.0) THEN
  136. ICAS = 2
  137. ELSE
  138. ICAS = 3
  139. CALL LIRMOT(LPARAM,NPARAM,iretou,0)
  140. IF (IERR.NE.0) RETURN
  141. IF (iretou.EQ.1) ICAS = 4
  142. ENDIF
  143. C
  144. IF (ICAS.EQ.2) THEN
  145. C
  146. CALL FRVISQ(IPMODL,IPMAIL,IPCHE1, IPRIG)
  147. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  148. C
  149. ELSE IF (ICAS.EQ.3) THEN
  150. C
  151. CALL AMOR1(IPMODL,IPCHE1,1, IPRIG)
  152. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  153. C
  154. ELSE IF (ICAS.EQ.4) THEN
  155. C
  156. CALL AMOR1(IPMODL,IPCHE1,2, IPRIG)
  157. IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
  158. C
  159. CALL AMOR1(IPMODL,IPCHE1,1, IPRIG2)
  160. IF (IERR.NE.0 .OR. IPRIG2.LE.0) RETURN
  161. ENDIF
  162. C
  163. CALL ECROBJ('RIGIDITE',IPRIG)
  164. IF (ICAS.EQ.4) CALL ECROBJ('RIGIDITE',IPRIG2)
  165. C
  166. ENDIF
  167. C
  168. RETURN
  169. END
  170.  
  171.  
  172.  
  173.  

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