      module mod_itp
      use module
      logical(1),save :: ydir=.true.
      logical(1),save :: yoci(maxorbcas)=.false.
      contains
       subroutine mul_itp(det,ind,ntp,ndim,j,k,l,m)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! decodage de det (ex : det="I+ k- -> a+ b- | I- j+ -> a+ b-")
! en entree : det
 
      use module
      use mod_script
      integer,optional,intent(in) :: j,k,l,m
      character(31) det
      character(4) spin1,spin2,eq
      dimension ioc1(4),ioc2(4),ntp(0:ndim)
      integer corr1,corr2
!+ k- -> a+ b- | I- j+ -> a+ b-
      spin1=det(2:2)//det(5:5)//det(11:11)//det(14:14)
      spin2=det(19:19)//det(22:22)//det(28:28)//det(31:31)
      eq=det(3:3)//det(12:12)//det(20:20)//det(29:29)
      ioc1=0
      ioc2=0
      it1=0
      it2=0
      ip1=0
      ip2=0
      jj=0
      kk=0
      mm=0
      ll=0
      if(present(j))jj=j
      if(present(k))kk=k
      if(present(l))ll=l
      if(present(m))mm=m
      !print*,'spin1 ',spin1
      !print*,'spin2 ',spin2
      do i=1,2
         if(spin1(i:i)=='+') then
            ioc1(1)=ioc1(1)+1
            it1=it1+1
         else if(spin1(i:i)=='-') then
            ioc1(2)=ioc1(2)+1
            it1=it1-1
         endif
         if(spin2(i:i)=='+') then
            ioc2(1)=ioc2(1)+1
            it2=it2+1
         else if(spin2(i:i)=='-') then
            ioc2(2)=ioc2(2)+1
            it2=it2-1
         endif
      enddo
      do i=3,4
         if(spin1(i:i)=='+') then
            ioc1(3)=ioc1(3)+1
            ip1=ip1+1
         else if(spin1(i:i)=='-') then
            ioc1(4)=ioc1(4)+1
            ip1=ip1-1
         endif
         if(spin2(i:i)=='+') then
            ioc2(3)=ioc2(3)+1
            ip2=ip2+1
         else if(spin2(i:i)=='-') then
            ioc2(4)=ioc2(4)+1
            ip2=ip2-1
         endif
      enddo
      if(w)print'(a,4i2)','ioc1',ioc1
      if(w)print'(a,4i2)','ioc2',ioc2
      jcltp1=isdimtp(icltp(ioc1(1),ioc1(2),ioc1(3),ioc1(4)))
      jcltp2=isdimtp(icltp(ioc2(1),ioc2(2),ioc2(3),ioc2(4)))
      !print*,'det ',det
      call chit(it1,1,2,1,spin1,eq,det(3:3),jj,kk)
      call chit(it2,1,2,3,spin2,eq,det(12:12),ll,mm)
      call chit(ip1,3,4,2,spin1,eq,det(20:20),jj,kk)
      call chit(ip2,3,4,4,spin2,eq,det(29:29),ll,mm)
 
      if(w)print*,'it1,ip1,it2,ip2',it1,ip1,it2,ip2
      !call mscript(corr_tp)
      corr1=corr_tp(it1,ip1)+jcltp1
      corr2=corr_tp(it2,ip2)+jcltp2
      ind2=ind
      ind1=ind-1
      if(w)print*,'corr_',corr_tp(it1,ip1),corr_tp(it2,ip2)
      if(w)print*,'jcltp1,jcltp2',jcltp1,jcltp2
      if(w)print*,'corr1,corr2',corr1,corr2
      if(w)print*,'ind1,ind2',ind1,ind2
      if(w)print*,'ntp',ntp(ind1),ntp(ind2)
      if(w)print*,'itp1',itp1(ntp(ind1)+1:ntp(ind2))
      if(w)print*,'itp2',itp2(ntp(ind1)+1:ntp(ind2))
      itp3(ntp(ind1)+1:ntp(ind2))=itp1(ntp(ind1)+1:ntp(ind2))+corr1
      itp4(ntp(ind1)+1:ntp(ind2))=itp2(ntp(ind1)+1:ntp(ind2))+corr2
      if(w)print*,'itp3',itp3(ntp(ind1)+1:ntp(ind2))
      if(w)print*,'itp4',itp4(ntp(ind1)+1:ntp(ind2))
!      itp3(1:ntp(ind2)-ntp(ind1)-1)=itp3(ntp(ind1)+1:ntp(ind2))
!      itp4(1:ntp(ind2)-ntp(ind1)-1)=itp4(ntp(ind1)+1:ntp(ind2))
!      print*,'itp3',itp3(1:ntp(ind2)-ntp(ind1)-1)
!      print*,'itp4',itp4(1:ntp(ind2)-ntp(ind1)-1)
 
      return
      end subroutine
       subroutine chit(it1,i,j,k,spin1,eq,s,jj,kk)
      character(4) spin1,eq
      character s
      !print*,'chit s ',s,jj,kk
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!      ! verif a supprimer
!      if(spin1(i:j)=='-+'.and.eq(k:k)=='=') stop 'err dans chit'
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      if(it1==0) then
         if(spin1(i:j)=='+-') then
            if(eq(k:k)=='=') then
               it1=4
            else
               it1=3
               if(s=='<'.and.jj>kk) it1=-3
               if(s=='<'.and.jj==kk) it1=4
            endif
         else if(spin1(i:j)=='-+') then
            if(eq(k:k)=='=') then
               it1=4
            else
               it1=-3
               if(s=='<'.and.jj>kk) it1=3
               if(s=='<'.and.jj==kk) it1=4
            endif
         endif
      endif
      return
      end subroutine
       subroutine mul_intc(intc,iclc1,iclc2,longc,idetc1,idetc2,isgnc,
     *llongc1,llongc2,x,y,z,t)
      use module
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   - intec ex: '-+-v'=type de l'integrale. Ici CCCv, avec spins -+-
!     sur les CCC (v. mul_intc)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      character(4) intc
      integer x,y,z,t,xz1,xz2,yt1,yt2
      integer idetc1(llongc1),idetc2(llongc2),isgnc(llongc2)
      logical yw
      yw=.false.
      longc=0
      isgnc=1
      j1=idebc(iclc1)-1
      j2=idebc(iclc2)-1
      if(w)print'(a,4i3)','Mul_intc x,y,z,t  ',x,y,z,t
      if(w)print*,'Mul_intc intc,ydir  ',intc,ydir
      !
      ! Int directe ou echange ?
      !
      xz1=min(x,z)
      xz2=max(x,z)
      yt1=min(y,t)
      yt2=max(y,t)
 
 
      do
         j1=j1+1
         if(w)print*,'j1',j1,ifinc(iclc1)
         if(j1>ifinc(iclc1)) exit
!        print*,btest(ibinc(j1),x),x,j1
!        print*,btest(ibinc(j1),y),y,j1
!        print*,btest(ibinc(j1),z),z,j1
!        print*,btest(ibinc(j1),t),t,j1
!        print*,btest(ibinc(j1),x+16)
!        print*,btest(ibinc(j1),y+16)
!        print*,btest(ibinc(j1),z+16)
!        print*,btest(ibinc(j1),t+16)
         if(intc(1:1)=='+') then
            if(.not.btest(ibinc(j1),x-1)) then
               if(w)print*,'Mul_intc1'
               cycle
            endif
         else if(intc(1:1)=='-') then
            if(.not.btest(ibinc(j1),x+16-1)) then
               if(w)print*,'Mul_intc2'
               cycle
            endif
         endif
         if(yw)print*,'c1'
         if(intc(2:2)=='+') then
            if(.not.btest(ibinc(j1),y-1)) then
               if(w)print*,'Mul_intc3'
               cycle
            endif
         else if(intc(2:2)=='-') then
            if(.not.btest(ibinc(j1),y+16-1)) then
               if(w)print*,'Mul_intc4'
               cycle
            endif
         endif
         if(yw)print*,'c2'
         if(intc(3:3)=='+') then
            if(x/=z.and.btest(ibinc(j1),z-1)) then
               if(w)print*,'Mul_intc5'
               cycle
            endif
         else if(intc(3:3)=='-') then
            if(x/=z.and.btest(ibinc(j1),z+16-1)) then
               if(w)print*,'Mul_intc6'
               cycle
            endif
         endif
         if(yw)print*,'c3'
         if(intc(4:4)=='+') then
            if(y/=t.and.btest(ibinc(j1),t-1)) then
               if(w)print*,'Mul_intc7'
               cycle
            endif
         else if(intc(4:4)=='-') then
            if(y/=t.and.btest(ibinc(j1),t+16-1)) then
               if(w)print*,'Mul_intc8'
               cycle
            endif
         endif
         if(yw)print*,'coucou1'
         do
            j2=j2+1
            if(w)print*,'j2',j2,ifinc(iclc2)
            !print*,btest(ibinc(j2),x)
            !print*,btest(ibinc(j2),y)
            !print*,btest(ibinc(j2),z)
            !print*,btest(ibinc(j2),x+16)
            !print*,btest(ibinc(j2),y+16)
            !print*,btest(ibinc(j2),z+16)
            if(j2>ifinc(iclc2)) exit
            if(intc(1:1)=='+') then
               if(x/=z.and.btest(ibinc(j2),x-1)) then
                  if(w)print*,'Mul_intc1'
                  cycle
               endif
            else if(intc(1:1)=='-') then
               if(x/=z.and.btest(ibinc(j2),x+16-1)) then
                  if(w)print*,'Mul_intc2'
                  cycle
               endif
            endif
            !if(w)print*,'C1'
            if(intc(2:2)=='+') then
               if(btest(ibinc(j2),y-1)) then
                       if(w)print*,'Mul_intc3'
                  cycle
               endif
            else if(intc(2:2)=='-') then
               if(y/=t.and.btest(ibinc(j2),y+16-1)) then
                  if(w)print*,'Mul_intc4'
                  cycle
               endif
            endif
            !print*,'C2'
            if(intc(3:3)=='+') then
               if(.not.btest(ibinc(j2),z-1)) then
                  if(w)print*,'Mul_intc5'
                  cycle
               endif
            else if(intc(3:3)=='-') then
               if(.not.btest(ibinc(j2),z+16-1)) then
                  if(w)print*,'Mul_intc6'
                  cycle
               endif
            endif
            !print*,'C3'
            if(intc(4:4)=='+') then
               if(.not.btest(ibinc(j2),t-1)) then
                  if(w)print*,'Mul_intc7'
                  cycle
               endif
            else if(intc(4:4)=='-') then
               if(.not.btest(ibinc(j2),t+16-1)) then
                  if(w)print*,'Mul_intc8'
                  cycle
               endif
            endif
            !print*,'C4'
            if(w)print*,'Mul_intc Occupation CAS correcte'
            if(sel==2) then
               ! Calcul selectionne
               ! Certains elt de mat sont a eliminer
               if(w)print*,'j1,j2,idist,idist2',j1,j2,idist,idist2
               if(w)print*,'icaldist',icaldist(j1,jbin,ibinc,noac)
               if(w)print*,'icaldist',icaldist(j2,jbin,ibinc,noac)
               if(icaldist(j1,jbin,ibinc,noac)>idist) exit
               if(icaldist(j2,jbin,ibinc,noac)>idist2) exit
               if(w)print*,'Mul_intc distance CAS correcte'
            endif
            longc=longc+1
            idetc1(longc)=idetc(j1)
            idetc2(longc)=idetc(j2)
            if(intc(1:1)=='+') then
               if(intc(3:3)=='o') then
                  call calisgnc(isgnc(longc),1,x-1,ibinc(j1))
               elseif(intc(3:3)=='v') then
                  call calisgnc(isgnc(longc),x+1,noac,ibinc(j1))
               else
                  call calisgnc(isgnc(longc),
     *            xz1+1,xz2-1,ibinc(j1))
               endif
            elseif(intc(1:1)=='-') then
               if(intc(3:3)=='o') then
                  call calisgnc(isgnc(longc),17,x+15,ibinc(j1))
               elseif(intc(3:3)=='v') then
                  call calisgnc(isgnc(longc),x+17,noac+16,ibinc(j1))
               else
                  call calisgnc(isgnc(longc),
     *            xz1+17,xz2+15,ibinc(j1))
               endif
            endif
            if(intc(2:2)=='+') then
               if(intc(4:4)=='o') then
                  call calisgnc(isgnc(longc),1,y-1,ibinc(j1))
               elseif(intc(4:4)=='v') then
                  call calisgnc(isgnc(longc),y+1,noac,ibinc(j1))
               else
                  call calisgnc(isgnc(longc),
     *            yt1+1,yt2-1,ibinc(j1))
               endif
            elseif(intc(2:2)=='-') then
               if(intc(4:4)=='o') then
                  call calisgnc(isgnc(longc),17,y+15,ibinc(j1))
               elseif(intc(4:4)=='v') then
                  call calisgnc(isgnc(longc),y+17,noac+16,ibinc(j1))
               else
                  call calisgnc(isgnc(longc),
     *            yt1+17,yt2+15,ibinc(j1))
               endif
            else
               if(intc(4:4)=='+') then
                  if(intc(2:2)=='o') then
                     call calisgnc(isgnc(longc),1,t-1,ibinc(j1))
                  elseif(intc(2:2)=='v') then
                     call calisgnc(isgnc(longc),t+1,noac,ibinc(j1))
                  endif
               elseif(intc(4:4)=='-') then
                  if(intc(2:2)=='o') then
                     call calisgnc(isgnc(longc),17,t+15,ibinc(j1))
                  elseif(intc(2:2)=='v') then
                     call calisgnc(isgnc(longc),t+17,noac+16,
     *               ibinc(j1))
                  endif
               endif
            endif
            exit
         enddo
      enddo
      return
      end subroutine
       subroutine calisgnc(isgnc,i,j,ibinc1)
      use module
      if(w)print*,'calisgnc',i,j,(btest(ibinc1,k-1),k=1,4)
     *,' ',(btest(ibinc1,k),k=17-1,20-1),'  ',ydir,yoci(1:noac)
      if(ydir) then
         do k=i,j
            if(btest(ibinc1,k-1)) isgnc=-isgnc
         enddo
      else
         do k=i,j
            kk=mod(k-1,16)+1
            if(.not.yoci(kk).and.btest(ibinc1,k-1)) isgnc=-isgnc
            !if(.not.yoci(kk).and.btest(ibinc1,k)) print*,'chisgnc'
         enddo
      endif
!      print*,'sortie calisgnc',(btest(ibinc1,k),k=i,j)
      return
      end subroutine
 
      end module
