Sources Esope | Cast3M

pouro2
C POURO2    SOURCE    PV        18/06/18    21:15:28     9860           
C POUROT    SOURCE    CASTEM    85/06/13    12:34:25
      SUBROUTINE POURO2(REL,LRE,P,RP)
C-----------------------------------------------------------------------
C  ROUTINE DE PASSAGE D UNE MATRICE ELEMENTAIRE DES AXES LOCAUX AUX AXES
C  GLOBAUX EN 2D
C  D APRES TEDEL
C
C  ENTREE
C         LRE    NOMBRE DE LIGNES DU TABLEAU REL
C         P      MATRICE DE PASSAGE
C         RP     MATRICE ELEMENTAIRE 12X12 EN AXES LOCAUX
C
C  SORTIE
C         REL    MATRICE ELEMENTAIRE EN AXES GLOBAUX
C
C     VIENT DE TEDEL AOUT 84
C
C     D'APRES POUROT  DC 98
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION REL(LRE,*),P(2,2),RP(6,6)
      DIMENSION NI(6),NJ(6)
      DATA ZER,UN/0.D0,1.0D0/
C
      DATA NI/1,1,1,4,4,4/
      DATA NJ/1,2,3,1,2,3/
       DO 10 K=1,6
       I3=NI(K)
       I4=I3+2
       LK=NJ(K)
       DO 11 L=K,6
        REL(K,L)=  0.D00
        I1=NI(L)
        I2=I1+2
        LL=NJ(L)
        LM=0
        DO 12 M=I3,I4
         LM=LM+1
         S=0.
         II=0
         DO 13 N=I1,I2
          II=II+1
C
          IF (II.EQ.3) THEN
           IF (LL.EQ.3) THEN
            XFACT1 =UN
           ELSE
            XFACT1 = ZER
           ENDIF
          ELSEIF (LL.EQ.3) THEN
           IF (II.EQ.3) THEN
            XFACT1 =UN
           ELSE
            XFACT1 = ZER
           ENDIF
          ELSE
           XFACT1 = P(II,LL)
         ENDIF
C
          IF (LM.EQ.3) THEN
           IF (LK.EQ.3) THEN
            XFACT2 =UN
           ELSE
            XFACT2 = ZER
           ENDIF
          ELSEIF (LK.EQ.3) THEN
           IF (LM.EQ.3) THEN
            XFACT2 =UN
           ELSE
            XFACT2 = ZER
           ENDIF
          ELSE
           XFACT2 = P(LM,LK)
          ENDIF
C
   13    S=S+  RP(M,N)*XFACT1
   12   REL(K,L)= REL(K,L)+ S*XFACT2
   11  REL(L,K)= REL(K,L)
   10 CONTINUE
      RETURN
      END