Télécharger la plaquette Cast3M


fr en

Télécharger tuyro2.eso

Retour à la liste

Numérotation des lignes : 

tuyro2

  1. C TUYRO2    SOURCE    CHAT      05/01/13    03:57:23     5004
  2.       SUBROUTINE TUYRO2(REL,LRE,P,NULI,NUCO,ISYM)
  3. *-----------------------------------------------------------------------
  4. *  PRODUITS DE MATRICES PAR BLOCS
  5. *
  6. *  ENTREE
  7. C         LRE    NOMBRE DE LIGNES DU TABLEAU REL
  8. C         P      MATRICE DE PASSAGE
  9. C         NULI   NOMBRE DE LIGNES DE DECALAGE
  10. C         NUCO   NUMERO DE COLONNES DE DECALAGE
  11. C         REL    MATRICE ELEMENTAIRE EN AXES LOCAUX
  12. C         ISYM   1 SI MATRICE SYMETRIQUE 0 SINON
  13. C
  14. C  SORTIE
  15. C         REL    MATRICE ELEMENTAIRE EN AXES GLOBAUX
  16. C
  17. C-----------------------------------------------------------------------
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8(A-H,O-Z)
  20.       DIMENSION REL(LRE,*),P(3,*),W(3,3),V(3)
  21. *
  22.       NCAR=4-ISYM
  23.       NREC=4-2*ISYM
  24. *
  25. *  LES BLOCS CARRES
  26. *
  27.       I1=NULI
  28.       J1=NUCO
  29.       DO 10 ICAR=1,NCAR
  30.       IF(ICAR.EQ.2) J1=J1+3
  31.       IF(ICAR.EQ.3) I1=I1+3
  32.       IF(ICAR.EQ.4) J1=J1-3
  33. *
  34.       DO 1 I=1,3
  35.       II=I1+I
  36.       DO 1 J=1,3
  37.       W(I,J)=0.D0
  38.       DO 1 K=1,3
  39.       KK=J1+K
  40.       W(I,J)=W(I,J)+REL(II,KK)*P(K,J)
  41.  1    CONTINUE
  42. *
  43.       DO 2 I=1,3
  44.       II=I1+I
  45.       DO 2 J=1,3
  46.       JJ=J1+J
  47.       REL(II,JJ)=0.D0
  48.       DO 2 K=1,3
  49.       REL(II,JJ)=REL(II,JJ)+P(K,I)*W(K,J)
  50.  2    CONTINUE
  51. *
  52.  10   CONTINUE
  53. *
  54. *  LES BLOCS RECTANGULAIRES
  55. *
  56.       I1=NULI
  57.       J1=NUCO+6
  58.       LRE2=LRE/2
  59.       LRE6=LRE2-6
  60. *
  61.       DO 20 IREC=1,NREC
  62. *
  63.       IF(IREC.LE.2) THEN
  64.       IF(IREC.EQ.2) I1=I1+3
  65.       DO 3 J=1,LRE6
  66.       JJ=J1+J
  67.       DO 31 I=1,3
  68.       II=I1+I
  69.       V(I)=REL(II,JJ)
  70.       REL(II,JJ)=0.D0
  71.  31   CONTINUE
  72.       DO 32 I=1,3
  73.       II=I1+I
  74.       DO 32 K=1,3
  75.       REL(II,JJ)=REL(II,JJ)+P(K,I)*V(K)
  76.  32   CONTINUE
  77.   3   CONTINUE
  78. *
  79.       ELSE
  80.       IF(IREC.EQ.3) THEN
  81.                      I1=NULI+6
  82.                      J1=NUCO
  83.                     ENDIF
  84.       IF(IREC.EQ.4) J1=J1+3
  85.       DO 4 I=1,LRE6
  86.       II=I1+I
  87.       DO 41 J=1,3
  88.       JJ=J1+J
  89.       V(J)=REL(II,JJ)
  90.       REL(II,JJ)=0.D0
  91.  41   CONTINUE
  92.       DO 42 J=1,3
  93.       JJ=J1+J
  94.       DO 42 K=1,3
  95.       REL(II,JJ)=REL(II,JJ)+V(K)*P(K,J)
  96.  42   CONTINUE
  97.   4   CONTINUE
  98.       ENDIF
  99. *
  100.  20   CONTINUE
  101. *
  102.       RETURN
  103.       END
  104.  
  105.  

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