Télécharger depge2.eso

Retour à la liste

Numérotation des lignes :

depge2
  1. C DEPGE2 SOURCE FANDEUR 22/01/03 21:15:10 11136
  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. IMPLICIT INTEGER(I-N)
  46. IMPLICIT REAL*8(A-H,O-Z)
  47.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50.  
  51. -INC SMCHPOI
  52. -INC SMELEME
  53.  
  54. REAL*8 PROPRE(*)
  55.  
  56. CHARACTER*(LOCOMP) MOT(3)
  57. *
  58. * ON PREND LE NUMERO D'OPTION DANS LE MCHPOI ,VARIABLE IFOPOI
  59. *
  60. MCHPOI=IPRX
  61. SEGACT MCHPOI
  62. IFOU1=IFOPOI
  63. SEGDES MCHPOI
  64. JFOUR=IFOU1+4
  65. *
  66. * LEX DEPLACEMENTS GENERALISES SE CALCULENT
  67. * AVEC LE CONJUGUE DU VECTEUR PROPRE
  68. *
  69. CALL MUCHPO(IPIX, -1.D0, IPIXB, 1)
  70. *
  71. * IMPRESSIONS
  72. *
  73. IF(IIMPI.EQ.322) WRITE(IOIMP,1000) JFOUR
  74. 1000 FORMAT(/10X,'SBR DEPGEN JFOUR',I5)
  75. GOTO(200,200,200,210,220,230),JFOUR
  76. 200 CONTINUE
  77. C
  78. C CAS PLAN QX QY (QZ= 0)
  79. C
  80. PROPRE(5)=0.D0
  81. PROPRE(10)=0.D0
  82. MOT(1)='UX'
  83. MOT(2)='UY'
  84. LMOT=2
  85. 520 DO 500 IMOT=1,LMOT
  86. CALL DEPGE1(IPB,IPRX,PROPRE(IMOT+2),MOT(IMOT),IBBX2,IPLMOX,
  87. & IPLMOY)
  88. CALL DEPGE1(IPB,IPIXB,PROPRE(IMOT+7),MOT(IMOT),IBBX2,IPLMOX,
  89. & IPLMOY)
  90. 500 CONTINUE
  91. GOTO 999
  92. 210 CONTINUE
  93. C
  94. C CAS AXISYMETRIQUE QX=QY=0 QZ
  95. C
  96. PROPRE(3)=0.D0
  97. PROPRE(4)=0.D0
  98. MOT(1)='UZ'
  99. CALL DEPGE1(IPB,IPRX,PROPRE(5),MOT(1),IBBX2,IPLMOX,IPLMOY)
  100. PROPRE(5)=PROPRE(5)
  101. PROPRE(8)=0.D0
  102. PROPRE(9)=0.D0
  103. CALL DEPGE1(IPB,IPIXB,PROPRE(10),MOT(1),IBBX2,IPLMOX,
  104. & IPLMOY)
  105. PROPRE(10) = PROPRE(10)
  106. GOTO 999
  107. 220 CONTINUE
  108. C
  109. C SERIE DE FOURIER
  110. C N DIFF. 1 ET 0 QX=QY=QZ=0
  111. C N =1 QY=QZ=0 QX=QR-QT HARM. SYM.
  112. C QX=QZ=0 QY=QR+QT HARM.ANTYS.
  113. C N=0 QX=QY=0 QZ NON NUL
  114. C
  115. MOT(1)='UX'
  116. MOT(2)='UY'
  117. MOT(3)='UZ'
  118. LMOT=3
  119. DO 510 IMOT=1,LMOT
  120. CALL DEPGE1(IPB,IPRX,PROPRE(2+IMOT),MOT(IMOT),IBBX2,IPLMOX,
  121. & IPLMOY)
  122. CALL DEPGE1(IPB,IPIXB,PROPRE(7+IMOT),MOT(IMOT),IBBX2,IPLMOX,
  123. & IPLMOY)
  124. 510 CONTINUE
  125. PROPRE(3)=PROPRE(3)
  126. PROPRE(4)=PROPRE(4)
  127. PROPRE(5)=PROPRE(5)
  128. PROPRE(8)= PROPRE(8)
  129. PROPRE(9)= PROPRE(9)
  130. PROPRE(10)= PROPRE(10)
  131.  
  132. GOTO 999
  133. 230 CONTINUE
  134. C
  135. C CAS TRIDIM
  136. C
  137. MOT(1)='UX'
  138. MOT(2)='UY'
  139. MOT(3)='UZ'
  140. LMOT=3
  141. GOTO 520
  142. 999 CONTINUE
  143.  
  144. c RETURN
  145. END
  146.  
  147.  
  148.  

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