Télécharger psacce.eso

Retour à la liste

Numérotation des lignes :

  1. C PSACCE SOURCE CHAT 05/01/13 02:36:56 5004
  2. SUBROUTINE PSACCE(IRAID,IMASS,IMAIL,MTRAV,DIR, ICHP1)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * P S A C C E
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * calcule le pseudo-mode en d{placement pour une acc{l{ration
  14. * sismique d'ensemble.
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19. -INC CCOPTIO
  20. -INC CCREEL
  21. -INC SMCHPOI
  22. *
  23. * PARAMETRES: (e)=entr{e (s)=sortie
  24. * -----------
  25. *
  26. * IRAID (e) pointeur sur la matrice K de la structure.
  27. * IMASS (e) pointeur sur la matrice M de la stuctureE.
  28. * IMAIL (e) pointeur sur le maillage de la structure.
  29. * MTRAV (e) pointeur sur les modes de la structure.
  30. * DIR (e) direction de l'excitation sismique.
  31. * ICHP1 (s) pointeur sur le pseudo-mode en d{placement.
  32. *
  33. CHARACTER*2 DIR
  34. SEGMENT MTRAV
  35. REAL*8 FREQ(NBMODE),MN(NBMODE),MW2(NBMODE),
  36. & QX(NBMODE),QY(NBMODE),QZ(NBMODE)
  37. INTEGER DEPL(NBMODE)
  38. ENDSEGMENT
  39. *
  40. *
  41. * AUTEUR, DATE DE CREATION:
  42. * -------------------------
  43. *
  44. * Lionel VIVAN Juillet 1988
  45. *
  46. ************************************************************************
  47. *
  48. SEGMENT PSTRA
  49. REAL*8 QSMW2(NBMODE)
  50. ENDSEGMENT
  51. *
  52. ICHP1 = 0
  53. SEGACT MTRAV
  54. NBMODE = FREQ(/1)
  55. SEGINI PSTRA
  56. IF (DIR .EQ. 'UX') THEN
  57. DO 4 I = 1,NBMODE
  58. QSMW2(I) = -1.D0 * QX(I) / MW2(I)
  59. 4 CONTINUE
  60. ELSE IF (DIR .EQ. 'UY') THEN
  61. DO 6 I = 1,NBMODE
  62. QSMW2(I) = -1.D0 * QY(I) / MW2(I)
  63. 6 CONTINUE
  64. ELSE
  65. DO 8 I = 1,NBMODE
  66. QSMW2(I) = -1.D0 * QZ(I) / MW2(I)
  67. 8 CONTINUE
  68. ENDIF
  69. *
  70. * r{solution du syst}me statique
  71. *
  72. * est-on en axisym{trique ?
  73. *
  74. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  75. IF (DIR .EQ. 'UX') THEN
  76. CALL ECRREE(1.D0)
  77. CALL ECRCHA('UT')
  78. CALL ECRREE(-1.D0)
  79. CALL ECRCHA('UR')
  80. CALL ECRENT(2)
  81. CALL ECROBJ('MAILLAGE',IMAIL)
  82. CALL MANUCH
  83. IF (IERR.NE.0) RETURN
  84. CALL LIROBJ('CHPOINT ',ICHPT,1,IRETOU)
  85. IF (IERR.NE.0) RETURN
  86. ELSE IF (DIR .EQ. 'UY') THEN
  87. CALL ECRREE(-1.D0)
  88. CALL ECRCHA('UT')
  89. CALL ECRREE(-1.D0)
  90. CALL ECRCHA('UR')
  91. CALL ECRENT(2)
  92. CALL ECROBJ('MAILLAGE',IMAIL)
  93. CALL MANUCH
  94. IF (IERR.NE.0) RETURN
  95. CALL LIROBJ('CHPOINT ',ICHPT,1,IRETOU)
  96. IF (IERR.NE.0) RETURN
  97. ELSE
  98. CALL ECRREE(-1.D0)
  99. CALL ECRCHA('UZ')
  100. CALL ECRENT(1)
  101. CALL ECROBJ('MAILLAGE',IMAIL)
  102. CALL MANUCH
  103. IF (IERR.NE.0) RETURN
  104. CALL LIROBJ('CHPOINT ',ICHPT,1,IRETOU)
  105. IF (IERR.NE.0) RETURN
  106. ENDIF
  107. *
  108. MCHPOI = ICHPT
  109. SEGACT MCHPOI
  110. IFOPOI = IFOUR
  111. NS = IPCHP(/1)
  112. DO 10 I = 1,NS
  113. MSOUPO = IPCHP(I)
  114. SEGACT MSOUPO
  115. NC = NOHARM(/1)
  116. DO 20 IC = 1,NC
  117. IF (IFOUR .EQ. 1) THEN
  118. IF (DIR .EQ. 'UX') THEN
  119. NOHARM(IC) = 1
  120. ELSE IF (DIR .EQ. 'UY') THEN
  121. NOHARM(IC) = -1
  122. ELSE
  123. NOHARM(IC) = 0
  124. ENDIF
  125. ELSE
  126. NOHARM(IC) = 0
  127. ENDIF
  128. 20 CONTINUE
  129. SEGDES MSOUPO
  130. 10 CONTINUE
  131. SEGDES MCHPOI
  132. ELSE
  133. CALL ECRREE(-1.D0)
  134. CALL ECRCHA(DIR)
  135. CALL ECRENT(1)
  136. CALL ECROBJ('MAILLAGE',IMAIL)
  137. CALL MANUCH
  138. IF (IERR.NE.0) RETURN
  139. CALL LIROBJ('CHPOINT ',ICHPT,1,IRETOU)
  140. IF (IERR.NE.0) RETURN
  141. ENDIF
  142. *
  143. CALL MUCPRI(ICHPT,IMASS,ICHP2)
  144. IF (IERR.NE.0) RETURN
  145. *
  146. CALL ECROBJ('CHPOINT ',ICHP2)
  147. CALL ECROBJ('RIGIDITE',IRAID)
  148. CALL RESOU
  149. IF (IERR.NE.0) RETURN
  150. CALL LIROBJ('CHPOINT ',ICHPST,1,IRETOU)
  151. IF (IERR.NE.0) RETURN
  152. *
  153. * r{solution du syst}me dynamique
  154. *
  155. DO 30 ID = 1,NBMODE
  156. XFLOT = QSMW2(ID)
  157. IPHI = DEPL(ID)
  158. IF (ID .EQ. 1) THEN
  159. CALL MUCHPO(IPHI,XFLOT,ICHPDY,1)
  160. IF (IERR.NE.0) RETURN
  161. ELSE
  162. CALL ADCHPO(ICHPDY,IPHI,ICHP3,1D0,XFLOT)
  163. IF (IERR.NE.0) RETURN
  164. CALL DECHPO(ICHPDY)
  165. IF (IERR.NE.0) RETURN
  166. ICHPDY = ICHP3
  167. ENDIF
  168. 30 CONTINUE
  169. *
  170. * calcul du pseudo-mode
  171. *
  172. CALL ADCHPO(ICHPST,ICHPDY,ICHP1,1D0,-1D0)
  173. IF (IERR.NE.0) RETURN
  174. *
  175. * destruction
  176. *
  177. CALL DECHPO(ICHPST)
  178. IF (IERR.NE.0) RETURN
  179. CALL DECHPO(ICHPDY)
  180. IF (IERR.NE.0) RETURN
  181. CALL DECHPO(ICHPT)
  182. IF (IERR.NE.0) RETURN
  183. *
  184. SEGSUP PSTRA
  185. SEGDES MTRAV
  186. *
  187. END
  188.  
  189.  
  190.  
  191.  

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