Sources Esope | Cast3M

chrep3
C CHREP3    SOURCE    CHAT      05/01/12    22:01:54     5004
      SUBROUTINE CHREP3(ENT,SOR,XMAT,TXR,NSTRS,ICLE,IND,KERRE)
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
      DIMENSION ENT(*),SOR(*),XMAT(*)
      DIMENSION ROTS(10,10),TXR(3,*)
      DIMENSION XLOC(3,3),XGLOB(3,3)
      PARAMETER(DEUX=2.D0)
 
C
C----------------------------------------------
C     CETTE ROUTINE PERMET DE CHANGER DE REPERE
C     UN CHAMP DE CONTRAINTE   (ICLE=1)
C     OU UN CHAMP DE DEFORMATION  (ICLE=2)
C     d'apres CHREP
C     CAS MASSIF 3D
C
C
C     EN PRATIQUE, IL FAUDRAIT PLUTOT APPELER
C     LES SOUS PROGRAMMES UTILISES DANS RTENS
C----------------------------------------------
C
        IF(ICLE.EQ.1) THEN
         FAC1=1.D0
         FAC2=2.D0
        ELSE
         FAC1=2.D0
         FAC2=1.D0
        ENDIF
*
        CALL ZERO(XGLOB,3,3)
        CALL ZERO(ROTS,10,10)
*
        XLOC(1,1)=XMAT(3)
        IF(IND.EQ.1) THEN
            XLOC(2,1)=XMAT(4)
            XLOC(1,2)=XMAT(6)
        ELSE
            XLOC(2,1)=-XMAT(4)
            XLOC(1,2)=-XMAT(6)
        ENDIF
        XLOC(3,1)=XMAT(5)
        XLOC(2,2)=XMAT(7)
        XLOC(3,2)=XMAT(8)
C
         CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
*
         DO 1045  K=1,3
          DO 1045 J=1,3
            DO 1045 I=1,3
               XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
 1045    CONTINUE
*
           DO 1050 IC=1,3
            DO 1050 IL=1,3
             ROTS(IL,IC)=XGLOB(IL,IC)*XGLOB(IL,IC)
 1050      CONTINUE
C
           DO 1060 IL=1,3
            ROTS(IL,4)=FAC2*XGLOB(IL,1)*XGLOB(IL,2)
            ROTS(IL,5)=FAC2*XGLOB(IL,2)*XGLOB(IL,3)
            ROTS(IL,6)=FAC2*XGLOB(IL,1)*XGLOB(IL,3)
 1060      CONTINUE
C
           DO 1065 IC=1,3
            ROTS(4,IC)=FAC1*XGLOB(1,IC)*XGLOB(2,IC)
            ROTS(5,IC)=FAC1*XGLOB(2,IC)*XGLOB(3,IC)
            ROTS(6,IC)=FAC1*XGLOB(1,IC)*XGLOB(3,IC)
 1065      CONTINUE
C
           DO 1070 IL=4,6
            IL1=IL-3
            IL2=IL1+1
            IF(IL2.GT.3)IL2=IL2-3
            DO 1070 IC=4,6
              IC1=IC-3
              IC2=IC1+1
              IF(IC2.GT.3)IC2=IC2-3
               ROTS(IL,IC)=XGLOB(IL1,IC1)*XGLOB(IL2,IC2)+
     .                       XGLOB(IL1,IC2)*XGLOB(IL2,IC1)
 1070      CONTINUE
            DO 1075 IC=1,6
              AA=ROTS(6,IC)
              ROTS(6,IC)=ROTS(5,IC)
              ROTS(5,IC)=AA
 1075       CONTINUE
            DO 1080 IL=1,6
              AA=ROTS(IL,6)
              ROTS(IL,6)=ROTS(IL,5)
              ROTS(IL,5)=AA
 1080       CONTINUE
*
*  CHGT D'AXES
*
             DO 1090 I=1,6
                SOR(I)=0.D0
                DO 1090 J=1,6
                  SOR(I)= SOR(I) +ROTS(I,J)*ENT(J)
 1090         CONTINUE
*
      RETURN
      END