Télécharger pschpt.eso

Retour à la liste

Numérotation des lignes :

  1. C PSCHPT SOURCE BP208322 15/06/22 21:21:29 8543
  2. SUBROUTINE PSCHPT(IRAID,IMASS,MTRAV,ICHPT,TYP,ICHP1)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * P S C H P T
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * calcule le pseudo-mode en d{placement pour un CHPOINT.
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. -INC CCHAMP
  19. -INC CCOPTIO
  20. -INC SMCHPOI
  21. *
  22. * PARAMETRES: (e)=entr{e (s)=sortie
  23. * -----------
  24. *
  25. * IRAID (e) pointeur sur la matrice K de la structure.
  26. * IMASS (e) pointeur sur la matrice M de la structure.
  27. * MTRAV (e) pointeur sur un segment contenant les modes.
  28. * ICHPT (e) pointeur sur le chpoint force.
  29. * TYP (e) = 'FORC', chpoint de type force.
  30. * = 'DEPL', chpoint de type d{placement.
  31. * ICHP1 (s) pointeur sur le pseudo-mode en d{placement.
  32. *
  33. *
  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. * VARIABLES:
  42. * ----------
  43. *
  44. CHARACTER*4 TYP,NOM,LNOM
  45. *
  46. *
  47. * AUTEUR, DATE DE CREATION:
  48. * -------------------------
  49. *
  50. * Lionel VIVAN Avril 1990
  51. *
  52. ************************************************************************
  53. *
  54. ICHP1 = 0
  55. *
  56. IF (TYP.EQ.'FORC') THEN
  57. I5 = 1
  58. CALL COPIE2(ICHPT,ICHP2)
  59. MCHPOI = ICHP2
  60. SEGACT MCHPOI
  61. NSOU = IPCHP(/1)
  62. DO 10 I = 1,NSOU
  63. MSOUPO = IPCHP(I)
  64. SEGACT MSOUPO
  65. NC = NOCOMP(/2)
  66. *
  67. * liste des composantes
  68. *
  69. DO 20 I4 = 1,NC
  70. NOM = NOCOMP(I4)
  71. CALL PLACE(NOMDU,40,INOM,NOM)
  72. LNOM = NOMDD(INOM)
  73. IF (I4.EQ.1 .AND. I.EQ.1) THEN
  74. CALL ECRCHA(NOM)
  75. CALL MOTS
  76. IF (IERR.NE.0) RETURN
  77. CALL LIROBJ('LISTMOTS',IMOT1,1,IRETOU)
  78. IF (IERR.NE.0) RETURN
  79. CALL ECRCHA(LNOM)
  80. CALL MOTS
  81. IF (IERR.NE.0) RETURN
  82. CALL LIROBJ('LISTMOTS',IMOT2,1,IRETOU)
  83. IF (IERR.NE.0) RETURN
  84. ELSE
  85. I5 = I5 + 1
  86. CALL INSER3(IMOT1,I5,NOM)
  87. IF (IERR.NE.0) RETURN
  88. CALL INSER3(IMOT2,I5,LNOM)
  89. IF (IERR.NE.0) RETURN
  90. ENDIF
  91. 20 CONTINUE
  92. * end do
  93. SEGDES MSOUPO
  94. 10 CONTINUE
  95. * end do
  96. SEGDES MCHPOI
  97. ENDIF
  98. *
  99. SEGACT MTRAV
  100. NBMODE = FREQ(/1)
  101. *
  102. * r{solution du syst}me statique
  103. *
  104. IF (TYP.EQ.'DEPL') THEN
  105. CALL MUCHPO(ICHPT,-1.D0,ICHP3,1)
  106. IF (IERR.NE.0) RETURN
  107. CALL MUCPRI(ICHP3,IMASS,ICHP2)
  108. IF (IERR.NE.0) RETURN
  109. CALL DECHPO(ICHP3)
  110. IF (IERR.NE.0) RETURN
  111. ENDIF
  112. CALL ECROBJ('CHPOINT ',ICHP2)
  113. CALL ECROBJ('RIGIDITE',IRAID)
  114. CALL RESOU
  115. IF (IERR.NE.0) RETURN
  116. CALL LIROBJ('CHPOINT ',ICHPST,1,IRETOU)
  117. IF (IERR.NE.0) RETURN
  118. *
  119. * r{solution du syst}me dynamique
  120. *
  121. DO 30 ID = 1,NBMODE
  122. IPHI = DEPL(ID)
  123. IF (TYP.EQ.'FORC') THEN
  124. CALL XTY1(IPHI,ICHP2,IMOT2,IMOT1,XPHINF)
  125. IF (IERR.NE.0) RETURN
  126. XFLOT = XPHINF / MW2(ID)
  127. ELSE IF (TYP.EQ.'DEPL') THEN
  128. CALL YTMX(IPHI,ICHPT,IMASS,RNI)
  129. IF (IERR.NE.0) RETURN
  130. XFLOT = -1.D0 * RNI / MW2(ID)
  131. ENDIF
  132. IF (ID .EQ. 1) THEN
  133. CALL MUCHPO(IPHI,XFLOT,ICHPDY,1)
  134. IF (IERR.NE.0) RETURN
  135. ELSE
  136. CALL ADCHPO(ICHPDY,IPHI,ICHP4,1D0,XFLOT)
  137. IF (IERR.NE.0) RETURN
  138. CALL DECHPO(ICHPDY)
  139. IF (IERR.NE.0) RETURN
  140. ICHPDY = ICHP4
  141. ENDIF
  142. 30 CONTINUE
  143. * end do
  144. *
  145. * calcul du pseudo-mode
  146. *
  147. CALL ADCHPO(ICHPST,ICHPDY,ICHP1,1D0,-1D0)
  148. IF (IERR.NE.0) RETURN
  149. CALL DECHPO(ICHPST)
  150. IF (IERR.NE.0) RETURN
  151. CALL DECHPO(ICHPDY)
  152. IF (IERR.NE.0) RETURN
  153. CALL DECHPO(ICHP2)
  154. IF (IERR.NE.0) RETURN
  155. *
  156. SEGDES MTRAV
  157. *
  158. END
  159.  
  160.  
  161.  
  162.  
  163.  

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