Télécharger la plaquette Cast3M


fr en

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