Sources Esope | Cast3M

asbglb
C ASBGLB    SOURCE    CHAT      07/10/22    21:15:05     5921
       SUBROUTINE ASBGLB(BGLOB,B,P)
       IMPLICIT REAL*8(A-H,O-Z)
       IMPLICIT INTEGER (I-N)
 
*      SUBROUTINE ASSE_BGLOB(BGLOB,B,P)
C ANTOINE LEGAY LE 30/01/2001
C TRANSFORME B(6,24) DANS LOCAL EN BGLOB(6,24) DANS GLOBAL
C AVEC P(3,3) MATRICE DE PASSAGE
*      REAL*8  BGLOB(6,24),B(3,8),P(3,3),BTMP(6,24)
*      INTEGER J
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      dimension  BGLOB(6,24),B(3,8),P(3,3),BTMP(6,24)
      CALL ZDANUL(BGLOB,144)
      CALL ZDANUL(BTMP,144)
C PREMIERE LIGNE:
      DO J=1,8
C "MULTIPLICATION AVEC X" ---> UNE PARTIE DE EPS11
          BTMP(1,J)=B(1,J)*P(1,1)*P(1,1)
     !             +B(2,J)*P(1,1)*P(2,1)
     !             +B(3,J)*P(3,1)*P(1,1)
      END DO
      DO J=9,16
C "MULTIPLICATION AVEC Y" ---> UNE PARTIE DE EPS11
          BTMP(1,J)=P(2,1)*B(1,J-8)*P(1,1)
     !             +P(2,1)*B(2,J-8)*P(2,1)
     !             +P(2,1)*B(3,J-8)*P(3,1)
      END DO
      DO J=17,24
C "MULTIPLICATION AVEC Z" ---> UNE PARTIE DE EPS11
          BTMP(1,J)=P(3,1)*B(1,J-16)*P(1,1)
     !             +P(3,1)*B(2,J-16)*P(2,1)
     !             +P(3,1)*B(3,J-16)*P(3,1)
      END DO
C 2IEME LIGNE:
      DO J=1,8
C "MULTIPLICATION AVEC X" ---> UNE PARTIE DE EPS22
          BTMP(2,J)=P(1,2)*B(1,J)*P(1,2)
     !             +P(1,2)*B(2,J)*P(2,2)
     !             +P(1,2)*B(3,J)*P(3,2)
      END DO
      DO J=9,16
C "MULTIPLICATION AVEC Y" ---> UNE PARTIE DE EPS22
          BTMP(2,J)=P(2,2)*B(1,J-8)*P(1,2)
     !             +P(2,2)*B(2,J-8)*P(2,2)
     !             +P(2,2)*B(3,J-8)*P(3,2)
      END DO
      DO J=17,24
C "MULTIPLICATION AVEC Z" ---> UNE PARTIE DE EPS22
          BTMP(2,J)=P(3,2)*B(1,J-16)*P(1,2)
     !             +P(3,2)*B(2,J-16)*P(2,2)
     !             +P(3,2)*B(3,J-16)*P(3,2)
      END DO
C 3IEME LIGNE:
      DO J=1,8
C "MULTIPLICATION AVEC X" ---> UNE PARTIE DE EPS33
          BTMP(3,J)=P(1,3)*B(1,J)*P(1,3)
     !             +P(1,3)*B(2,J)*P(2,3)
     !             +P(1,3)*B(3,J)*P(3,3)
      END DO
      DO J=9,16
C "MULTIPLICATION AVEC Y" ---> UNE PARTIE DE EPS33
          BTMP(3,J)=P(2,3)*B(1,J-8)*P(1,3)
     !             +P(2,3)*B(2,J-8)*P(2,3)
     !             +P(2,3)*B(3,J-8)*P(3,3)
      END DO
      DO J=17,24
C "MULTIPLICATION AVEC Z" ---> UNE PARTIE DE EPS33
          BTMP(3,J)=P(3,3)*B(1,J-16)*P(1,3)
     !             +P(3,3)*B(2,J-16)*P(2,3)
     !             +P(3,3)*B(3,J-16)*P(3,3)
      END DO
C 4IEME LIGNE:
      DO J=1,8
C "MULTIPLICATION AVEC X" ---> UNE PARTIE DE EPS12
          BTMP(4,J)=B(1,J)*P(1,1)*P(1,2)*2.
     !             +B(2,J)*P(1,2)*P(2,1)
     !             +B(2,J)*P(1,1)*P(2,2)
     !             +B(3,J)*P(1,2)*P(3,1)
     !             +B(3,J)*P(1,1)*P(3,2)
      END DO
      DO J=9,16
C "MULTIPLICATION AVEC Y" ---> UNE PARTIE DE EPS12
          BTMP(4,J)=B(1,J-8)*P(1,2)*P(2,1)
     !             +B(1,J-8)*P(1,1)*P(2,2)
     !             +B(2,J-8)*P(2,1)*P(2,2)*2.
     !             +B(3,J-8)*P(2,2)*P(3,1)
     !             +B(3,J-8)*P(2,1)*P(3,2)
      END DO
      DO J=17,24
C "MULTIPLICATION AVEC Z" ---> UNE PARTIE DE EPS12
          BTMP(4,J)=B(1,J-16)*P(1,2)*P(3,1)
     !             +B(2,J-16)*P(2,2)*P(3,1)
     !             +B(1,J-16)*P(1,1)*P(3,2)
     !             +B(2,J-16)*P(2,1)*P(3,2)
     !             +B(3,J-16)*P(3,1)*P(3,2)*2.
      END DO
C 5IEME LIGNE:
      DO J=1,8
C "MULTIPLICATION AVEC X" ---> UNE PARTIE DE EPS23
          BTMP(5,J)=B(1,J)*P(1,2)*P(1,3)*2.
     !             +B(2,J)*P(1,3)*P(2,2)
     !             +B(2,J)*P(1,2)*P(2,3)
     !             +B(3,J)*P(1,3)*P(3,2)
     !             +B(3,J)*P(1,2)*P(3,3)
      END DO
      DO J=9,16
C "MULTIPLICATION AVEC Y" ---> UNE PARTIE DE EPS23
          BTMP(5,J)=B(1,J-8)*P(1,3)*P(2,2)
     !             +B(1,J-8)*P(1,2)*P(2,3)
     !             +B(2,J-8)*P(2,2)*P(2,3)*2.
     !             +B(3,J-8)*P(2,3)*P(3,2)
     !             +B(3,J-8)*P(2,2)*P(3,3)
      END DO
      DO J=17,24
C "MULTIPLICATION AVEC Z" ---> UNE PARTIE DE EPS23
          BTMP(5,J)=B(1,J-16)*P(1,3)*P(3,2)
     !             +B(2,J-16)*P(2,3)*P(3,2)
     !             +B(1,J-16)*P(1,2)*P(3,3)
     !             +B(2,J-16)*P(2,2)*P(3,3)
     !             +B(3,J-16)*P(3,2)*P(3,3)*2.
      END DO
C 6IEME LIGNE:
      DO J=1,8
C "MULTIPLICATION AVEC X" ---> UNE PARTIE DE EPS13
          BTMP(6,J)=B(1,J)*P(1,1)*P(1,3)*2
     !             +B(2,J)*P(1,3)*P(2,1)
     !             +B(2,J)*P(1,1)*P(2,3)
     !             +B(3,J)*P(1,3)*P(3,1)
     !             +B(3,J)*P(1,1)*P(3,3)
      END DO
      DO J=9,16
C "MULTIPLICATION AVEC Y" ---> UNE PARTIE DE EPS13
          BTMP(6,J)=B(1,J-8)*P(1,3)*P(2,1)
     !             +B(1,J-8)*P(1,1)*P(2,3)
     !             +B(2,J-8)*P(2,1)*P(2,3)*2.
     !             +B(3,J-8)*P(2,3)*P(3,1)
     !             +B(3,J-8)*P(2,1)*P(3,3)
      END DO
      DO J=17,24
C "MULTIPLICATION AVEC Z" ---> UNE PARTIE DE EPS13
          BTMP(6,J)=B(1,J-16)*P(1,3)*P(3,1)
     !             +B(2,J-16)*P(2,3)*P(3,1)
     !             +B(1,J-16)*P(1,1)*P(3,3)
     !             +B(2,J-16)*P(2,1)*P(3,3)
     !             +B(3,J-16)*P(3,1)*P(3,3)*2.
      END DO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DO J=1,24
         DO I=1,6
            BGLOB(I,J)=BTMP(I,J)
         END DO
      END DO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      RETURN
      END