Télécharger la plaquette Cast3M


fr en

Télécharger devlk0.eso

Retour à la liste

Numérotation des lignes : 

devlk0

  1. C DEVLK0    SOURCE    BP208322  15/07/22    21:15:24     8586
  2. C DEVLK0    SOURCE    PLAF      89/08/01    21:13:53
  3.       SUBROUTINE DEVLK0(Q1,XK,FTOTA,NA1,NB1K,IND)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Operateur DYNE                                                 *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Actualisation des forces exterieures totalisees sur la base A  *
  12. *     FTOTA = FTOTA - K*q                                            *
  13. *     Calcule le produit matrice vecteur                             *
  14. *     Distingue le cas matrice diagonal et pleine                    *
  15. *                                                                    *
  16. *     Parametres:                                                    *
  17. *                                                                    *
  18. * e   Q1(,)     Deplacement generalise                               *
  19. * e   XK        Matrice de raideur generalisee                       *
  20. * es  FTOTA     Forces totalisees                                    *
  21. * e   NA1,NB1K  Dimension de la matrice                              *
  22. *               (si NB1K=1, alors matrice diagonale)                 *
  23. * e   IND       Indice du pas                                        *
  24. *                                                                    *
  25. *    -Auteur, date de creation:                                      *
  26. *     Denis ROBERT-MOUGIN, le 22 mai 1989.                           *
  27. *    -Modifs : distinction cas diago et plein                        *
  28. *     Benoit PRABEL, 11/02/2015                                      *
  29. *                                                                    *
  30. *--------------------------------------------------------------------*
  31.       REAL*8 Q1(NA1,*),XK(NA1,*),FTOTA(NA1,*)
  32. *
  33. *
  34.       IF (NB1K.EQ.1) THEN
  35.          DO 100 I=1,NA1
  36.            FTOTA(I,IND) = FTOTA(I,IND) - XK(I,1)*Q1(I,IND)
  37.  100     CONTINUE
  38. c       ELSEIF(NB1K.NE.NA1) THEN
  39. c         CALL ERREUR(832)
  40. c on ne va pas tester a chaque fois que cette subroutine est appelee
  41.       ELSE
  42.          DO 200 I=1,NA1
  43.          DO 200 J=1,NB1K
  44.            FTOTA(I,IND) = FTOTA(I,IND) - XK(I,J)*Q1(J,IND)
  45.  200     CONTINUE
  46.       ENDIF
  47.  
  48.       END
  49.  
  50.  
  51.  

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