C ADTUY     SOURCE    CHAT      12/06/07    21:15:00     7389           
      SUBROUTINE adtuy (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NMATR,
     &                   IPMATR,NLIGR)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMCHAML
-INC SMCOORD
-INC SMELEME
-INC SMINTE
-INC SMRIGID

      SEGMENT MPTVAL
        INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT

      SEGMENT,MMAT1
        REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
        REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN)
C*      REAL*8 FORME(NBNN),V77(NBNN),V22(IDIM) <- A verifier pour V22
        REAL*8 FORME(NBNN),V77(NBNN),V22(NDIM)
        REAL*8 CMAT(NDIM,NDIM),CMAT1(IDIM,IDIM),CMAT2(IDIM,IDIM)
      ENDSEGMENT
      
C  1 - INITIALISATIONS ET VERIFICATIONS
C ======================================
      MELEME = IPMAIL
c*      SEGACT,MELEME
      NBNN   = NUM(/1)
      NBELEM = NUM(/2)
C =====
      MINTE = IPINTE
c*      SEGACT,MINTE
      NBPGAU = POIGAU(/1)

C =====
      MPTVAL = IVAMAT
c*      SEGACT,MPTVAL
C =====
      XMATRI = IPMATR

C =====
C Initialisation des segments de travail
C =====
      IF (IFOMOD.EQ.1) THEN
         NDIM = 3
      ELSE
         NDIM = IDIM
      ENDIF
      segini mmat1
C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
C ============================================================
      DO IEL = 1, NBELEM
*
* MISE A ZERO DU TABLEAU CEL
*
        CALL ZERO(CEL,NBNN,NBNN)
*
* COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL
*
        CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
*
* 
        if(nef.eq.269) then
          DO i = 1, NMATR
c*          IF (IVAL(i).NE.0) THEN
              MELVAL = IVAL(i)
              ibmn = MIN(iel ,VELCHE(/2))
              igmn = 1
              V22(i) = VELCHE(igmn,ibmn)
c*          ELSE
c*            VALMAT(i) = 0.
c*          ENDIF
          ENDDO   
          rhosv=v22(1)*v22(2)*v22(3)*v22(4)
          cel(1,1)=-0.5d0*rhosv
          cel(1,2)=0.5d0*rhosv
          cel(2,1)=  cel(1,1) 
          cel(2,2)=  cel(1,2)     
        elseif( nef.eq.270) then                             
          IFOIS = 0      
          DO IGAU = 1, NBPGAU      
c  calcul de la longueur ou du jacobien  
*            dx= shptot(2,1,igau)*xe(1,1)+shptot(2,2,igau)*xe(1,2)
*     $      + shptot(2,3,igau)*xe(1,3)
*            dy= shptot(2,1,igau)*xe(2,1)+shptot(2,2,igau)*xe(2,2)
*     $      + shptot(2,3,igau)*xe(2,3) 
*            dl2= dx*dx + dy * dy    
*            if(idim.eq.3) then
*              dz= shptot(2,1,igau)*xe(3,1)+shptot(2,2,igau)*xe(3,2)
*     $        + shptot(2,3,igau)*xe(3,3)
*              dl2=dl2+ dz*dz
*            endif
*           djac= sqrt ( dl2)
       
*
*- Recuperation de rho cp et section en un point de la barre
*- NB : ces composantes sont obligatoires donc IVAL(i) n'est pas nul !
            DO i = 1, NMATR
c*          IF (IVAL(i).NE.0) THEN
              MELVAL = IVAL(i)
              ibmn = MIN(iel ,VELCHE(/2))
              igmn = MIN(igau,VELCHE(/1))
              V22(i) = VELCHE(igmn,ibmn)
            ENDDO  
             rhsvs= v22(1)*v22(2)*v22(3)*v22(4)       
            rhosv= rhsvs*poigau(igau)
            do i=1,nbnn
*              do j=1,idim
                cz=  shptot(1,i,igau)* rhosv
                
*              enddo
              do j=1,nbnn
                cel(i,j)=cel(i,j) +cz*shptot(2,j,igau)
              enddo
            enddo
          ENDDO
        endif
*        write(6,*) ' cel(1,)', ( cel(1,jou),jou=1,nbnn)
*        write(6,*) ' cel(2,)', ( cel(2,jou),jou=1,nbnn)  
*        if(nbnn.eq.3)write(6,*) ' cel(3,)', ( cel(3,jou),jou=1,nbnn)            
        call rempms(cel,nbnn,re(1,1,iel))
      enddo       
      SEGSUP,MMAT1 
      return
      end