      module mod_mula
      integer,save :: xc,yc,zc,tc
      common/com_nntp/nntp(0:100)
      contains
       subroutine mula0(x,y,z,t)
      integer x,y,z,t
      xc=x
      yc=y
      zc=z
      tc=t
      return
      end subroutine
       subroutine mula(aa3,integr,elmat,n,nelem,isgn0,
     *c1,c2,c3,c4,c5,c6)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!             Cas des integrales avec orbitale(s) active(s)
! en entree : 
!   - elmat=elements de matrice types
!     ex elmat(1:3)=(/'      -> b+    |       -> A+ b+',
!                     '      -> b+    |       -> b+ A+',
!                     '      -> b+    |       -> b+=A+'/)
!     elmat est donne sans l'info des spins (que des "+")
!   - c1,c2,c3,c4,c5,c6 donnees "optional"=liste des orbitales de elmat
!     a mettre a "-"
!     ex : c1='A-'  ==>   on transforme les A+ en A- dans elmat
!   - integr ex: '-+-v'=type de l'integrale. Ici CCCv, avec spins -+-
!     sur les CCC (v. mul_intc)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      use module
      use mod_ena
      use mod_ena2
      use mod_itp
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character(31) elmat(nelem),el,el1
      character(4) integr
      character(2),dimension(6) :: modif
      dimension aal(27),isec1(27),isec2(27)
      character(2),intent(in),optional :: c1,c2,c3,c4,c5,c6
      integer,intent(in) :: isgn0
      double precision,intent(in) :: aa3
      dimension mm(6)
      common/com_nntp/nntp(0:100)

      if(w)print*,'MULA'
      ! test a supprimer
      if(abs(isgn0)/=1) stop'mula isgn0'
      itest(24)=1
      if(itest(2)==1) return
      !
      ! liste des spins a passer de + a -
      !
! on stocke dans modif la liste des + a changer en - dans el
      m=0
      mm=1
      if(present(c1)) then
         m=1
         modif(1)=c1
      endif
      if(present(c2)) then
         m=2
         modif(2)=c2
      endif
      if(present(c3)) then
         m=3
         modif(3)=c3
      endif
      if(present(c4)) then
         m=4
         modif(4)=c4
      endif
      if(present(c5)) then
         m=5
         modif(5)=c5
      endif
      if(present(c6)) then
         m=6
         modif(6)=c6
      endif
      if(itest(15)==1) return
!     mm(k)==1 si on a une majuscule, c-a-d un indice de l'integrale
!     dans ce cas, l'indice va apparaitre 2 fois dans la ligne de el
      do k=1,m
         if(ichar(modif(k)(1:1))>95) mm(k)=2
      enddo
      !print*,'m',m
      if(w)print'(a9,6a3)','modif    ',modif(1:m)
!+ I+ -> d+ A- | j+    -> d+ B-
      !
      ! occupation de la partie CAS
      !
      inda1=0
      indb1=0
      inda2=0
      indb2=0
!
! Transformation de elmat (mis dans el1)
!
      if(yiil1lent) then
         el1=elmat(1)
         do l=1,m
            do k=1,mm(l)
               ind=index(el1,modif(l)(1:1)//'+')
               if(ind/=0) then
                  el1(ind:ind+1)=modif(l)
               else
                  exit
               endif
            enddo
         enddo
      else
         if(yiil1(niil1)) then
            el1=elmat(1)
            do l=1,m
               do k=1,mm(l)
                  ind=index(el1,modif(l)(1:1)//'+')
                  if(ind/=0) then
                     el1(ind:ind+1)=modif(l)
                  else
                     exit
                  endif
               enddo
            enddo
            el1iil1(iil1)=el1
            iil1=iil1+1
           ! print*,'premier passage',iil1
           ! print*,'premier passage',el1
           ! print*,'premier passage',el1iil1(iil1)
         else
            el1=el1iil1(iil1)
            iil1=iil1+1
           ! print*,'autre passage',iil1
           ! print*,'autre passage',el1
           ! print*,'autre passage',el1iil1(iil1)
         endif
      endif
!
! Nb d'alpha et de beta dans les 2 det CAS
!
      if(itest(16)==1) return
      if(w)print*,'premiere interaction, supposee de signe + ',el1
        if(el1(2:2)=='+') inda1=inda1+1
        if(el1(5:5)=='+') inda1=inda1+1
      if(el1(11:11)=='+') inda1=inda1-1
      if(el1(14:14)=='+') inda1=inda1-1
      if(el1(19:19)=='+') inda2=inda2+1
      if(el1(22:22)=='+') inda2=inda2+1
      if(el1(28:28)=='+') inda2=inda2-1
      if(el1(31:31)=='+') inda2=inda2-1
        if(el1(2:2)=='-') indb1=indb1+1
        if(el1(5:5)=='-') indb1=indb1+1
      if(el1(11:11)=='-') indb1=indb1-1
      if(el1(14:14)=='-') indb1=indb1-1
      if(el1(19:19)=='-') indb2=indb2+1
      if(el1(22:22)=='-') indb2=indb2+1
      if(el1(28:28)=='-') indb2=indb2-1
      if(el1(31:31)=='-') indb2=indb2-1
! On en deduit la la classe CAS de chaque det
      iclc1=iclasc(inda1,indb1)
      iclc2=iclasc(inda2,indb2)
      if(w)print'(a,2i3,a)','iclc1(',inda1,indb1,')'
      if(w)print'(a,2i3,a)','iclc2(',inda2,indb2,')'
      if(iclc1==0.or.iclc2==0) return
      !
      ! allocations
      !
      llongc1=ifinc(iclc1)-idebc(iclc1)+1
      llongc2=ifinc(iclc2)-idebc(iclc2)+1
      !
      ! Partie CAS
      !
      if(itest(3)==1) return
      call mul_intc(integr,iclc1,iclc2,longc,mdetc1,mdetc2,msgnc,
     *llongc1,llongc2,xc,yc,zc,tc)
      if(itest(4)==1) return
      if(w)print'(a,20i3)','msgnc',msgnc(1:longc)
      if(longc==0) return
      !
      ! Boucle sur des elements de matrice
      !
      msec=1
      jsgn=0
      isec1(1)=0
      jsec=0
      if(w)print*,'aa3,isgn0',aa3,isgn0
      aal(1)=aa3*isgn0
      n1=0
      n2=0
      n3=0
      y=.true.
      if(w)print*,'nntp',nntp(1:nelem)
      do k=1,nelem
         if(yiil1lent) then
            ! Elimination des situations d'espace vides
            if(nntp(k)==nntp(k-1)) cycle
            el=elmat(k)
            n2v=n2
            n2=n2+nntp(k)-nntp(k-1)
            if(w)print*,'n2v,n2',n2v,n2,nntp(k),nntp(k-1)
            if(itest(18)==1) cycle
            do l=1,m
               !
               ! modification des spins de l'element de matrice
               !
               do kk=1,mm(l)
                  ind=index(el,modif(l)(1:1)//'+')+1
                  el(ind:ind)='-'
               enddo
            enddo
         else
            n2v=n2
            n2=n2+nntp(k)-nntp(k-1)
            if(w)print*,'n2v,n2',n2v,n2,nntp(k),nntp(k-1)
            if(yiil1(niil1)) then
               el=elmat(k)
               if(itest(18)==1) cycle
               do l=1,m
                  !
                  ! modification des spins de l'element de matrice
                  !
                  do kk=1,mm(l)
                     ind=index(el,modif(l)(1:1)//'+')+1
                     el(ind:ind)='-'
                  enddo
               enddo
               el1iil1(iil1)=el
               iil1=iil1+1
            else
               el=el1iil1(iil1)
               iil1=iil1+1
            endif
            if(nntp(k)==nntp(k-1)) cycle
         endif
         if(itest(17)==1) cycle
         if(w)print*,'Mula  element de matrice',k,'    ',el
         !
         ! elimination des violations Pauli
         !
         yeq1=el(2:2)==el(5:5).and.el(2:2)/=' '
         yeq2=el(11:11)==el(14:14).and.el(11:11)/=' '
         yeq3=el(19:19)==el(22:22).and.el(19:19)/=' '
         yeq4=el(28:28)==el(31:31).and.el(28:28)/=' '
         !print*,'yeq1,yeq2,yeq3,yeq4',yeq1,yeq2,yeq3,yeq4
         if(el(3:3)=='='.and.yeq1) cycle
         if(el(12:12)=='='.and.yeq2) cycle
         if(el(20:20)=='='.and.yeq3) cycle
         if(el(29:29)=='='.and.yeq4) cycle
         n1=n1+1
         n3=n3+nntp(k)-nntp(k-1)
         kk=k
         if(w)print*,'n1,n2v,n2',n1,n2v,n2
         !
         ! signe - si on echange 2 electrons de meme spin
         !
         jsgnv=jsgn
         jsgn=isgn0
!+ I+ -> d+ A- | j+    -> d+ B-
         if(el1(1:1)/=el(1:1).and.yeq1) jsgn=-jsgn
         if(el1(10:10)/=el(10:10).and.yeq2) jsgn=-jsgn
         if(el1(18:18)/=el(18:18).and.yeq3) jsgn=-jsgn
         if(el1(27:27)/=el(27:27).and.yeq4) jsgn=-jsgn
         !
         ! On regroupe les signes
         !
         isec1(msec)=n2v
         isec2(msec)=n2
         aal(msec)=aa3*jsgn
         if(w)print'(a,27i5)','isec1',isec1(1:msec)
         if(w)print'(a,27i5)','isec2',isec2(1:msec)
         if(w)print'(a,27f10.6)','aal',aal(1:msec)
         if(w)print*,'isgn0,jsgnv,jsgn',isgn0,jsgnv,jsgn
         !if(jsgnv==jsgn.and.msec>1.and.isec1(msec)==isec2(msec-1)) then
         if(jsgnv==jsgn.and.msec>1) then
            if(isec1(msec)==isec2(msec-1)) then
            isec2(msec-1)=isec2(msec)
            msec=msec-1
            !print'(a,27i3)','Isec1',isec1(1:msec)
            !print'(a,27i3)','Isec2',isec2(1:msec)
            !print'(a,27f10.6)','Aal',aal(1:msec)
            endif
         endif
         msec=msec+1
         if(w)print*,'element de matrice courant,  signe',el,'  ',jsgn
         !
         ! formation des elements de matrice TP
         !
         if(nntp(k)==nntp(k-1)) cycle
         if(itest(6)==1) cycle
         call mul_itp(el,k,nntp,27)
      enddo
      if(itest(17)==1) return
      if(itest(18)==1) return
      if(itest(6)==1) return
      if(itest(5)==1) return
      if(w)print*,'n2v,n2,n3',n2v,n2,n3
      if(w)print'(a,27i3)','apres boucle itp3',itp3(1:n2)
      if(w)print'(a,27i3)','apres boucle itp4',itp4(1:n2)
      msec=msec-1
      if(w)print'(a,27i3)','isec1',isec1(1:msec)
      if(w)print'(a,27i3)','isec2',isec2(1:msec)
      if(w)print'(a,27f10.6)','aal',aal(1:msec)
      if(msec==1.and.isec1(1)==0) then
         if(w)print*,'appel ena',longc
         call ena(aal(1),longc,mdetc1,mdetc2,
     *   n3,itp3,itp4,isgn=msgnc)
      else
              if(w)print*,'appel enam',longc
         call enam(aal,longc,mdetc1,mdetc2,n2,itp3,itp4,
     *   msec,isec1,isec2,isgn=msgnc)
      endif
      if(w)print*,'n,m,n1,msec',n,m,n1,msec
      return
      end subroutine
      end module
