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