C AMPL3D    SOURCE    PV090527  23/01/27    21:15:05     11574          
       subroutine ampl3d(souplesse66,sigm06,fshr06,skdw,alphaw,
     # epse6,sigef06,epse_tild6,sref)
      
c      concentration des contraintes de compression du a lendommagement
c      hydrique pour le calcul du potentiel de fluage,
c      en l etat ces endommagements sont reversibles

c      tables de dimension fixe pour resolution des sytemes lineaires 
       implicit real*8 (a-h,o-z)
       implicit integer (i-n)
       
       real*8 souplesse66(6,6),skdw,alphaw,sref
       real*8 sigm06(6),fshr06(6),epse6(6),ampli6(6),sigef06(6)
       real*8 epse_tild6(6)
       
       real*8 sige3(3),vsige33(3,3),vsige33t(3,3),
     # siget6(6),sigec6(6),sigec3(3),siget3(3)
     
       real*8 dwt3(3),dwc3(3),dmaxi,sigft61(6),sigfc61(6)
       real*8 coeff,petit
       parameter(petit=1.0d-6,dmaxi=1.d0-petit)
       logical endor
       integer i,j,k,l
       real*8 xx1
       real*8 fshr33(3,3),fshr3(3),vfshr33(3,3),vfshr33t(3,3)
       real*8 sigec6p(6),sigm16(6),sigm133(3,3),sigm13(3)
       real*8 vsigm133(3,3), vsigm133t(3,3),sigm16p(6)
       real*8 epse_tilde6(6),sigef6p(6),sigefa6p(6),sigefa6(6),dcws
       real*8 alphaw_p
       
c      *****************************************************************
c      decomposition du tenseur des contraintes apparentes
       call prtt3d(sigm06,sige3,vsige33,vsige33t,
     # siget6,sigec6,sigec3,siget3)       
         
c      *****************************************************************
c      endommagement du a la pression capillaire
c      rangement des contraintes effectives en tableau 3*3
       call x6x33(fshr06,fshr33)
c      diagonalisation contraintes effectives actuelles 
c      et valeurs propres par la methode de jacobi
       call b3_v33(fshr33,fshr3,vfshr33)
c      creation de la matrice de passage inverse    
       call traps1(vfshr33t,vfshr33,3)       
c      calcul des endommagements hydriques de traction
       endor=.false.
       alphaw_p=alphaw
       if ((skdw.gt.0.).and.(alphaw_p.gt.0.)) then
        do i=1,3
         xx1=fshr3(i)
         if(xx1.gt.0.d0) then
            endor=.true.
         else
            xx1=0.d0
         end if
c        endo de rgi et borne de dgt         
         dwt3(i)=min(dmaxi,max((xx1/(xx1+skdw)),0.d0))
c        print*,'ds endort dwt3(',i,')',dwt3(i)
        end do
        if(endor) then      
c         calcul des endommagements hydriques de compression 
          do i=1,3   
c         complementarite par orthogonalite      
             call indce1(i,k,l)
             dwc3(i)=1.d0-((1.d0-dwt3(k))*(1.d0-dwt3(l)))**alphaw_p
             dwc3(i)=min(dmaxi,dwc3(i))
c             print*,'dwc3(',i,')',dwc3(i)
          end do
        else
          do i=1,3
             dwc3(i)=0.d0
          end do
        end if
       else
          do i=1,3
             dwc3(i)=0.d0
          end do 
       end if 

c      *****************************************************************  
c      amplification seulement dans les directions des contraintes
c      de compression macroscopiques

c      passage des contraintes de compression en base prin des endo-w
       if(endor) then
         call chrep6(sigec6,vfshr33,.false.,sigec6p)
         call chrep6(sigef06,vfshr33,.false.,sigef6p)
         do i=1,6
          if(i.le.3) then
            if(sigec6p(i).lt.(-sref)) then
                 sigefa6p(i)=sigef6p(i)/(1.d0-dwc3(i))
            else
                 coeff=-sigec6p(i)/sref
                 if(coeff.gt.0.d0) then
                     sigefa6p(i)=sigef6p(i)/(1.d0-coeff*dwc3(i))
                 else
                     sigefa6p(i)=sigef6p(i)
                 end if
            end if
          else
            call indce0(i,k,l)
            dcws=0.d0 
c           la resistance au cisaillement depend de l etat de refermeture            
            if(sigec6p(k).lt.(-sref)) then
                 dcws=max(dcws,dwc3(k))
            else
                 coeff=-sigec6p(k)/sref  
                 if(coeff.gt.0.d0) then
                     dcws=max(dcws,coeff*dwc3(k))
                 end if
            end if
c           prise en compte etat de refermeture            
            if(sigec6p(l).lt.(-sref)) then
                 dcws=max(dcws,dwc3(l))
            else
                 coeff=-sigec6p(l)/sref            
                 if(coeff.gt.0.d0) then
                     dcws=max(dcws,coeff*dwc3(l))
                 end if
            end if 
c           la fissure la moins fermee controle le cosaillement            
            sigefa6p(i)=sigef6p(i)/(1.d0-dcws)
          end if 
         end do
c        retour en base fixe
         call chrep6(sigefa6p,vfshr33t,.false.,sigefa6) 
c        deformations effective elastiques amplifiee
         do i=1,6
             epse_tild6(i)=0.d0
             do j=1,6
               epse_tild6(i)=epse_tild6(i)+souplesse66(i,j)*sigefa6(j)
             end do
         end do         
       else       
c        si pas d endo hydrique, pas d apmlification       
         do i=1,6
             epse_tild6(i)=epse6(i)
         end do         
       end if
c       do i=1,6
c          ampli6(i)=1.d0
c         print*,'ampli',i,'=',ampli6(i)
c       end do
c      *****************************************************************       
       return
       end