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