Télécharger la plaquette Cast3M


fr en

Télécharger cq8loc.eso

Retour à la liste

Numérotation des lignes : 

cq8loc

  1. C CQ8LOC    SOURCE    CHAT      05/01/12    22:27:23     5004
  2.       SUBROUTINE CQ8LOC(XX,NBNN,SHPELE,TXR,IRR)
  3. C=======================================================================
  4. C       CALCULE LES REPERES LOCAUX DES NOEUDS   COQ6 ET  COQ8
  5. C  ENTREES
  6. C     XX(3,NBNN)           : COORDONNEES DES NOEUDS
  7. C     NBNN                 : NOMBRE DE NOEUDS
  8. C  SHPELE(6,NBNN,NBNN)     :   VALEURS DES FONCTIONS DE FORME ET
  9. C                  DE LEURS DERIVEES AUX NOEUDS
  10. C  SORTIES
  11. C   TXR(3,3,NBNN)          :LES NBNN REPERE LOCAUX AUX NOEUDS
  12. C     IRR                  :INDICATEUR  D ERREUR
  13. C-----------------------------------------------------------------------
  14. C                RECUPERATION BILBO   JUILLET 86
  15. C=======================================================================
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8 (A-H,O-Z)
  18.       PARAMETER(XZER=0.D0)
  19.       DIMENSION XX(3,*),SHPELE(6,NBNN,*),TXR(3,3,*)
  20.       DIMENSION T(9)
  21. C
  22. C   ---   DETERMINATION DES AXES LOCAUX AU NOEUD I   ---
  23. C
  24.       DO 50 I=1,NBNN
  25.       DO 20 L=1,3
  26.       DO 20 J=1,2
  27.       K1=3*(J-1)+L
  28.       T(K1)=XZER
  29.       DO 20 K=1,NBNN
  30.       T(K1)=T(K1)+SHPELE(J+1,K,I)*XX(L,K)
  31.    20 CONTINUE
  32. C
  33. C   ---   PRODUIT VECTORIEL ET NORMALISATION   ---
  34. C
  35.       CALL CROSS2(T(1),T(4),T(7),IRR)
  36.       CALL CROSS2(T(7),T(1),T(4),IRR)
  37.       CALL CROSS2(T(4),T(7),T(1),IRR)
  38. C
  39.       IF(IRR.EQ.0) RETURN
  40. C
  41. C   ---   TRANSFERT DANS LE TABLEAU TXR   ---
  42. C
  43.       DO 40 J=1,3
  44.       DO 40 K=1,3
  45.       K1=3*(K-1)+J
  46.       TXR(J,K,I)=T(K1)
  47.    40 CONTINUE
  48.    50 CONTINUE
  49.       RETURN
  50.       END
  51.  
  52.  

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