1 : C JOIGLO SOURCE AM 11/05/03 21:17:15 6955 2 : SUBROUTINE JOIGLO(REL,BPSS,P,PT,REG,REH,LRE,IDIM) 3 : C----------------------------------------------------------------------- 4 : C CALCUL D'UNE MATRICE DANS LE REPERE GLOBAL 5 : C 6 : C ENTREE 7 : C REL MATRICE EXPRIMEE DANS LE REPERE LOCAL 8 : C BPSS MATRICE DE PASSAGE 9 : C SORTIE 10 : C REL MATRICE EXPRIMEE DANS LE REPERE GLOBAL 11 : C----------------------------------------------------------------------- 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : DIMENSION BPSS(3,3),P(LRE,LRE),Pt(LRE,LRE) 15 : DIMENSION REL(LRE,LRE),REG(LRE,LRE),REH(LRE,LRE) 15 : CALL ZERO(REG,LRE,LRE) 15 : CALL ZERO(REH,LRE,LRE) 15 : CALL ZERO(P,LRE,LRE) 15 : CALL ZERO(Pt,LRE,LRE) 16 : * 17 : * ASSEMBLAGE DE PASSAGE P 18 : * 19 : IF(IDIM.EQ.3) THEN 20 : DO K=0,3 21 : DO I=1,3 22 : DO J=1,3 23 : P(I+3*K,J+3*K)=BPSS(I,J) 24 : ENDDO 25 : ENDDO 26 : ENDDO 27 : ELSE IF(IDIM.EQ.2) THEN 28 : DO K=0,1 29 : DO I=1,3 30 : DO J=1,3 31 : P(I+3*K,J+3*K)=BPSS(I,J) 32 : ENDDO 33 : ENDDO 34 : ENDDO 35 : ENDIF 36 : C 37 : C Creation de la transposée de P 38 : C 39 : DO I=1,LRE 40 : DO J=1,LRE 41 : Pt(J,I)=P(I,J) 42 : ENDDO 43 : ENDDO 44 : C 45 : C REG = REL*P 46 : C 47 : DO I=1,LRE 48 : DO J=1,LRE 49 : DO K=1,LRE 50 : REG(I,J) = REG(I,J) + REL(I,K)*P(K,J) 51 : ENDDO 52 : ENDDO 53 : ENDDO 54 : C 55 : C REH = Pt*REG 56 : C 57 : DO I=1,LRE 58 : DO J=1,LRE 59 : DO K=1,LRE 60 : REH(I,J) = REH(I,J) + Pt(I,K)*REG(K,J) 61 : ENDDO 62 : ENDDO 63 : ENDDO 64 : * 64 : CALL ZERO(REL,LRE,LRE) 65 : C 66 : C REL = REG 67 : C 68 : DO I=1,LRE 69 : DO J=1,LRE 70 : REL(I,J)=REH(I,J) 71 : ENDDO 72 : ENDDO 73 : * 74 : RETURN 75 : END 76 : 77 : 78 :
© Cast3M 2003 - All rights reserved.
Disclaimer