      module mod_ena2
      contains
       subroutine enam(aa1,longc,idetc1,idetc2,longtp,jtp1,jtp2,
     *nsec,isec1,isec2,isgn)
      use module
      use mod_ena
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension isec1(nsec),isec2(nsec)
      dimension aa1(nsec)
      dimension idetc1(longc),idetc2(longc)
      dimension jtp1(longtp),jtp2(longtp)
      integer,intent(in),optional,dimension(longc) :: isgn
      integer,allocatable,dimension(:) :: jjtp1,jjtp2
!      integer,save :: imat(2048),jmat(2048),ijmat=0
!      real(4),save :: dmat(2048)
!      allocatable ktp1(:),ktp2(:)
      
      if(calcul=='M') then
         if(w)print*,'entree enam'
         if(w)print*,idebc(1),ifinc(1)
         if(w)print*,idebc(2),ifinc(2)
         if(w)print'(10i8)',idetc(idebc(1):ifinc(1))
         if(w)print'(a)','idetc1'
         if(w)print'(10i8)',idetc1
         if(w)print'(a)','idetc2'
         if(w)print'(10i8)',idetc2
         if(w)print'(a)','jtp1'
         if(w)print'(10i8)',jtp1
         if(w)print'(a)','jtp2'
         if(w)print'(10i8)',jtp2
         if(present(isgn)) then
            do i=1,longc
               do isec=1,nsec
                  aa2=aa1(isec)
                  do j=isec1(isec)+1,isec2(isec)
                     iadr1=idetc1(i)+jtp1(j)
                     iadr2=idetc2(i)+jtp2(j)
                     jjadr1=max(iadr1,iadr2)
                     jjadr2=min(iadr1,iadr2)
                     if(w1)print 1000,'elt_mat',jjadr1,jjadr2,
     *               iadr1,iadr2,aa2*isgn(i)
!                     if(jjadr1==41254.and.jjadr2==172) then
!                  print 1000,'elt_mat2',jjadr1,jjadr2,
!     *               iadr1,iadr2,aa2*isgn(i)
!                  stop
!               endif
 1000             format(a,4i6,f15.8)
                     ! remplissage du fichier mat
                     call ecrmat(iadr1,iadr2,aa2*isgn(i))
                  enddo
               enddo
            enddo
         else
            do i=1,longc
               do isec=1,nsec
                  aa2=aa1(isec)
                  do j=isec1(isec)+1,isec2(isec)
                     iadr1=idetc1(i)+jtp1(j)
                     iadr2=idetc2(i)+jtp2(j)
                     jjadr1=max(iadr1,iadr2)
                     jjadr2=min(iadr1,iadr2)
                     if(w1)print 1000,'elt_mat',jjadr1,jjadr2,
     *               iadr1,iadr2,aa2
!                     if(jjadr1==41254.and.jjadr2==172) then
!                  print 1000,'elt_mat3',jjadr1,jjadr2,
!     *               iadr1,iadr2,aa2
!                  stop
!               endif
                     ! remplissage du fichier mat
                     call ecrmat(iadr1,iadr2,aa2)
                  enddo
               enddo
            enddo
         endif
      else
         do isec=1,nsec
            jsec1=isec1(isec)+1
            jsec2=isec2(isec)
            if(itest(13)==3) 
     *      allocate(jjtp1(jsec1:jsec2),jjtp2(jsec1:jsec2))
            if(.not.present(isgn)) aa2=aa1(isec)
!            allocate(ktp1(jsec2-jsec1+1),ktp2(jsec2-jsec1+1))
            do i=1,longc
               if(present(isgn)) aa2=aa1(isec)*isgn(i)
               if(itest(14)==1) cycle
               if(itest(11)==2) then
                  call enar(idetc1(i)+jtp1(isec1(isec):isec2(isec)),
     *            idetc2(i)+jtp2(isec1(isec):isec2(isec)),
     *            isec2(isec)-isec1(isec)+1,aa2)
               else if(itest(11)==1) then
                  do j=isec1(isec)+1,isec2(isec)
                     iadr1=idetc1(i)+jtp1(j)
                     iadr2=idetc2(i)+jtp2(j)
                     ! Produit
                    ! v2(iadr2,:)=v2(iadr2,:)+aa2*v1(iadr1,:)
                    ! v2(iadr1,:)=v2(iadr1,:)+aa2*v1(iadr2,:)
                     call prodena0(aa2,iadr1,iadr2)
                  enddo
               else if(itest(11)==3) then
                  do iv=1,maxl0
                     !if(ycvl(iv)) cycle
                     jjtp1=idetc1(i)+jtp1(jsec1:jsec2)
                     jjtp2=idetc2(i)+jtp2(jsec1:jsec2)
                     v2(jjtp2,iv)=v2(jjtp2,iv)+aa2*v1(jjtp1,iv)
                     v2(jjtp1,iv)=v2(jjtp1,iv)+aa2*v1(jjtp2,iv)
                  enddo
               else
                  do iv=1,maxl0
                     !if(ycvl(iv)) cycle
!   Habillage a partir de ITERH
                      if(iter.ge.iterh.and.hab.ne.0.and.nhab==iv) then
!                      print*,'mod_ena2 : habillage'
!		        do kkk=1,longtp
                           do jjsec=jsec1,jsec2
                              delta(hab)=delta(hab)+vhab(idetc1(i)+
     *                        jtp1(jjsec))
     *                        *vhab(idetc2(i)+jtp2(jjsec))*aa2
                              if(mprinth(2)==1)
     *                        print'(a,3i4,2d26.15)','2hab,delta(hab)',
     *                        idetc1(i)+jtp1(jsec1:jsec2),
     *                        idetc2(i)+jtp2(jsec1:jsec2),hab,
     *                        vhab(idetc1(i)+
     *                        jtp1(jjsec))
     *                        ,delta(hab)
                           enddo
                           v2(idetc2(i)+jtp2(jsec1:jsec2),iv)=
     *                     v2(idetc2(i)+jtp2(jsec1:jsec2),iv)
     *                     +aa2*v1(idetc1(i)+jtp1(jsec1:jsec2),iv)
                           v2(idetc1(i)+jtp1(jsec1:jsec2),iv)=
     *                     v2(idetc1(i)+jtp1(jsec1:jsec2),iv)
     *                     +aa2*v1(idetc2(i)+jtp2(jsec1:jsec2),iv)
                           if(w6)print*,'i',i,jsec1,jsec2
                           if(w6)print*,'iadr2',idetc1(i)+jtp1(jsec1)
     *                     ,idetc2(i)+jtp2(jsec1),aa2
!                        enddo
                         else
!		        do kkk=1,longtp
                           v2(idetc2(i)+jtp2(jsec1:jsec2),iv)=
     *                     v2(idetc2(i)+jtp2(jsec1:jsec2),iv)
     *                     +aa2*v1(idetc1(i)+jtp1(jsec1:jsec2),iv)
                           v2(idetc1(i)+jtp1(jsec1:jsec2),iv)=
     *                     v2(idetc1(i)+jtp1(jsec1:jsec2),iv)
     *                     +aa2*v1(idetc2(i)+jtp2(jsec1:jsec2),iv)
                           if(w6)print*,'i',i,jsec1,jsec2
                           if(w6)print*,'iadr2',idetc1(i)+jtp1(jsec1)
     *                     ,idetc2(i)+jtp2(jsec1),aa2
!                        enddo
                     endif
                  enddo
               endif
            enddo
            if(itest(13)==3) deallocate(jjtp1,jjtp2)
         enddo
      endif
      return
      end subroutine
      end module

