Esope source files

   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 :