Télécharger la plaquette Cast3M


fr en

Télécharger hbmrw.eso

Retour à la liste

Numérotation des lignes : 

hbmrw

  1. C HBMRW     SOURCE    BP208322  20/10/05    21:15:18     10742          
  2.         SUBROUTINE HBMRW(NT,NDDL,ISD,X,OMEG,XM,XC,XK,Rw,LOGAMO)
  3.  
  4. *=======================================================================
  5. * Rw: calcul de la derivee: Rw = Z,w(w)*X - P,w
  6. *     TODO? : terme P,w ?
  7. * Zw = 2*w*kron(DL²,M)+kron(DL,C)
  8. * X : coefficients de Fourier
  9. * w : frequence angulaire
  10. *=======================================================================
  11.  
  12. *----- Declarations ----------------------------------------------------
  13.  
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8(A-H,O-Z)
  16.  
  17.       REAL*8 X(NT),Rw(NT),OMEG
  18.       REAL*8 XM(NDDL,NDDL),XC(NDDL,NDDL),XK(NDDL,NDDL)
  19.       REAL*8 CF,CF2
  20.       INTEGER NT,NDDL,ISD,H,I,J,M,P,Q,NH
  21.       LOGICAL LOGAMO
  22.  
  23. *       Nombre d'harmoniques
  24.         NH = (NT/NDDL - 1)/2
  25.  
  26. *------ Matrices diagonales --------------------------------------------
  27.         IF (ISD.EQ.1) THEN
  28.  
  29. *         Termes constants
  30.           DO 1 P=1,NDDL
  31.             Rw(P) = 0.D0
  32.   1       CONTINUE
  33.  
  34. c        -cas non conservatif (i.e. avec amortissement)
  35.           IF (LOGAMO) THEN
  36.  
  37.             DO 10 J=1,2*NH
  38. *              Termes paires (sin)
  39.                IF (MOD(J,2).EQ.0) THEN
  40.                    cf = -J/2.D0
  41.                    cf2 = -2.D0*OMEG*(cf**2)
  42.                    DO 11 I = 1,NDDL 
  43.                       Rw(J*nddl+I) = cf2 * XM(I,1) * X(J*nddl+I)
  44.      &                             + cf  * XC(I,1) * X((J-1)*nddl+I)        
  45.  11                CONTINUE
  46. *              Termes impaires (cos)     
  47.                ELSE
  48.                    cf = (J+1)/2.D0
  49.                    cf2 = -2.D0*OMEG*(cf**2)
  50.                    DO 12 I = 1,NDDL
  51.                       Rw(J*nddl+I) = cf2 * XM(I,1) * X(J*nddl+I) 
  52.      &                             + cf  * XC(I,1) * X((J+1)*NDDL+I)
  53.  12                CONTINUE
  54.                ENDIF
  55. 10          CONTINUE
  56.  
  57. c        -cas conservatif (i.e. sans amortissement)
  58.           ELSE
  59.             DO 20 J=1,2*NH
  60. *               Termes paires (sin)
  61.                 IF (MOD(J,2).EQ.0) THEN
  62. cbp                  cf = -J/2.D0
  63.                    cf2 = -0.5D0*OMEG*(J**2)
  64.                    DO 21 I = 1,NDDL 
  65. cbp             Rw(J*nddl+I)= -2.*OMEG*(cf**2)*XM(I,1)*X(J*nddl+I)     
  66.                 Rw(J*nddl+I) = cf2 * XM(I,1) * X(J*nddl+I)     
  67.  21                 CONTINUE
  68. *               Termes impaires (cos)     
  69.                 ELSE
  70. cbp                cf = (J+1)/2.D0
  71.                    cf2 = -0.5D0*OMEG*((J+1)**2)
  72.                    DO 22 I = 1,NDDL
  73. cbp                   Rw(J*nddl+I)=-2.*OMEG*(cf**2)*XM(I,1)*X(J*nddl+I) 
  74.                       Rw(J*nddl+I) = cf2 * XM(I,1) * X(J*nddl+I) 
  75.  22                 CONTINUE
  76.                 ENDIF
  77.  20          CONTINUE
  78.  
  79.           ENDIF
  80.  
  81.  
  82. *------- Matrices generales --------------------------------------------
  83.          ELSE
  84.  
  85. *           Termes constants
  86.             DO 101 P=1,NDDL
  87.                   Rw(P) = 0.D0 
  88.  101        CONTINUE
  89.  
  90. c          -cas non conservatif (i.e. avec amortissement)
  91.             IF (LOGAMO) THEN
  92.  
  93.               DO 111 J=2,2*NH,2
  94.                 cf2 = 2.D0*OMEG*(J**2)
  95.                 DO 112 M=1,NDDL
  96.                    Rw(J*NDDL+M) = 0.D0
  97.                    DO 113 H=1,NDDL
  98.                      Rw(J*NDDL+M) = Rw(J*NDDL+M) 
  99.      &                            - cf2 * XM(M,H) * X(J*NDDL+H)  
  100.      &                            + J   * XC(M,H) * X((J+1)*NDDL+H)
  101.                      Rw((J+1)*NDDL+M) = Rw((J+1)*NDDL+M)
  102.      &                                - cf2 * XM(M,H) * X((J+1)*NDDL+H) 
  103.      &                                - J   * XC(M,H) * X(J*NDDL+H)          
  104.  113               CONTINUE
  105.  112            CONTINUE
  106.  111          CONTINUE
  107.  
  108. c          -cas conservatif (i.e. sans amortissement)
  109.             ELSE
  110.  
  111.               DO 121 J=2,2*NH,2              
  112.                 cf2 = 2.D0*OMEG*(J**2)
  113.                 DO 122 M=1,NDDL
  114.                    Rw(J*NDDL+M) = 0.D0
  115.                    DO 123 H=1,NDDL
  116.                      Rw(J*NDDL+M) = Rw(J*NDDL+M)
  117.      &                            - cf2 * XM(M,H) * X(J*NDDL+H)  
  118.                      Rw((J+1)*NDDL+M) = Rw((J+1)*NDDL+M)
  119.      &                                - cf2 * XM(M,H) * X((J+1)*NDDL+H) 
  120.  123               CONTINUE
  121.  122            CONTINUE
  122.  121          CONTINUE
  123.  
  124.             ENDIF
  125.  
  126.          ENDIF
  127.  
  128.         END
  129.  
  130.  
  131.  
  132.  
  133.  

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