Télécharger la plaquette Cast3M


fr en

Télécharger depgen.eso

Retour à la liste

Numérotation des lignes : 

depgen

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

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