Télécharger la plaquette Cast3M


fr en

Télécharger deveq8.eso

Retour à la liste

Numérotation des lignes : 

deveq8

  1. C DEVEQ8    SOURCE    BP208322  18/12/20    21:15:29     10048          
  2. C
  3.       SUBROUTINE DEVEQ8(Q2,NA1,XM,PDT,NPAS,FTOTA,FAMOR,
  4.      &              XOPM1,NB1,NB1M)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. *                                                                    *
  9. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  10. *     ________________________________________________               *
  11. *                                                                    *
  12. *     Calcul des vitesses generalisees pour le second demi-pas       *
  13. *     de temps.                                                      *
  14. *                                                                    *
  15. *     Param}tres:                                                    *
  16. *                                                                    *
  17. * es  Q2(.,.) Vecteur des vitesses generalisees                      *
  18. * e   NA1     Nombre total d'inconnues dans la base A                *
  19. * e   XM      Vecteur des masses generalisees                        *
  20. * e   PDT     pas de temps                               *
  21. * e   NPAS    Numero du pas de temps                                 *
  22. * e   FTOTA   Forces exterieures totalisees, sur la base A           *
  23. *                                                                    *
  24. *     Auteur, date de creation:                                      *
  25. *     Benoit PRABEL, 16/02/2015                                      *
  26. *                                                                    *
  27. *--------------------------------------------------------------------*
  28.       REAL*8 Q2(NA1,*)
  29.       REAL*8 XM(NA1,*),FTOTA(NA1,*)
  30.       REAL*8 XOPM1(NB1,NB1,*),FAMOR(NA1,*),F2ND(NA1)
  31. *
  32.       PDTS6 = PDT / 6.D0
  33. *
  34. *     .
  35. *     Q        = [6 + dt M^-1 C]^-1 *
  36. *      i,m+1
  37. *                        .
  38. *                    ( 6 Q    + h M^-1 ( F      + 4 F       + F
  39. *                         i,m             i,m+1      i,m+1/2   i,m
  40. *
  41. *                        .          .
  42. *              - C   ( 4 Q        + Q    ) ) )
  43. *                 ij      j,m+1/2    j,m
  44. *
  45.  
  46. C     CALCUL DU 2ND MEMBRE
  47.  
  48. C     MATRICE M PLEINE
  49.       IF(NB1M.GT.1) THEN
  50.  
  51.         DO 31 IA=1,NA1
  52.           AUX = 0.D0
  53.           DO 32 IB=1,NB1
  54.             AUX = AUX + XOPM1(IA,IB,3)
  55.      &      * ( FTOTA(IB,1) + 4.D0*(FTOTA(IB,2)-FAMOR(IB,2))
  56.      &                      +       FTOTA(IB,3)-FAMOR(IB,3) )
  57.  32       CONTINUE
  58.           F2ND(IA) = 6.D0*Q2(IA,3) + PDT*AUX
  59.  31     CONTINUE
  60.  
  61.  
  62. C     MATRICE M DIAGO
  63.       ELSE
  64.  
  65.         DO 30 I=1,NA1
  66.            F2ND(I) =  (6.D0*Q2(I,3)) + ( PDT
  67.      &     * ( FTOTA(I,1) + 4.D0*(FTOTA(I,2)-FAMOR(I,2))
  68.      &                    +       FTOTA(I,3)-FAMOR(I,3) )/XM(I,1))
  69.  30     CONTINUE
  70.  
  71.       ENDIF
  72.  
  73. C     MATRICE M ou C PLEINE
  74.       DO 10 IA = 1,NA1
  75.          Q2(IA,1) = 0.D0
  76.       DO 10 IB = 1,NB1
  77.          Q2(IA,1) = Q2(IA,1) + (XOPM1(IA,IB,2)*F2ND(IB))
  78.  10   CONTINUE
  79.  
  80.  
  81.       END
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  

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