Télécharger pschoc.eso

Retour à la liste

Numérotation des lignes :

  1. C PSCHOC SOURCE CHAT 05/01/13 02:37:16 5004
  2. SUBROUTINE PSCHOC(IRAID,MTRAV,IPCH,NORM,IJ, ICHP1)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * P S C H O C
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * calcule le pseudo-mode en d{placement pour une force de choc.
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. -INC CCOPTIO
  19. -INC CCREEL
  20. -INC SMCOORD
  21. *
  22. * PARAMETRES: (e)=entr{e (s)=sortie
  23. * -----------
  24. *
  25. * IRAID (e) pointeur sur la matrice K de la structure.
  26. * MTRAV (e) pointeur sur un segemnt contenant les modes.
  27. * IPCH (e) point de choc.
  28. * NORM (e) normale de choc.
  29. * IJ (e) point de la structure IJ
  30. * ICHP1 (s) pointeur sur le pseudo-mode en d{placement.
  31. *
  32. *
  33. SEGMENT MTRAV
  34. REAL*8 FREQ(NBMODE),MN(NBMODE),MW2(NBMODE),
  35. & QX(NBMODE),QY(NBMODE),QZ(NBMODE)
  36. INTEGER DEPL(NBMODE)
  37. ENDSEGMENT
  38. *
  39. *
  40. * AUTEUR, DATE DE CREATION:
  41. * -------------------------
  42. *
  43. * Lionel VIVAN Juillet 1988
  44. *
  45. ************************************************************************
  46. *
  47. ICHP1 = 0
  48. *
  49. * normalisation de la normale
  50. *
  51. IPNV = (IDIM + 1) * (NORM - 1)
  52. PS = 0.D0
  53. DO 10 ID = 1,IDIM
  54. XC = XCOOR(IPNV + ID)
  55. PS = PS + XC * XC
  56. 10 CONTINUE
  57. IF (PS.LT.XPETIT) THEN
  58. CALL ERREUR(162)
  59. RETURN
  60. ENDIF
  61. RACPS = SQRT(PS)
  62. XX = XCOOR(IPNV + 1) / RACPS
  63. XY = XCOOR(IPNV + 2) / RACPS
  64. IF (IDIM.EQ.3) THEN
  65. XZ = XCOOR(IPNV + 3) / RACPS
  66. ENDIF
  67. IF (IJ.EQ.2) THEN
  68. XX = -1.D0 * XX
  69. XY = -1.D0 * XY
  70. IF (IDIM.EQ.3) THEN
  71. XZ = -1.D0 * XZ
  72. ENDIF
  73. ENDIF
  74. *
  75. * liste des composantes
  76. *
  77. IF (IDIM.EQ.3) THEN
  78. CALL ECRCHA('UZ')
  79. ENDIF
  80. CALL ECRCHA('UY')
  81. CALL ECRCHA('UX')
  82. CALL MOTS
  83. CALL LIROBJ('LISTMOTS',IMOT1,1,IRETOU)
  84. IF (IERR.NE.0) RETURN
  85. IF (IDIM.EQ.3) THEN
  86. CALL ECRCHA('FZ')
  87. ENDIF
  88. CALL ECRCHA('FY')
  89. CALL ECRCHA('FX')
  90. CALL MOTS
  91. CALL LIROBJ('LISTMOTS',IMOT2,1,IRETOU)
  92. IF (IERR.NE.0) RETURN
  93. *
  94. * cr{ation du chpoint force
  95. *
  96. IF (IDIM.EQ.3) THEN
  97. CALL ECRREE(XZ)
  98. CALL ECRCHA('FZ')
  99. ENDIF
  100. CALL ECRREE(XY)
  101. CALL ECRCHA('FY')
  102. CALL ECRREE(XX)
  103. CALL ECRCHA('FX')
  104. CALL ECRENT(IDIM)
  105. CALL ECROBJ('POINT',IPCH)
  106. CALL ECRCHA('CHPO')
  107. CALL MANUEL
  108. CALL LIROBJ('CHPOINT ',ICHP2,1,IRETOU)
  109. IF (IERR.NE.0) RETURN
  110. *
  111. SEGACT MTRAV
  112. NBMODE = FREQ(/1)
  113. *
  114. * r{solution du syst}me statique
  115. *
  116. CALL ECROBJ('CHPOINT ',ICHP2)
  117. CALL ECROBJ('RIGIDITE',IRAID)
  118. CALL RESOU
  119. CALL LIROBJ('CHPOINT ',ICHPST,1,IRETOU)
  120. IF (IERR.NE.0) RETURN
  121. *
  122. * r{solution du syst}me dynamique
  123. *
  124. DO 70 ID = 1,NBMODE
  125. IPHI = DEPL(ID)
  126. CALL XTY1(IPHI,ICHP2,IMOT1,IMOT2,XPHINF)
  127. IF (IERR.NE.0) RETURN
  128. XFLOT = XPHINF / MW2(ID)
  129. IF (ID .EQ. 1) THEN
  130. CALL MUCHPO(IPHI,XFLOT,ICHPDY,1)
  131. IF (IERR.NE.0) RETURN
  132. ELSE
  133. CALL ADCHPO(ICHPDY,IPHI,ICHP4,1D0,XFLOT)
  134. IF (IERR.NE.0) RETURN
  135. CALL DECHPO(ICHPDY)
  136. IF (IERR.NE.0) RETURN
  137. ICHPDY = ICHP4
  138. ENDIF
  139. 70 CONTINUE
  140. *
  141. * calcul du pseudo-mode
  142. *
  143. CALL ADCHPO(ICHPST,ICHPDY,ICHP1,1D0,-1D0)
  144. IF (IERR.NE.0) RETURN
  145. CALL DECHPO(ICHPST)
  146. IF (IERR.NE.0) RETURN
  147. CALL DECHPO(ICHPDY)
  148. IF (IERR.NE.0) RETURN
  149. *
  150. SEGDES MTRAV
  151. *
  152. END
  153.  
  154.  
  155.  
  156.  

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