Télécharger depge1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEPGE1 SOURCE CB215821 19/08/20 21:16:37 10287
  2. C
  3. SUBROUTINE DEPGE1(IPB,IPX,QI,MOT,IBBX2,IPLMOX,IPLMOY)
  4. C
  5. C********************************************************************
  6. C
  7. C SBR APPELE PAR DEPGEN
  8. C
  9. C CALCUL DES DEPLACEMENTS GENERALISES
  10. C """""""""""""""""""""""""""""""""""
  11. C ECRIT PAR D. BROCHARD 15/5/86
  12. C
  13. C
  14. C IPB POINTEUR MASSE
  15. C IPX POINTEUR MODE
  16. C PROPRE VECTEUR DES CARACTERISTIQUES MODALES)
  17. C MOT NOM DE LA COMPOSANTE
  18. C IBBX2 POINTEUR SUR CHPO M*X
  19. C IPLIMO POINTEUR SUR LIST MOTS TABLEAU UX FX ... POUR APPEL A
  20. C XTY1
  21. C
  22. C CE SBR CALCULE DTMU
  23. C TOUT D ABORD GENERATION DU VECTEUR U AYANT DES COMPOSANTES
  24. C DE VALEUR 1. SUR LES VARIABLES UX UY UZ OU SUR UR UT DANS
  25. C LEC CAS AXI OU FOURIER (1 OU -1 SELON L HARMONIQUE)
  26. C
  27. C SBR APPELANT : DEPGEN
  28. C
  29. C SBR APPELE : YTMX,DTCHPO,PLACE
  30. C
  31. C LE 15/05/86 : OPTION FOURIER N DIFF. 0 NON TESTEE
  32. C NUMERO D HARMONIQUE NON ECRITE DANS CHAMP POINT
  33. C
  34. C
  35. C
  36. C LE 08/07/86 : IFOPOI ET NOHARM CORRECTS SPR. TESTE DANS LE
  37. C CAS FOURIER AVEC UNE SEULE HARMONIQUE. RESTE
  38. C A TESTER LE CAS AXISYMETRIQUE.
  39. C
  40. C********************************************************************
  41. C
  42. C
  43. IMPLICIT INTEGER(I-N)
  44. IMPLICIT REAL*8(A-H,O-Z)
  45. -INC SMCHPOI
  46. -INC SMELEME
  47. -INC CCOPTIO
  48. SEGMENT MTRA(NSOUP1)
  49. C
  50. REAL*8 QI
  51. CHARACTER*4 MOREF(3),MOT,MOT1,MOT2(3),MOT3
  52. DATA MOT2/'UR ','UT ','UZ '/,MOREF/'UX ','UY ','UZ '/
  53. C
  54. C
  55. C EXTRAIRE LA COMPOSANTE DE NOM MOT
  56. C
  57. C
  58. C
  59. IHARM1=0
  60. MCHPO1=IPX
  61. SEGACT MCHPO1
  62. IF(MCHPO1.IFOPOI.NE.1) GOTO 1001
  63. LMOREF=3
  64. CALL PLACE(MOREF,LMOREF,IMOT,MOT)
  65. GOTO (1,2,3),IMOT
  66. 1 CONTINUE
  67. C
  68. C UX
  69. C
  70. IHARM1=1
  71. IDEB=1
  72. IFIN=2
  73. GOTO 1001
  74. 2 CONTINUE
  75. C
  76. C UY
  77. C
  78. IHARM1=-1
  79. IDEB=1
  80. IFIN=2
  81. GOTO 1001
  82. 3 CONTINUE
  83. C
  84. C UZ
  85. C
  86. IDEB=3
  87. IFIN=3
  88. C
  89. 1001 CONTINUE
  90. NSOUP1=MCHPO1.IPCHP(/1)
  91. SEGINI MTRA
  92. NSOUPO=0
  93. C
  94. C BOUCLE SUR LES SOUS PAQUETS DE MCHPO1
  95. C
  96. IF(MCHPO1.IFOPOI.EQ.1) GOTO 400
  97. DO 100 IA=1,NSOUP1
  98. MSOUP1=MCHPO1.IPCHP(IA)
  99. SEGACT MSOUP1
  100. NC1=MSOUP1.NOCOMP(/2)
  101. DO 110 IB=1,NC1
  102. MOT1=MSOUP1.NOCOMP(IB)
  103. IF(MOT1.NE.MOT) GOTO 110
  104. NSOUPO=NSOUPO+1
  105. MTRA(NSOUPO)=MSOUP1
  106. GOTO 401
  107. 110 CONTINUE
  108. 401 CONTINUE
  109. 100 CONTINUE
  110. GOTO 500
  111. 400 CONTINUE
  112. DO 410 IA=1,NSOUP1
  113. MSOUP1=MCHPO1.IPCHP(IA)
  114. SEGACT MSOUP1
  115. NC1=MSOUP1.NOCOMP(/2)
  116. DO 112 I=IDEB,IFIN
  117. MOT3=MOT2(I)
  118. DO 111 IB=1,NC1
  119. MOT1=MSOUP1.NOCOMP(IB)
  120. IHARM=MSOUP1.NOHARM(IB)
  121. IF(MOT1.EQ.MOT3.AND.IHARM.EQ.IHARM1) GOTO 112
  122. 111 CONTINUE
  123. GOTO 405
  124. 112 CONTINUE
  125. NSOUPO=NSOUPO+1
  126. MTRA(NSOUPO)=MSOUP1
  127. 405 CONTINUE
  128. 410 CONTINUE
  129. C
  130. 500 CONTINUE
  131. C
  132. IF(NSOUPO.EQ.0) GOTO 1000
  133. C
  134. IF(IHARM1.EQ.0) GOTO 300
  135. C
  136. C CREATION DU CHAMP POINT AYANT SELON LES CAS 1 OU -1 SU UR ET UT
  137. C
  138. NAT=1
  139. SEGINI MCHPOI
  140. IFOPOI=MCHPO1.IFOPOI
  141. NC=2
  142. DO 130 ISOUP=1,NSOUPO
  143. SEGINI MSOUPO
  144. IPCHP(ISOUP)=MSOUPO
  145. MSOUP1=MTRA(ISOUP)
  146. SEGACT MSOUP1
  147. IGEOC=MSOUP1.IGEOC
  148. NOCOMP(1)=MOT2(1)
  149. NOCOMP(2)=MOT2(2)
  150. NOHARM(1)=IHARM1
  151. NOHARM(2)=IHARM1
  152. MPOVA1=MSOUP1.IPOVAL
  153. SEGACT MPOVA1
  154. N=MPOVA1.VPOCHA(/1)
  155. SEGINI MPOVAL
  156. IPOVAL=MPOVAL
  157. DO 131 I=1,N
  158. VPOCHA(I,1)=1.0D0
  159. VPOCHA(I,2)=1.0D0
  160. IF(IHARM1.EQ.1) VPOCHA(I,2)=-1.0D0
  161. 131 CONTINUE
  162. 130 CONTINUE
  163. GOTO 310
  164. 300 NAT=1
  165. SEGINI MCHPOI
  166. IFOPOI=MCHPO1.IFOPOI
  167. C
  168. C CREATION D UN CHAMP POINT DE VALEUR 1.0 SUR UX OU UY OU UZ
  169. C
  170. NC=1
  171. DO 120 ISOUP=1,NSOUPO
  172. SEGINI MSOUPO
  173. IPCHP(ISOUP)=MSOUPO
  174. MSOUP1=MTRA(ISOUP)
  175. SEGACT MSOUP1
  176. IGEOC=MSOUP1.IGEOC
  177. NOCOMP(1)=MOT
  178. NOHARM(1)=0
  179. MPOVA1=MSOUP1.IPOVAL
  180. SEGACT MPOVA1
  181. N =MPOVA1.VPOCHA(/1)
  182. SEGINI MPOVAL
  183. IPOVAL=MPOVAL
  184. DO 121 I=1,N
  185. VPOCHA(I,1)= 1.D0
  186. 121 CONTINUE
  187. 120 CONTINUE
  188. 310 CONTINUE
  189. IP2=MCHPOI
  190. *
  191. IF(IBBX2.EQ.0) GOTO 2000
  192. CALL XTY1(IP2,IBBX2,IPLMOX,IPLMOY,QI)
  193. GOTO 2001
  194. C
  195. 2000 CALL YTMX(IPX,IP2,IPB,QI)
  196. 2001 CALL DTCHPO(IP2)
  197. GOTO 1100
  198. 1000 CONTINUE
  199. QI=0.D0
  200. 1100 CONTINUE
  201. SEGSUP MTRA
  202. END
  203.  
  204.  
  205.  

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