Sources Esope | Cast3M

joiglo
C JOIGLO    SOURCE    AM        11/05/03    21:17:15     6955
             SUBROUTINE JOIGLO(REL,BPSS,P,PT,REG,REH,LRE,IDIM)
C-----------------------------------------------------------------------
C  CALCUL D'UNE MATRICE DANS LE REPERE GLOBAL
C
C  ENTREE
C          REL   MATRICE EXPRIMEE DANS LE REPERE LOCAL
C          BPSS  MATRICE DE PASSAGE
C  SORTIE
C          REL   MATRICE EXPRIMEE DANS LE REPERE GLOBAL
C-----------------------------------------------------------------------
       IMPLICIT INTEGER(I-N)
       IMPLICIT REAL*8(A-H,O-Z)
       DIMENSION BPSS(3,3),P(LRE,LRE),Pt(LRE,LRE)
       DIMENSION REL(LRE,LRE),REG(LRE,LRE),REH(LRE,LRE)
       CALL ZERO(REG,LRE,LRE)
       CALL ZERO(REH,LRE,LRE)
       CALL ZERO(P,LRE,LRE)
       CALL ZERO(Pt,LRE,LRE)
*
*  ASSEMBLAGE DE PASSAGE P
*
      IF(IDIM.EQ.3) THEN
      DO K=0,3
       DO I=1,3
        DO J=1,3
         P(I+3*K,J+3*K)=BPSS(I,J)
        ENDDO
       ENDDO
      ENDDO
      ELSE IF(IDIM.EQ.2) THEN
      DO K=0,1
       DO I=1,3
        DO J=1,3
         P(I+3*K,J+3*K)=BPSS(I,J)
        ENDDO
       ENDDO
      ENDDO
      ENDIF
C
C  Creation de la transposée de P
C
       DO I=1,LRE
        DO J=1,LRE
         Pt(J,I)=P(I,J)
        ENDDO
       ENDDO
C
C  REG = REL*P
C
       DO I=1,LRE
        DO J=1,LRE
         DO K=1,LRE
          REG(I,J) = REG(I,J) + REL(I,K)*P(K,J)
         ENDDO
        ENDDO
       ENDDO
C
C  REH = Pt*REG
C
       DO I=1,LRE
        DO J=1,LRE
         DO K=1,LRE
          REH(I,J) = REH(I,J) + Pt(I,K)*REG(K,J)
         ENDDO
        ENDDO
       ENDDO
*
       CALL ZERO(REL,LRE,LRE)
C
C  REL = REG
C
       DO I=1,LRE
        DO J=1,LRE
         REL(I,J)=REH(I,J)
        ENDDO
       ENDDO
*
       RETURN
       END