Télécharger depge2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEPGE2 SOURCE CHAT 05/01/12 22:42:22 5004
  2. C
  3. SUBROUTINE DEPGE2(IPB,IPRX,IPIX,PROPRE,IBBX2,IPLMOX,IPLMOY)
  4. C
  5. C********************************************************************
  6. C
  7. C SBR APPELE PAR ITINVC
  8. C
  9. C CALCUL DES DEPLACEMENTS GENERALISES COMPLEXES
  10. C """""""""""""""""""""""""""""""""""""""""""""
  11. C ECRIT PAR C. LE BIDEAU JUILLET 2001
  12. C
  13. C
  14. C IPB POINTEUR MASSE
  15. C IPRX POINTEUR MODES PROPRES REELS
  16. C IPIX POINTEUR MODES PROPRES IMAGINAIRES
  17. C PROPRE VECTEUR DES CARACTERISTIQUES MODALES VOIR ITINVC
  18. C IBBX2 POINTEUR SUR CHAMPONT M*X
  19. C IPLIMO POINTEUR SUR LISTMOTS CONTENANT LES COUPLES UX FX ETC
  20. C POUR APPEL DE XTY1
  21. C
  22. C CAS PLAN QX,QY (QZ=0)
  23. C CAS AXISYMETRIQUE QX=QY=0 QZ NON NUL) QZ=QZ
  24. C FOURIER:
  25. C N=0 QZ NON NUL QX=QY=0 QZ+QZ
  26. C N=1 (HARM.SYM.) QY=QZ=0 QX NON NUL QX=(QR-QT)
  27. C N=-1 (HARM.ANTIS.) QX=QZ=0 QY NON NUL QY=(QR+QT)
  28. C
  29. C
  30. C
  31. C 07/2001
  32. C _______
  33. C
  34. C LES CAS N DIFFERENT DE 0 N ONT PU ETRE TESTES CAR LES NUMEROS
  35. C D HARMONIQUE NE SONT PAS STOCKES DANS LES CHAMPS-POINT
  36. C
  37. C SOUS PROGRAMME APPELANT : ITINVC
  38. C
  39. C SOUS PROGRAMME APPELE:
  40. C DEPGE1 : CALCUL DTMU EN TESTANT SI ON EST EN SERIE DE
  41. C FOURIER OU NON
  42. C
  43. C********************************************************************
  44. C
  45. C
  46. IMPLICIT INTEGER(I-N)
  47. IMPLICIT REAL*8(A-H,O-Z)
  48. REAL*8 PROPRE(*)
  49. -INC SMCHPOI
  50. -INC SMELEME
  51. -INC CCOPTIO
  52. C
  53. CHARACTER*4 MOT(3)
  54. *
  55. * ON PREND LE NUMERO D'OPTION DANS LE MCHPOI ,VARIABLE IFOPOI
  56. *
  57. MCHPOI=IPRX
  58. SEGACT MCHPOI
  59. IFOU1=IFOPOI
  60. SEGDES MCHPOI
  61. JFOUR=IFOU1+4
  62. *
  63. * LEX DEPLACEMENTS GENERALISES SE CALCULENT
  64. * AVEC LE CONJUGUE DU VECTEUR PROPRE
  65. *
  66. CALL MUCHPO(IPIX, -1.D0, IPIXB, 1)
  67. *
  68. * IMPRESSIONS
  69. *
  70. IF(IIMPI.EQ.322) WRITE(IOIMP,1000) JFOUR
  71. 1000 FORMAT(/10X,'SBR DEPGEN JFOUR',I5)
  72. GOTO(200,200,200,210,220,230),JFOUR
  73. 200 CONTINUE
  74. C
  75. C CAS PLAN QX QY (QZ= 0)
  76. C
  77. PROPRE(5)=0.D0
  78. PROPRE(10)=0.D0
  79. MOT(1)='UX'
  80. MOT(2)='UY'
  81. LMOT=2
  82. 520 DO 500 IMOT=1,LMOT
  83. CALL DEPGE1(IPB,IPRX,PROPRE(IMOT+2),MOT(IMOT),IBBX2,IPLMOX,
  84. & IPLMOY)
  85. CALL DEPGE1(IPB,IPIXB,PROPRE(IMOT+7),MOT(IMOT),IBBX2,IPLMOX,
  86. & IPLMOY)
  87. 500 CONTINUE
  88. GOTO 999
  89. 210 CONTINUE
  90. C
  91. C CAS AXISYMETRIQUE QX=QY=0 QZ
  92. C
  93. PROPRE(3)=0.D0
  94. PROPRE(4)=0.D0
  95. MOT(1)='UZ'
  96. CALL DEPGE1(IPB,IPRX,PROPRE(5),MOT(1),IBBX2,IPLMOX,IPLMOY)
  97. PROPRE(5)=PROPRE(5)
  98. PROPRE(8)=0.D0
  99. PROPRE(9)=0.D0
  100. CALL DEPGE1(IPB,IPIXB,PROPRE(10),MOT(1),IBBX2,IPLMOX,
  101. & IPLMOY)
  102. PROPRE(10) = PROPRE(10)
  103. GOTO 999
  104. 220 CONTINUE
  105. C
  106. C SERIE DE FOURIER
  107. C N DIFF. 1 ET 0 QX=QY=QZ=0
  108. C N =1 QY=QZ=0 QX=QR-QT HARM. SYM.
  109. C QX=QZ=0 QY=QR+QT HARM.ANTYS.
  110. C N=0 QX=QY=0 QZ NON NUL
  111. C
  112. MOT(1)='UX'
  113. MOT(2)='UY'
  114. MOT(3)='UZ'
  115. LMOT=3
  116. DO 510 IMOT=1,LMOT
  117. CALL DEPGE1(IPB,IPRX,PROPRE(2+IMOT),MOT(IMOT),IBBX2,IPLMOX,
  118. & IPLMOY)
  119. CALL DEPGE1(IPB,IPIXB,PROPRE(7+IMOT),MOT(IMOT),IBBX2,IPLMOX,
  120. & IPLMOY)
  121. 510 CONTINUE
  122. PROPRE(3)=PROPRE(3)
  123. PROPRE(4)=PROPRE(4)
  124. PROPRE(5)=PROPRE(5)
  125. PROPRE(8)= PROPRE(8)
  126. PROPRE(9)= PROPRE(9)
  127. PROPRE(10)= PROPRE(10)
  128.  
  129. GOTO 999
  130. 230 CONTINUE
  131. C
  132. C CAS TRIDIM
  133. C
  134. MOT(1)='UX'
  135. MOT(2)='UY'
  136. MOT(3)='UZ'
  137. LMOT=3
  138. GOTO 520
  139. 999 CONTINUE
  140. RETURN
  141. END
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  

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