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    CB215821  26/08/24    21:18:45     12622          
  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 44 I=1,3
  35.       II=I1+I
  36.       DO 43 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 CONTINUE
  43.    44 CONTINUE
  44. *
  45.       DO 46 I=1,3
  46.       II=I1+I
  47.       DO 45 J=1,3
  48.       JJ=J1+J
  49.       REL(II,JJ)=0.D0
  50.       DO 2 K=1,3
  51.       REL(II,JJ)=REL(II,JJ)+P(K,I)*W(K,J)
  52.  2    CONTINUE
  53.    45 CONTINUE
  54.    46 CONTINUE
  55. *
  56.  10   CONTINUE
  57. *
  58. *  LES BLOCS RECTANGULAIRES
  59. *
  60.       I1=NULI
  61.       J1=NUCO+6
  62.       LRE2=LRE/2
  63.       LRE6=LRE2-6
  64. *
  65.       DO 20 IREC=1,NREC
  66. *
  67.       IF(IREC.LE.2) THEN
  68.       IF(IREC.EQ.2) I1=I1+3
  69.       DO 3 J=1,LRE6
  70.       JJ=J1+J
  71.       DO 31 I=1,3
  72.       II=I1+I
  73.       V(I)=REL(II,JJ)
  74.       REL(II,JJ)=0.D0
  75.  31   CONTINUE
  76.       DO 47 I=1,3
  77.       II=I1+I
  78.       DO 32 K=1,3
  79.       REL(II,JJ)=REL(II,JJ)+P(K,I)*V(K)
  80.  32   CONTINUE
  81.    47 CONTINUE
  82.   3   CONTINUE
  83. *
  84.       ELSE
  85.       IF(IREC.EQ.3) THEN
  86.                      I1=NULI+6
  87.                      J1=NUCO
  88.                     ENDIF
  89.       IF(IREC.EQ.4) J1=J1+3
  90.       DO 4 I=1,LRE6
  91.       II=I1+I
  92.       DO 41 J=1,3
  93.       JJ=J1+J
  94.       V(J)=REL(II,JJ)
  95.       REL(II,JJ)=0.D0
  96.  41   CONTINUE
  97.       DO 48 J=1,3
  98.       JJ=J1+J
  99.       DO 42 K=1,3
  100.       REL(II,JJ)=REL(II,JJ)+V(K)*P(K,J)
  101.  42   CONTINUE
  102.    48 CONTINUE
  103.   4   CONTINUE
  104.       ENDIF
  105. *
  106.  20   CONTINUE
  107. *
  108.       RETURN
  109.       END
  110.  
  111.  
  112.  

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