Télécharger depgen.eso

Retour à la liste

Numérotation des lignes :

  1. C DEPGEN SOURCE CHAT 05/01/12 22:42:26 5004
  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. C
  45. IMPLICIT INTEGER(I-N)
  46. IMPLICIT REAL*8(A-H,O-Z)
  47. REAL*8 PROPRE(*)
  48. -INC SMCHPOI
  49. -INC SMELEME
  50. -INC CCOPTIO
  51. C
  52. CHARACTER*4 MOT(3)
  53. *
  54. * ON PREND LE NUMERO D'OPTION DANS LE MCHPOI ,VARIABLE IFOPOI
  55. *
  56. MCHPOI=IPX
  57. SEGACT MCHPOI
  58. IFOU1=IFOPOI
  59. SEGDES MCHPOI
  60. JFOUR=IFOU1+4
  61. *
  62. * IMPRESSIONS
  63. *
  64. IF(IIMPI.EQ.322) WRITE(IOIMP,1000) JFOUR
  65. 1000 FORMAT(/10X,'SBR DEPGEN JFOUR',I5)
  66. *
  67. * ANCIENNE VERSION JFOUR=IFOUR+4
  68. *
  69. GOTO(200,200,200,210,220,230),JFOUR
  70. 200 CONTINUE
  71. C
  72. C CAS PLAN QX QY (QZ= 0)
  73. C
  74. PROPRE(5)=0.D0
  75. MOT(1)='UX'
  76. MOT(2)='UY'
  77. LMOT=2
  78. 520 DO 500 IMOT=1,LMOT
  79. CALL DEPGE1(IPB,IPX,PROPRE(IMOT+2),MOT(IMOT),IBBX2,IPLMOX,
  80. C IPLMOY)
  81. 500 CONTINUE
  82. GOTO 999
  83. 210 CONTINUE
  84. C
  85. C CAS AXISYMETRIQUE QX=QY=0 QZ
  86. C
  87. PROPRE(3)=0.D0
  88. PROPRE(4)=0.D0
  89. MOT(1)='UZ'
  90. CALL DEPGE1(IPB,IPX,PROPRE(5),MOT(1),IBBX2,IPLMOX,IPLMOY)
  91. PROPRE(5)=PROPRE(5)
  92. GOTO 999
  93. 220 CONTINUE
  94. C
  95. C SERIE DE FOURIER
  96. C N DIFF. 1 ET 0 QX=QY=QZ=0
  97. C N =1 QY=QZ=0 QX=QR-QT HARM. SYM.
  98. C QX=QZ=0 QY=QR+QT HARM.ANTYS.
  99. C N=0 QX=QY=0 QZ NON NUL
  100. C
  101. MOT(1)='UX'
  102. MOT(2)='UY'
  103. MOT(3)='UZ'
  104. LMOT=3
  105. DO 510 IMOT=1,LMOT
  106. CALL DEPGE1(IPB,IPX,PROPRE(2+IMOT),MOT(IMOT),IBBX2,IPLMOX,
  107. C IPLMOY)
  108. 510 CONTINUE
  109. PROPRE(3)=PROPRE(3)
  110. PROPRE(4)=PROPRE(4)
  111. PROPRE(5)=PROPRE(5)
  112. GOTO 999
  113. 230 CONTINUE
  114. C
  115. C CAS TRIDIM
  116. C
  117. MOT(1)='UX'
  118. MOT(2)='UY'
  119. MOT(3)='UZ'
  120. LMOT=3
  121. GOTO 520
  122. 999 CONTINUE
  123. RETURN
  124. END
  125.  
  126.  
  127.  

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