Télécharger depge1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEPGE1 SOURCE CHAT 05/01/12 22:42:17 5004
  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. SEGDES MSOUP1
  110. 100 CONTINUE
  111. GOTO 500
  112. 400 CONTINUE
  113. DO 410 IA=1,NSOUP1
  114. MSOUP1=MCHPO1.IPCHP(IA)
  115. SEGACT MSOUP1
  116. NC1=MSOUP1.NOCOMP(/2)
  117. DO 112 I=IDEB,IFIN
  118. MOT3=MOT2(I)
  119. DO 111 IB=1,NC1
  120. MOT1=MSOUP1.NOCOMP(IB)
  121. IHARM=MSOUP1.NOHARM(IB)
  122. IF(MOT1.EQ.MOT3.AND.IHARM.EQ.IHARM1) GOTO 112
  123. 111 CONTINUE
  124. GOTO 405
  125. 112 CONTINUE
  126. NSOUPO=NSOUPO+1
  127. MTRA(NSOUPO)=MSOUP1
  128. 405 CONTINUE
  129. SEGDES MSOUP1
  130. 410 CONTINUE
  131. C
  132. 500 CONTINUE
  133. C
  134. IF(NSOUPO.EQ.0) GOTO 1000
  135. C
  136. IF(IHARM1.EQ.0) GOTO 300
  137. C
  138. C CREATION DU CHAMP POINT AYANT SELON LES CAS 1 OU -1 SU UR ET UT
  139. C
  140. NAT=1
  141. SEGINI MCHPOI
  142. IFOPOI=MCHPO1.IFOPOI
  143. NC=2
  144. DO 130 ISOUP=1,NSOUPO
  145. SEGINI MSOUPO
  146. IPCHP(ISOUP)=MSOUPO
  147. MSOUP1=MTRA(ISOUP)
  148. SEGACT MSOUP1
  149. IGEOC=MSOUP1.IGEOC
  150. NOCOMP(1)=MOT2(1)
  151. NOCOMP(2)=MOT2(2)
  152. NOHARM(1)=IHARM1
  153. NOHARM(2)=IHARM1
  154. MPOVA1=MSOUP1.IPOVAL
  155. SEGACT MPOVA1
  156. N=MPOVA1.VPOCHA(/1)
  157. SEGINI MPOVAL
  158. IPOVAL=MPOVAL
  159. DO 131 I=1,N
  160. VPOCHA(I,1)=1.0D0
  161. VPOCHA(I,2)=1.0D0
  162. IF(IHARM1.EQ.1) VPOCHA(I,2)=-1.0D0
  163. 131 CONTINUE
  164. SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO
  165. 130 CONTINUE
  166. GOTO 310
  167. 300 NAT=1
  168. SEGINI MCHPOI
  169. IFOPOI=MCHPO1.IFOPOI
  170. C
  171. C CREATION D UN CHAMP POINT DE VALEUR 1.0 SUR UX OU UY OU UZ
  172. C
  173. NC=1
  174. DO 120 ISOUP=1,NSOUPO
  175. SEGINI MSOUPO
  176. IPCHP(ISOUP)=MSOUPO
  177. MSOUP1=MTRA(ISOUP)
  178. SEGACT MSOUP1
  179. IGEOC=MSOUP1.IGEOC
  180. NOCOMP(1)=MOT
  181. NOHARM(1)=0
  182. MPOVA1=MSOUP1.IPOVAL
  183. SEGACT MPOVA1
  184. N =MPOVA1.VPOCHA(/1)
  185. SEGINI MPOVAL
  186. IPOVAL=MPOVAL
  187. DO 121 I=1,N
  188. VPOCHA(I,1)= 1.D0
  189. 121 CONTINUE
  190. SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO
  191. 120 CONTINUE
  192. 310 CONTINUE
  193. IP2=MCHPOI
  194. SEGDES MCHPOI
  195. *
  196. IF(IBBX2.EQ.0) GOTO 2000
  197. CALL XTY1(IP2,IBBX2,IPLMOX,IPLMOY,QI)
  198. GOTO 2001
  199. C
  200. 2000 CALL YTMX(IPX,IP2,IPB,QI)
  201. 2001 CALL DTCHPO(IP2)
  202. GOTO 1100
  203. 1000 CONTINUE
  204. QI=0.D0
  205. 1100 CONTINUE
  206. SEGSUP MTRA
  207. SEGDES MCHPO1
  208. RETURN
  209. END
  210.  
  211.  

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