      module mod_gen
      parameter (maxorbcas2=16)
      !IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      character(maxorbcas2+48) bb
      integer iadr,nta,npa,it(2),ip(2),nt,np,ntnp,ntb,npb
      integer ica(maxorbcas2),icb(maxorbcas2)
      double precision diagc
      logical(1) yc(32)
      logical :: yfin=.false.,ysysp=.false.
      integer nca,ncb,kc
      integer,allocatable,dimension(:) :: isyspi,work1,work2,work3
      real(8),allocatable,dimension(:,:) :: workc
      real(8),allocatable,dimension(:,:) :: densa,densb
      integer,allocatable,dimension(:,:) :: infosym
      integer idets,infosyml,idets0,ndetsy,msym,nvzero
      integer(1) infosymn(2048)
      logical(1),allocatable :: yysymdeja(:)
      integer,save :: iidiag=0
      contains
       subroutine gen_0
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      if(ysym) then
         call symdet2
         return
      endif
      if(yfin) then
         call ecribb(0,0,it,ip)
         return
      endif
      iadr=iadr+1
      if(ysysp) then
         call syspin1(0,0,it,ip)
         return
      endif
      call diago1
      if(ygendet) call pie(yc,0,it,0,ip)
      if(ygenverif) then
         call adrdet(yc,0,it,0,ip,iadr1)
         if(iadr.ne.iadr1) then
            print*,'1iadr,iadr1',iadr,iadr1
            stop
         endif
      endif
      return
      end subroutine
       subroutine gen_tp
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      do k=1,nlpair
         iadr=iadr+1
         if(nta==0) then
                 !print*,'it',it
                 !print*,'k',k
                 !print*,'nlpair',nlpair
            it(1)=-ilpair(1,k)
         else
            it(1)=ilpair(1,k)
         endif
         if(npa==0) then
            ip(1)=-ilpair(2,k)
         else
            ip(1)=ilpair(2,k)
         endif
         if(ysym) then
            call symdet2
            cycle
         endif
         if(yfin) then
            call ecribb(1,1,it,ip)
            cycle
         endif
         if(ysysp) then
            call syspin1(1,1,it,ip)
            cycle
         endif
         call diago1
         if(ygendet) call pie(yc,1,it,1,ip)
         if(ygenverif) then
            call adrdet(yc,1,it,1,ip,iadr1)
            if(iadr.ne.iadr1) then
               print*,'2iadr,iadr1',iadr,iadr1
               stop
            endif
         endif
      enddo
      return
      end subroutine
       subroutine gen_ttp
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      if(nta==1) then
         call gen_ttp1('<')
         call gen_ttp1('=')
         call gen_ttp1('>')
      else
         call gen_ttp1('<')
      endif
      return
      end subroutine
       subroutine gen_ttp1(cas)
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character cas
      yw=.false.
      do k=1,nlco
         jt2=ilc(k)
         do l=1,nlpairp
            if(ipc(l,k)<=0) cycle
            jt1=ilpair(1,l)
            jp1=ilpair(2,l)
            if(cas=='<') then
               if(jt1==jt2) cycle
               it=(/min(jt1,jt2),max(jt1,jt2)/)
               ip(1)=jp1
            else if(cas=='=') then
               if(jt1/=jt2) cycle
               it=(/jt1,jt2/)
               ip(1)=jp1
            else if(cas=='>') then
               if(jt1==jt2) cycle
               it=(/max(jt1,jt2),min(jt1,jt2)/)
               ip(1)=jp1
            endif
            do kk=1+nta,2
               it(kk)=-it(kk)
            enddo
            do kk=1+npa,2
               ip(kk)=-ip(kk)
            enddo
            !print*,'it,ip',it,ip(1)
            if(ysym) then
               call symdet2
               cycle
            endif
            if(yfin) then
               call ecribb(2,1,it,ip)
               cycle
            endif
            iadr=iadr+1
            if(ysysp) then
               call syspin1(2,1,it,ip)
               cycle
            endif
            call diago1
            if(ygendet) call pie(yc,2,it,1,ip)
            if(ygenverif) then
               call adrdet(yc,2,it,1,ip,iadr1)
               if(iadr.ne.iadr1) then
                  print*,'3iadr,iadr1',iadr,iadr1
                  print*,'it,ip',it,ip
                  stop
               endif
            endif
         enddo
      enddo
      return
      end subroutine
       subroutine gen_tpp
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      !print*,'entree gen_tpp'
      if(npa==1) then
         call gen_tpp1('<')
         call gen_tpp1('=')
         call gen_tpp1('>')
      else
         call gen_tpp1('<')
      endif
      return
      end subroutine
      
       subroutine gen_tpp1(cas)
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character cas
      yw=.false.
      !print*,'entree gen_tpp1'
      do k=nlco+1,nlc
         jp2=ilc(k)
         do l=1,nlpairp
            if(ipc(l,k)<=0) cycle
            jt1=ilpair(1,l)
            jp1=ilpair(2,l)
            if(cas=='<') then
               if(jp1==jp2) cycle
               ip=(/min(jp1,jp2),max(jp1,jp2)/)
               it(1)=jt1
            else if(cas=='=') then
               if(jp1/=jp2) cycle
               ip=(/jp1,jp2/)
               it(1)=jt1
            else if(cas=='>') then
               if(jp1==jp2) cycle
               ip=(/max(jp1,jp2),min(jp1,jp2)/)
               it(1)=jt1
            endif
            do kk=1+nta,2
               it(kk)=-it(kk)
            enddo
            do kk=1+npa,2
               ip(kk)=-ip(kk)
            enddo
            !print*,'it,ip',it(1),ip
            if(ysym) then
               call symdet2
               cycle
            endif
            if(yfin) then
               call ecribb(1,2,it,ip)
               cycle
            endif
            iadr=iadr+1
            if(ysysp) then
               call syspin1(1,2,it,ip)
               cycle
            endif
            call diago1
            if(ygendet) call pie(yc,1,it,2,ip)
            if(ygenverif) then
               call adrdet(yc,1,it,2,ip,iadr1)
               if(iadr.ne.iadr1) then
                  print*,'iadr,iadr1',iadr,iadr1
                  print*,'it,ip',it,ip
                  stop
               endif
            endif
         enddo
      enddo
      return
      end subroutine
      
       subroutine gen_t
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      do k=1,nlco
         iadr=iadr+1
         if(nta==1) then
            it(1)=ilc(k)
         else
            it(1)=-ilc(k)
         endif
         if(ysym) then
            call symdet2
            cycle
         endif
         if(yfin) then
            call ecribb(1,0,it,ip)
            cycle
         endif
         if(ysysp) then
            call syspin1(1,0,it,ip)
            cycle
         endif
         call diago1
         if(ygendet) call pie(yc,1,it,0,ip)
         if(ygenverif) then
            call adrdet(yc,1,it,0,ip,iadr1)
            if(iadr.ne.iadr1) then
               print*,'iadr,iadr1',iadr,iadr1
               stop
            endif
         endif
      enddo
      return
      end subroutine
       subroutine gen_p
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      do k=nlco+1,nlc
         iadr=iadr+1
         if(npa==1) then
            ip(1)=ilc(k)
         else
            ip(1)=-ilc(k)
         endif
         if(ysysp) then
            call syspin1(0,1,it,ip)
            cycle
         endif
         if(ysym) then
            call symdet2
            cycle
         endif
         if(yfin) then
            call ecribb(0,1,it,ip)
            cycle
         endif
         call diago1
         if(ygendet) call pie(yc,0,it,1,ip)
         if(ygenverif) then
            call adrdet(yc,0,it,1,ip,iadr1)
            if(iadr.ne.iadr1) then
               print*,'iadr,iadr1',iadr,iadr1
               stop
            endif
         endif
      enddo
      return
      end subroutine
       subroutine gen_pp
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      if(npa==1) then
         call gen_pp1('<')
         call gen_pp1('=')
         call gen_pp1('>')
      else
         call gen_pp1('<')
      endif
      return
      end subroutine
       subroutine gen_pp1(cas)
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character cas
      yw=.false.
      do k=nlco+1,nlc
         if(cas=='=') then
            ideb=k
            ifin=k
         else
            ideb=nlco+1
            ifin=k-1
         endif
         do l=ideb,ifin
            iadr=iadr+1
            if(cas=='<') then
               ip=(/ilc(l),ilc(k)/)
            else
               ip=(/ilc(k),ilc(l)/)
            endif
            ip(npa+1:2)=-ip(npa+1:2)
            if(ysysp) then
               call syspin1(0,2,it,ip)
               cycle
            endif
            if(ysym) then
               call symdet2
               cycle
            endif
            if(yfin) then
               call ecribb(0,2,it,ip)
               cycle
            endif
      
            call diago1
            if(ygendet) call pie(yc,0,it,2,ip)
            if(ygenverif) then
               call adrdet(yc,0,it,2,ip,iadr1)
               if(iadr.ne.iadr1) then
                  print*,'iadr,iadr1',iadr,iadr1
                  stop
               endif
            endif
         enddo
      enddo
      return
      
      
      
      
      end subroutine
       subroutine gen_tt
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      if(nta==1) then
         call gen_tt1('<')
         call gen_tt1('=')
         call gen_tt1('>')
      else
         call gen_tt1('<')
      endif
      return
      end subroutine
       subroutine gen_tt1(cas)
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character cas
      yw=.false.
      do k=1,nlco
         if(cas=='=') then
            ideb=k
            ifin=k
         else
            ideb=1
            ifin=k-1
         endif
         do l=ideb,ifin
            iadr=iadr+1
            if(cas=='<') then
               it=(/ilc(l),ilc(k)/)
            else
               it=(/ilc(k),ilc(l)/)
            endif
            it(nta+1:2)=-it(nta+1:2)
            if(ysysp) then
               call syspin1(2,0,it,ip)
               cycle
            endif
            if(ysym) then
               call symdet2
               cycle
            endif
            if(yfin) then
               call ecribb(2,0,it,ip)
               cycle
            endif
      
            call diago1
            if(ygendet) call pie(yc,2,it,0,ip)
            if(ygenverif) then
               call adrdet(yc,2,it,0,ip,iadr1)
               if(iadr.ne.iadr1) then
                  print*,'iadr,iadr1',iadr,iadr1
                  stop
               endif
            endif
         enddo
      enddo
      return
      
      
      
      
      end subroutine
       subroutine gen_ttpp
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      yw=.false.
      if(nta==0) then
         if(npa==0) then
            call gen_ttpp1('<<')
         else if(npa==1) then
            call gen_ttpp1('<<')
            call gen_ttpp1('<=')
            call gen_ttpp1('<>')
         else if(npa==2) then
            call gen_ttpp1('<<')
         endif
      else if(nta==1) then
         if(npa==0) then
            call gen_ttpp1('<<')
            call gen_ttpp1('=<')
            call gen_ttpp1('><')
         else if(npa==1) then
            call gen_ttpp1('<<')
            call gen_ttpp1('<=')
            call gen_ttpp1('=<')
            call gen_ttpp1('==')
            call gen_ttpp1('<>')
            call gen_ttpp1('><')
            call gen_ttpp1('>>')
            call gen_ttpp1('>=')
            call gen_ttpp1('=>')
         else if(npa==2) then
            call gen_ttpp1('<<')
            call gen_ttpp1('=<')
            call gen_ttpp1('><')
         endif
      else if(nta==2) then
         if(npa==0) then
            call gen_ttpp1('<<')
         else if(npa==1) then
            call gen_ttpp1('<<')
            call gen_ttpp1('<=')
            call gen_ttpp1('<>')
         else if(npa==2) then
            call gen_ttpp1('<<')
         endif
      endif
      return
      end subroutine
       subroutine gen_ttpp1(cas)
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character(2) cas
      yw=.false.
      npp0=0
      do k=1,nlpairp
         jt1=ilpair(1,k)
         jp1=ilpair(2,k)
         do l=1,k
            npp0=npp0+1
            if(cas=='=='.and.k.ne.l) cycle
            !print*,'ipp',npp0,ipp(npp0)
            if(ipp(npp0)<=0) cycle
            jt2=ilpair(1,l)
            jp2=ilpair(2,l)
            !print*,'ilpair',ilpair(:,k),ilpair(:,l)
            if(cas=='<<') then
               if(jt1==jt2.or.jp1==jp2) cycle
               it=(/min(jt1,jt2),max(jt1,jt2)/)
               ip=(/min(jp1,jp2),max(jp1,jp2)/)
            else if(cas=='<=') then
               if(jt1==jt2.or.jp1/=jp2) cycle
               it=(/min(jt1,jt2),max(jt1,jt2)/)
               ip=(/jp1,jp2/)
            else if(cas=='=<') then
               if(jt1/=jt2.or.jp1==jp2) cycle
               it=(/jt1,jt2/)
               ip=(/min(jp1,jp2),max(jp1,jp2)/)
            else if(cas=='==') then
               it=(/jt1,jt2/)
               ip=(/jp1,jp2/)
               if(yw)print*,'it,ip',it,ip
            else if(cas=='<>') then
               if(jt1==jt2.or.jp1==jp2) cycle
               it=(/min(jt1,jt2),max(jt1,jt2)/)
               ip=(/max(jp1,jp2),min(jp1,jp2)/)
            else if(cas=='><') then
               if(jt1==jt2.or.jp1==jp2) cycle
               it=(/max(jt1,jt2),min(jt1,jt2)/)
               ip=(/min(jp1,jp2),max(jp1,jp2)/)
            else if(cas=='>>') then
               if(jt1==jt2.or.jp1==jp2) cycle
               it=(/max(jt1,jt2),min(jt1,jt2)/)
               ip=(/max(jp1,jp2),min(jp1,jp2)/)
            else if(cas=='>=') then
               if(jt1==jt2.or.jp1/=jp2) cycle
               it=(/max(jt1,jt2),min(jt1,jt2)/)
               ip=(/jp1,jp2/)
            else if(cas=='=>') then
               if(jt1/=jt2.or.jp1==jp2) cycle
               it=(/jt1,jt2/)
               ip=(/max(jp1,jp2),min(jp1,jp2)/)
            endif
            do kk=1+nta,2
               it(kk)=-it(kk)
            enddo
            do kk=1+npa,2
               ip(kk)=-ip(kk)
            enddo
            !print*,'it,ip',it,ip
            if(ysym) then
               call symdet2
               cycle
            endif
            if(yfin) then
               call ecribb(2,2,it,ip)
               cycle
            endif
            iadr=iadr+1
            if(ysysp) then
               call syspin1(2,2,it,ip)
               cycle
            endif
            call diago1
            if(ygendet) call pie(yc,2,it,2,ip)
            if(ygenverif) then
               call adrdet(yc,2,it,2,ip,iadr1)
               if(iadr.ne.iadr1) then
                  print*,'iadr,iadr1',iadr,iadr1
                  print*,'it,ip',it,ip
                  stop
               endif
            endif
         enddo
      enddo
      return
      end subroutine
      end module mod_gen
