C CMAXR2 SOURCE KICH 09/09/11 21:16:18 6505 SUBROUTINE CMAXR2(wrk52,wrk53,wrk54,ICAS,WR12,NCHAIN) C MAXRO2 SOURCE AM 00/12/13 21:38:11 4045 * SUBROUTINE MAXRO2(ICAS,WTRAV,WRK1,WRK5,WR12,NCHAIN) * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC CCOPTIO -INC SMEVOLL -INC SMLREEL -INC CCHAMP -INC DECHE * SEGMENT WR12 REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) REAL*8 SM8(NSTRS) ENDSEGMENT * SEGMENT WTRA2 REAL*8 A(NDIM,NDIM) REAL*8 RR(NDIM,NDIM),RT(NDIM,NDIM),RTRA(NDIM,NDIM) ENDSEGMENT * IDIM=XGLOB(/1) NDIM=IDIM IF(IFOUR.EQ.1) NDIM=IDIM+1 NSTRS=SIG0(/1) SEGINI WTRA2 * ICAS = 1 : RT A R * ICAS = 2 : R A RT DO I=1,IDIM DO J=1,IDIM RR(I,J)=XGLOB(I,J) ENDDO ENDDO IF(IDIM.EQ.2.AND.IFOUR.EQ.1) RR(3,3)=1.D0 CALL TRSPOD(RR,NDIM,NDIM,RT) * * ROTATION DES TENSEURS * IDEFO=0 CALL MAXRO3(ICAS,IDEFO,SM0,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) CALL MAXRO3(ICAS,IDEFO,SM1,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) CALL MAXRO3(ICAS,IDEFO,SM2,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) CALL MAXRO3(ICAS,IDEFO,SM3,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) CALL MAXRO3(ICAS,IDEFO,SM4,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) IF(NCHAIN.GE.6) THEN CALL MAXRO3(ICAS,IDEFO,SM5,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) ENDIF IF(NCHAIN.GE.7) THEN CALL MAXRO3(ICAS,IDEFO,SM6,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) ENDIF IF(NCHAIN.GE.8) THEN CALL MAXRO3(ICAS,IDEFO,SM7,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) ENDIF IF(NCHAIN.GE.9) THEN CALL MAXRO3(ICAS,IDEFO,SM8,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) ENDIF IF(ICAS.EQ.1) THEN CALL MAXRO3(ICAS,IDEFO,SIG0,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) IDEFO=1 CALL MAXRO3(ICAS,IDEFO,DEPST,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) CALL MAXRO3(ICAS,IDEFO,EPIN0,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) * ELSE IF(ICAS.EQ.2) THEN CALL MAXRO3(ICAS,IDEFO,SIGF,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) IDEFO=1 CALL MAXRO3(ICAS,IDEFO,DEFP ,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) CALL MAXRO3(ICAS,IDEFO,EPINF,A,RR,RT,RTRA,NDIM,IDIM,IFOUR) ENDIF SEGSUP WTRA2 RETURN END