Sources Esope | Cast3M

rempth
C REMPTH    SOURCE    CHAT      08/10/02    21:15:46     6168
      SUBROUTINE REMPTH
     &  (REL1,REL2,REL3,REL4,REL5,REL6,REL7,REL8,
     &  REL9,RE10,RE11,RE12,LRE,RE)
C====================================================================
C
C     TRANSVASE REL (LRE,LRE) MATRICE DE RIGIDITE TRIANGULAIRE
C     INFERIEURE DANS RE(lre,lre) STOCKE LIGNE PAR LIGNE
C
C====================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION REL1(LRE,LRE),REL2(LRE,LRE),REL3(LRE,LRE),REL4(LRE,LRE)
      DIMENSION REL5(LRE,LRE),REL6(LRE,LRE),REL7(LRE,LRE),REL8(LRE,LRE)
      DIMENSION REL9(LRE,LRE),RE10(LRE,LRE),RE11(LRE,LRE),RE12(LRE,LRE)
      DIMENSION RE(3*LRE,3*LRE)
C
      DO 100 IA=1,LRE
      DO 100 IB=1,LRE
      RE(IA,IB)=REL1(IA,IB)
 100  CONTINUE
 
      DO 200 IA=LRE+1,2*LRE
      DO 200 IB=1,LRE
      RE(IA,IB)=REL4(IA-LRE,IB)
 200  CONTINUE
 
      DO 300 IA=(2*LRE)+1,3*LRE
      DO 300 IB=1,LRE
      RE(IA,IB)=REL7(IA-2*LRE,IB) +RE10(IA-2*LRE,IB)
 300  CONTINUE
 
      DO 400 IA=1,LRE
      DO 400 IB=LRE+1,2*LRE
      RE(IA,IB)=REL2(IA,IB-LRE)
 400  CONTINUE
 
      DO 500 IA=LRE+1,2*LRE
      DO 500 IB=LRE+1,2*LRE
      RE(IA,IB)=REL5(IA-LRE,IB-LRE)
 500  CONTINUE
 
      DO 600 IA=(2*LRE)+1,3*LRE
      DO 600 IB=LRE+1,2*LRE
      RE(IA,IB)=REL8(IA-2*LRE,IB-LRE)+RE11(IA-2*LRE,IB-LRE)
 600  CONTINUE
 
      DO 700 IA=1,LRE
      DO 700 IB=2*LRE+1,3*LRE
      RE(IA,IB)=REL3(IA,IB-2*LRE)
 700  CONTINUE
 
      DO 800 IA=LRE+1,2*LRE
      DO 800 IB=2*LRE+1,3*LRE
      RE(IA,IB)=REL6(IA-LRE,IB-2*LRE)
 800  CONTINUE
 
      DO 900 IA=(2*LRE)+1,3*LRE
      DO 900 IB=2*LRE+1,3*LRE
      RE(IA,IB)=REL9(IA-2*LRE,IB-2*LRE)+RE12(IA-2*LRE,IB-2*LRE)
 900  CONTINUE
 
      RETURN
      END