C MAXTRA    SOURCE    AM        08/02/14    21:26:39     6050           
      SUBROUTINE MAXTRA(WRK0,WRK1,WRK5,WR12,WTRAV,IB,IGAU,NBGMAT,
     &   NELMAT,NPINT,NWA,NSTRS,NCHAIN,CMATE,MFR)
*
*      MODELE DE MAXWELL  : RECUPERATION DES INFORMATIONS
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
-INC CCHAMP
*
      SEGMENT WRK0
        REAL*8 XMAT(NCXMAT)
      ENDSEGMENT
*
      SEGMENT WRK1
        REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT
*
      SEGMENT WRK5
        REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
      ENDSEGMENT
*
      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 WTRAV
        REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
        REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
        REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
        REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM)
        REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
      ENDSEGMENT
*



      DIMENSION NWA(9),IPX(9),IPY(9)
        CHARACTER*8 CMATE
*
            ncxmat=xmat(/1)
             DO JC=1,9
               NWA(JC)=0
               IPX(JC)=0
               IPY(JC)=0
             END DO
*
******* Cas d'une formulation isotrope
      IF(CMATE.EQ.'ISOTROPE') THEN
*            em0
             MEVOLL=NINT(XMAT(3))
             SEGACT MEVOLL
             KEVOLL=IEVOLL(1)
             SEGACT KEVOLL
             MLREEL=IPROGX
             IPX(1)=IPROGX
             IPY(1)=IPROGY
             SEGACT MLREEL
             NWA(1)=PROG(/1)
             SEGDES KEVOLL*NOMOD
             SEGDES MEVOLL*NOMOD
*
*            em1 a em4
*
             KED=4
             DO JC=2,5
               MEVOLL=NINT(XMAT(KED))
               KED=KED+2
               SEGACT MEVOLL
               KEVOLL=IEVOLL(1)
               SEGACT KEVOLL
               MLREEL=IPROGX
               IPX(JC)=IPROGX
               IPY(JC)=IPROGY
               SEGACT MLREEL
               NWA(JC)=PROG(/1)
               SEGDES KEVOLL*NOMOD
               SEGDES MEVOLL*NOMOD
             END DO
*
             NCHAIN=5
             JED=0
             IF(IFOUR.EQ.-2) JED=1
             KED=14+JED
             DO JC=6,9
               MEVOLL=NINT(XMAT(KED))
               KED=KED+2
               IF(MEVOLL.GT.0) THEN
                 SEGACT MEVOLL
                 KEVOLL=IEVOLL(1)
                 SEGACT KEVOLL
                 MLREEL=IPROGX
                 IPX(JC)=IPROGX
                 IPY(JC)=IPROGY
                 SEGACT MLREEL
                 NWA(JC)=PROG(/1)
                 NCHAIN=NCHAIN+1
                 SEGDES KEVOLL*NOMOD
                 SEGDES MEVOLL*NOMOD
               ENDIF
             END DO
*
******* Cas d'une formulation unidirectionnelle
        ELSE IF(CMATE.EQ.'UNIDIREC') THEN 
*
             JED=0
             IF(IFOUR.EQ.2) JED=4

*            em0
             MEVOLL=NINT(XMAT(4+JED))
             SEGACT MEVOLL
             KEVOLL=IEVOLL(1)
             SEGACT KEVOLL
             MLREEL=IPROGX
             IPX(1)=IPROGX
             IPY(1)=IPROGY
             SEGACT MLREEL
             NWA(1)=PROG(/1)
             SEGDES KEVOLL*NOMOD
             SEGDES MEVOLL*NOMOD
*
*            em1 a em4
*
             KED=5+JED
             DO JC=2,5
               MEVOLL=NINT(XMAT(KED))
               KED=KED+2
               SEGACT MEVOLL
               KEVOLL=IEVOLL(1)
               SEGACT KEVOLL
               MLREEL=IPROGX
               IPX(JC)=IPROGX
               IPY(JC)=IPROGY
               SEGACT MLREEL
               NWA(JC)=PROG(/1)
               SEGDES KEVOLL*NOMOD
               SEGDES MEVOLL*NOMOD
             END DO
*
             NCHAIN=5
             JED=0
             IF(IFOUR.EQ.-2) JED=1
             IF(IFOUR.EQ. 2) JED=4
             KED=15+JED
             DO JC=6,9
               MEVOLL=NINT(XMAT(KED))
               KED=KED+2
               IF(MEVOLL.GT.0) THEN
                 SEGACT MEVOLL
                 KEVOLL=IEVOLL(1)
                 SEGACT KEVOLL
                 MLREEL=IPROGX
                 IPX(JC)=IPROGX
                 IPY(JC)=IPROGY
                 SEGACT MLREEL
                 NWA(JC)=PROG(/1)
                 NCHAIN=NCHAIN+1
                 SEGDES KEVOLL*NOMOD
                 SEGDES MEVOLL*NOMOD
               ENDIF
             END DO
        ENDIF
*
*     creation du segment de travail
*
             SEGINI WR12
*
*     recuperation des proprietes materielles
*     et des variables internes
*     D'abord les composantes obligatoires
*
             DO JC=1,5
               MLREEL=IPX(JC)
               MLREE1=IPY(JC)
               SEGACT MLREE1
             
               MLREE2=NINT(VAR0(JC+1))
               SEGACT MLREE2
               IF(JC.EQ.1) THEN
                 DO JD=1,NWA(1)
                   EM0(1,JD)=PROG(JD)
                   EM0(2,JD)=MLREE1.PROG(JD)
                 END DO
                 DO JD=1,NSTRS
                   SM0(JD)=MLREE2.PROG(JD)
                 END DO
               ELSE IF(JC.EQ.2) THEN
                 DO JD=1,NWA(2)
                   EM1(1,JD)=PROG(JD)
                   EM1(2,JD)=MLREE1.PROG(JD)
                 END DO
                 DO JD=1,NSTRS
                   SM1(JD)=MLREE2.PROG(JD)
                 END DO
               ELSE IF(JC.EQ.3) THEN
                 DO JD=1,NWA(3)
                   EM2(1,JD)=PROG(JD)
                   EM2(2,JD)=MLREE1.PROG(JD)
                 END DO
                 DO JD=1,NSTRS
                   SM2(JD)=MLREE2.PROG(JD)
                 END DO
               ELSE IF(JC.EQ.4) THEN
                 DO JD=1,NWA(4)
                   EM3(1,JD)=PROG(JD)
                   EM3(2,JD)=MLREE1.PROG(JD)
                 END DO
                 DO JD=1,NSTRS
                   SM3(JD)=MLREE2.PROG(JD)
                 END DO
               ELSE IF(JC.EQ.5) THEN
                 DO JD=1,NWA(5)
                   EM4(1,JD)=PROG(JD)
                   EM4(2,JD)=MLREE1.PROG(JD)
                 END DO
                 DO JD=1,NSTRS
                   SM4(JD)=MLREE2.PROG(JD)
                 END DO
               ENDIF
             END DO
*
*       traitement des composantes facultatives
*
             DO JC=6,9
               IF(IPX(JC).NE.0) THEN
                 MLREEL=IPX(JC)
                 MLREE1=IPY(JC)
                 SEGACT MLREE1
                 MLREE2=NINT(VAR0(JC+1))
                 SEGACT MLREE2
                 IF(JC.EQ.6) THEN
                   DO JD=1,NWA(6)
                     EM5(1,JD)=PROG(JD)
                     EM5(2,JD)=MLREE1.PROG(JD)
                   END DO
                   DO JD=1,NSTRS
                     SM5(JD)=MLREE2.PROG(JD)
                   END DO
                 ELSE IF(JC.EQ.7) THEN
                   DO JD=1,NWA(7)
                     EM6(1,JD)=PROG(JD)
                     EM6(2,JD)=MLREE1.PROG(JD)
                   END DO
                   DO JD=1,NSTRS
                     SM6(JD)=MLREE2.PROG(JD)
                   END DO
                ELSE IF(JC.EQ.8) THEN
                   DO JD=1,NWA(8)
                     EM7(1,JD)=PROG(JD)
                     EM7(2,JD)=MLREE1.PROG(JD)
                   END DO
                   DO JD=1,NSTRS
                     SM7(JD)=MLREE2.PROG(JD)
                   END DO
                 ELSE IF(JC.EQ.9) THEN
                   DO JD=1,NWA(9)
                     EM8(1,JD)=PROG(JD)
                     EM8(2,JD)=MLREE1.PROG(JD)
                   END DO
                   DO JD=1,NSTRS
                     SM8(JD)=MLREE2.PROG(JD)
                   END DO
                 ENDIF
               ENDIF
             END DO
*
*   ROTATION DES TENSEURS SI BESOIN
*
*
******* Cas d'une formulation unidirectionnelle
*

        IF(CMATE.EQ.'UNIDIREC') THEN


          IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
             CALL MAXROT(WTRAV,MFR,IB,IGAU,NBGMAT,NELMAT,NPINT)
             IF(IERR.NE.0) RETURN

             ICAS=1
             CALL MAXRO2(ICAS,WTRAV,WRK1,WRK5,WR12,NCHAIN)

          ELSE
             CALL ERREUR(251)
             RETURN
          ENDIF

        ENDIF

*
*      DESACTIVATION DES SEGMENTS PROG
*
            DO  10 JC=1,9
C# MC : la dimension est définie au départ = 9
              IF (IPX(JC).EQ.0) GO TO 10
               MLREEL=IPX(JC)
               SEGDES MLREEL*NOMOD
               MLREE1=IPY(JC)
               SEGDES MLREE1*NOMOD
               MLREE2=NINT(VAR0(JC+1))
               SEGDES MLREE2*NOMOD
  10        CONTINUE
*
      RETURN
      END