      subroutine tijkl_saijij
      use module
      use mod_script
      use mod_licost
      use mod_tijkl
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      logical yw
      real(8),allocatable,dimension(:,:) :: iqis,piri
      real(8),allocatable,dimension(:,:,:) :: abrs,aqbsijij,aqbsjiji
     *,aqrb
      integer ip,pq,al,be,ab,pr,qr,al_a,be_a,aal_a,bbe_a,v,v_a,vv_a
      integer ga,ga_a,gga_a,de,de_a,dde_a,cd
      integer aal_abs,bbe_abs,vv_abs,gga_abs,dde_abs
      integer(2),dimension(4,lblock) :: jdx4
      real(8),dimension(lblock) :: value2
!      real(8),allocatable,dimension(:,:) :: a_iijj
      
      
      
      allocatable insinvinv(:)
      allocatable pqrs(:,:,:,:)
      dimension jdeb(3),jfin(3)
      yw=.false.;yw=yw.or.ywtot
      
      
      allocate(iqis(isym(is),num1(isymoa(js)+1)))
      allocate(piri(isym(js),num1(isymoa(is)+1)))
      allocate(aqbsijij(noacs(is),noacs(is),num1(isymoa(js)+1)))
      allocate(abrs(noacs(is),noacs(js),isymoa(is)*isymoa(js)))
      allocate(aqbsjiji(noacs(js),noacs(js),num1(isymoa(is)+1)))
      allocate(aqrb(noacs(is),noacs(js),isymoa(is)*isymoa(js)))
!      allocate(a_iijj(norb,norb))
!      a_iijj(:,:)=0.d0
      ii=lblock
      om1(1:isymoa(is),1:isym(is))=om(1:isymoa(is),1:isym(is),is)
      om2(1:isymoa(js),1:isym(js))=om(1:isymoa(js),1:isym(js),js)
!      print*,'om1'
!      call mscript(om1)
!      print*,'om2'
!      call mscript(om2)
      iqis=0.d0
      piri=0.d0
      abrs=0.d0
      aqrb(:,:,:)=0.d0
      aqbsijij=0.d0
      aqbsjiji=0.d0
      allocate(insinvinv(norb))
      do k=1,norb
         insinvinv(insinv(k))=k
      enddo

C      yt=.true.
C      if(yt) then
C         allocate
C     *   (pqrs(isymoa(is),isymoa(js),isymoa(is),isymoa(js)))
C         print*,'isym',isym(1:nsym)
C         do
C            ii=ii+1
C            if(ii>lblock) then
C               read(11) jdx4,value2
C               ii=1
C            endif
C            vv=value2(ii)
C            p=jdx4(1,ii)
C            if(p==0) exit
C            p=insoa(p)
C            q=insoa(jdx4(2,ii))
C            r=insoa(jdx4(3,ii))
C            s=insoa(jdx4(4,ii))
C            pqrs(p,q,r,s)=vv
C            pqrs(r,s,p,q)=vv
C         !print'(a,4i4,2x,4i4,f12.8)','pqrs',jdx4(:,ii),p,q,r,s,vv
C         enddo
C         ii=lblock
C      print*,'ins',ins
C      print*,'insinv',insinv
C      print*,'insinvinv',insinvinv
C      print*,'is,js,ks,ls',is,js,ks,ls
C         do i=7,7
C            i_abs=ins(insinvinv(i)-sum(isym(1:is-1)))
C            do j=13,13
C               j_abs=ins(insinvinv(j)-sum(isym(1:js-1)))
C               do k=6,6
C                  k_abs=ins(insinvinv(k)-sum(isym(1:ks-1)))
C                  do l=5,5
C                     l_abs=ins(insinvinv(l)-sum(isym(1:ls-1)))
C                     print*,'i,j,k,l',i,j,k,l,i_abs,j_abs,k_abs,l_abs
C                     ai=0.d0
C                     do p=1,isymoa(is)
C                        do q=1,isymoa(js)
C                           do r=1,isymoa(ks)
C                              do s=1,isymoa(ls)
C                                 vv=pqrs(p,q,r,s)
C                                 ai=ai+vv*om1(p,i_abs)*om2(q,j_abs)*
C     *                           om1(r,k_abs)*om2(s,l_abs)
C!                 print'(a,4i4,6f12.8)','vv',p,q,r,s,vv,ai
C!        * ,om1(p,i_abs),om1(q,j_abs),om1(r,k_abs),om1(s,l_abs)
C                              enddo
C                           enddo
C                        enddo
C                     enddo
C                     print'(a,4i4,f12.8)'
C     *               ,'AI',i,j,k,l,ai
C                  enddo
C               enddo
C            enddo
C         enddo
C         ai=0.d0
C         ai2=0.d0
C         aqrb1=0.d0
C         qr=0
C         do q=1,isymoa(js)
C            do r=1,isymoa(is)
C               qr=qr+1
C               aqrb1=0.d0
C               do p=1,isymoa(is)
C                  do s=1,isymoa(js)
C                     vv=pqrs(p,q,r,s)
C                     aqrb1=aqrb1+vv*om1(p,2)*om2(s,5)
C                     ai2=ai2+vv*om1(p,2)*om2(s,5)*om2(q,7)*om1(r,1)
C        print'(5f12.8,4i4,a)',vv*om1(p,2)*om2(s,5),aqrb1
C     *,vv,om1(p,2),om2(s,5),p,q,r,s,'DELJ'
C                  enddo
C               enddo
C               ai=ai+aqrb1*om2(q,7)*om1(r,1)
C               print'(a,3i4,f12.8)','AQRB1',q,r,qr,aqrb1
C            enddo
C         enddo
C         print'(a,2f12.8)','AI2',AI,ai2
C         
C         AIiijv=0.d0
C         do i=6,6
C            i_a=ins(insinvinv(i))
C            do j=6,6
C               j_a=ins(insinvinv(j))
C               do q=1,isymoa(js)
C                  do s=1,isymoa(js)
C                     ai=0.d0
C                     do p=1,isymoa(is)
C                        do r=1,isymoa(is)
C                           vv=pqrs(p,q,r,s)
C                           ai=ai+vv*om1(p,i_a)*om1(r,i_a)
C!      if(q==10.and.s==1)print'(2i4,5f12.8,a)',
C!     *p,r,vv*om1(p,i_a)*om1(r,i_a),vv,om1(p,i_a),om1(r,i_a)
C!     *,ai
C!     *,'JJ'
C                        enddo
C                     enddo
C                     AIiijv=AIiijv+ai*om2(q,j_a)*om2(s,j_a)
C!      print'(2i4,4f12.8,a)',
C!     *max(q,s),min(q,s),ai*om2(q,j_a)*om2(s,j_a)
C!     * ,ai,om2(q,j_a),om2(s,j_a),' AIiijv'
C!                     print'(4i4,f12.8,a)'
C!     *               ,i_a,max(s,q),j_a,min(s,q),ai,' AIJRS'
C                  enddo
C               enddo
C!               print*,'AIiijv',AIiijv
C
C            enddo
C         enddo
C         rewind 11
C      endif
      
      do
         ii=ii+1
         if(ii>lblock) then
            read(11) jdx4,value2
            ii=1
         endif
         vv=value2(ii)
         !if(yw)print'(a,4i4,f12.8)','Int lue',jdx4(:,ii),vv
         p=jdx4(1,ii)
         if(p==0) exit
         p=insoa(p)
         q=insoa(jdx4(2,ii))
         r=insoa(jdx4(3,ii))
         s=insoa(jdx4(4,ii))
         pq=(p-1)*isymoa(js)+q
         pr=num1(p)+r
         qr=(q-1)*isymoa(is)+r
         qs=num1(max(q,s))+min(q,s)
         rs=(r-1)*isymoa(js)+s
         sp=(s-1)*isymoa(is)+p
        
! Kiqis
         do i=1,inac(is)
!     pqrs
            i_abs=numnonacs(i,is)
            !print*,'i,i_abs',i,is,i_abs
            if(q>=s)
     *      iqis(i,qs)=iqis(i,qs)+vv*om1(p,i_abs)*om1(r,i_abs)
!      if(q>=s.and.i==1) then
!      if((q==10.and.s==1).or.(q==1.and.s==10))print'(2i4,5f12.8,a)',
!     *p,r,vv*om1(p,i_abs)*om1(r,i_abs),vv,om1(p,i_abs),om1(r,i_abs)
!     *,iqis(i,qs)
!     *,'FF1'
!       endif
!      if(all(jdx4(:,ii)==(/13,1,12,10/)))print*,'LUE',p,q,r,s,i,pq,rs
            if(pq==rs) cycle
!     rspq
            if(s>=q)
     *      iqis(i,qs)=iqis(i,qs)+vv*om1(r,i_abs)*om1(p,i_abs)
!      if(s>=q.and.i==1) then
!      if((q==10.and.s==1).or.(q==1.and.s==10))print'(2i4,5f12.8,a)',
!     *p,r,vv*om1(p,i_abs)*om1(r,i_abs),vv,om1(p,i_abs),om1(r,i_abs)
!     *,iqis(i,qs)
!     *,'FF2'
!       endif
         enddo
         do i=1,inac(js)
!     qpsr
            i_abs=numnonacs(i,js)
            piri(i,pr)=piri(i,pr)+vv*om2(q,i_abs)*om2(s,i_abs)
!     srqp
            if(pq==rs) cycle
            if(r>=p)
     *      piri(i,pr)=piri(i,pr)+vv*om2(q,i_abs)*om2(s,i_abs)
         enddo

      
      
      
      
! aqbsijij
         do al=1,noacs(is)
            al_a=numacs(al,is)
            do be=1,noacs(is)
               be_a=numacs(be,is)
               if(q>=s)aqbsijij(al,be,qs)=aqbsijij(al,be,qs)+
     *         vv*om1(p,al_a)*om1(r,be_a)
               if(pq==rs) cycle
               if(s>=q)aqbsijij(al,be,qs)=aqbsijij(al,be,qs)+
     *         vv*om1(r,al_a)*om1(p,be_a)
            enddo
         enddo
! aqbsjiji
         do al=1,noacs(js)
            al_a=numacs(al,js)
            do be=1,noacs(js)
               be_a=numacs(be,js)
               if(p>=r)aqbsjiji(al,be,pr)=aqbsjiji(al,be,pr)+
     *         vv*om2(q,al_a)*om2(s,be_a)
               if(pq==rs) cycle
               if(r>=p)aqbsjiji(al,be,pr)=aqbsjiji(al,be,pr)+
     *         vv*om2(s,al_a)*om2(q,be_a)
            enddo
         enddo
! aqrb
         do al=1,noacs(is)
            al_a=numacs(al,is)
            do be=1,noacs(js)
               be_a=numacs(be,js)
               aqrb(al,be,qr)=aqrb(al,be,qr)+
     *         vv*om1(p,al_a)*om2(s,be_a)
C          if(al==1.and.be==1.and.qr==2)print'(4f12.8,4i4,a)',
C     *   vv*om1(p,al_a)*om2(s,be_a),vv,om1(p,al_a),om2(s,be_a)
C     *   ,p,q,r,s,' DEL2'
               if(pq==rs) cycle
               aqrb(al,be,sp)=aqrb(al,be,sp)+
     *         vv*om1(r,al_a)*om2(q,be_a)
C          if(al==1.and.be==1.and.sp==2)print'(4f12.8,4i4,a)',
C     *   vv*om1(r,al_a)*om2(q,be_a),vv,om1(r,al_a),om2(q,be_a)
C     *   ,r,s,p,q,' del2'
            enddo
         enddo
! abrs
         do al=1,noacs(is)
            al_a=numacs(al,is)
            do be=1,noacs(js)
               be_a=numacs(be,js)
               abrs(al,be,rs)=abrs(al,be,rs)+
     *         vv*om1(p,al_a)*om2(q,be_a)
               if(pq/=rs)
     *         abrs(al,be,pq)=abrs(al,be,pq)+
     *         vv*om1(r,al_a)*om2(s,be_a)
            enddo
         enddo
      enddo
C      rs=0
C      do q=1,isymoa(js)
C         do r=1,isymoa(is)
C            rs=rs+1
C            print'(a,3i4,f12.8))','aqrb',q,r,rs,aqrb(1,1,rs)
C         enddo
C      enddo
!               !print*,'aqbsc'if(p/=q) del=del+om1(q,al_a)*om1(p,be_a)
!               !call mscript(aqbsc(1,:,:))
C      do r=1,isymoa(js)
C         do s=1,r
C            rs=(r-1)*r/2+s
C           !print'(a,4i4,f12.8)','iirs',1,1,r,s,iirs(1,rs)
C            !print'(a,3i4,f12.8)','i,r,s,iris',1,r,r,iris(1,rs)
C           !print'(a,4i4,f12.8)','a,b,r,s,abrs',5,5,r,s,abrs(1,rs)
C          !print'(a,4i4,f12.8)','a,b,r,s,abrs',12,5,r,s,abrs(2,rs)
C           !print'(a,4i4,f12.8)','a,q,b,s,AqBs',5,r,5,s,aqbs(1,1,rs)
C          !print'(4i4,f12.8,a)',5,r,12,s,aqbs(1,2,rs),' a,q,b,s,aqbs'
C       !print'(4i4,f12.8,a)',1,r,1,s,iqis(1,rs),' i,q,i,s,iqis'
C         enddo
C      enddo
! the block of pqrs integrals of sym is is is is was read
! tables iirs... were filledif(p/=q) del=del+om1(q,al_a)*om1(p,be_a)
! we begin now the second transformation
!
c               do i=1,inac(is)
c                  i_a=numnonacs(i,is)
c                  rs=0
c                  do r=1,isymoa(is)
c                     do s=1,r
c                        rs=rs+1
c                        if(r==s)
c     *                  print'(a,5i4,f12.8)','iris',i,i_a,r,s,rs,
c     *                  iris(i,rs)
c                     enddo
c                  enddo
c               enddo
! 1.  ijij
      do i=1,inac(is)
         i_a=numnonacs(i,is)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:is-1)))
          !print*,i,ii_a,ii_abs;stop
         do j=1,inac(js)
            j_a=numnonacs(j,js)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:js-1)))
            a_ijij=0.d0
            qs=0
            do q=1,isymoa(js)
               ifac=2
               do s=1,q
                  qs=qs+1
                  if(q==s) ifac=1
                  del=iqis(i,qs)*om2(q,j_a)*om2(s,j_a)*ifac
                  a_ijij=a_ijij+del
!           if(i==1.and.j==1)print'(2i4,4f12.8,a)',
!     *max(q,s),min(q,s),
!     *iqis(i,qs)*om2(q,j_a)*om2(s,j_a),
!     *iqis(i,qs),om2(q,j_a),om2(s,j_a),' IJIJ'
!           if(i==1.and.ifac==2.and.j==1)print'(2i4,4f12.8,a)',
!     *max(q,s),min(q,s),
!     *iqis(i,qs)*om2(q,j_a)*om2(s,j_a),
!     *iqis(i,qs),om2(q,j_a),om2(s,j_a),' IJIJ'
               enddo
            enddo
            call stoijkl(ii_abs,jj_abs,ii_abs,jj_abs,a_ijij,72)
            if(yw)print'(a,4i4,2f12.8)',
     *      '#IJIJ',ii_abs,jj_abs,ii_abs,jj_abs,a_ijij
         enddo
      enddo
! 2. iaib
      do i=1,inac(is)
         i_a=numnonacs(i,is)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:is-1)))
         do al=1,noacs(js)
            al_a=numacs(al,js)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:js-1)))
            do be=1,al
               be_a=numacs(be,js)
               bbe_a=insinv(be_a)
               bbe_abs=insinv(be_a+sum(isym(1:js-1)))
               qs=0
               a_iaib=0.d0
               do q=1,isymoa(js)
                  do s=1,q
                     qs=qs+1
                     del=om2(q,al_a)*om2(s,be_a)
                     if(q/=s)
     *               del=del+om2(s,al_a)*om2(q,be_a)
                     a_iaib=a_iaib+del*iqis(i,qs)
                  enddo
               enddo
               call stoijkl(ii_abs,aal_abs,ii_abs,bbe_abs,a_iaib,72)
               if(yw)print'(a,4i4,f12.8)',
     *         '#IAIB',ii_abs,aal_abs,ii_abs,bbe_abs,a_iaib
            enddo
         enddo
      enddo
! 2. abai
      do i=1,inac(js)
         i_a=numnonacs(i,js)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:js-1)))
         do al=1,noacs(is)
            al_a=numacs(al,is)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:is-1)))
            do be=1,al
               be_a=numacs(be,is)
               bbe_a=insinv(be_a)
               bbe_abs=insinv(be_a+sum(isym(1:is-1)))
               qs=0
               a_iaib=0.d0
               do q=1,isymoa(is)
                  do s=1,q
                     qs=qs+1
                     del=om1(q,al_a)*om1(s,be_a)
                     if(q/=s)
     *               del=del+om1(s,al_a)*om1(q,be_a)
                     a_iaib=a_iaib+del*piri(i,qs)
                  enddo
               enddo
               call stoijkl(aal_abs,ii_abs,bbe_abs,ii_abs,a_iaib,72)
               if(yw)print'(a,4i4,f12.8)',
     *         '#AIBI',aal_abs,ii_abs,bbe_abs,ii_abs,a_iaib
            enddo
         enddo
      enddo
! 3.  iviv
      do i=1,inac(is)
         i_a=numnonacs(i,is)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:is-1)))
          !print*,i,ii_a,ii_abs;stop
         do j=inac(js)+1,nononacs(js)
            j_a=numnonacs(j,js)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:js-1)))
            a_ijij=0.d0
            qs=0
            do q=1,isymoa(js)
               ifac=2
               do s=1,q
                  qs=qs+1
                  if(q==s) ifac=1
                  del=iqis(i,qs)*om2(q,j_a)*om2(s,j_a)*ifac
                  a_ijij=a_ijij+del
               enddo
            enddo
               call stoijkl(jj_abs,ii_abs,jj_abs,ii_abs,a_ijij,72)
            if(yw)print'(a,4i4,2f12.8)',
     *      '#IVIV',jj_abs,ii_abs,jj_abs,ii_abs,a_ijij
         enddo
      enddo
! 3.  vivi
      do i=1,inac(js)
         i_a=numnonacs(i,js)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:js-1)))
          !print*,i,ii_a,ii_abs;stop
         do j=inac(is)+1,nononacs(is)
            j_a=numnonacs(j,is)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:is-1)))
            a_jiji=0.d0
            qs=0
            do q=1,isymoa(is)
               ifac=2
               do s=1,q
                  qs=qs+1
                  if(q==s) ifac=1
                  del=piri(i,qs)*om1(q,j_a)*om1(s,j_a)*ifac
                  a_jiji=a_jiji+del
               enddo
            enddo
               call stoijkl(jj_abs,ii_abs,jj_abs,ii_abs,a_jiji,72)
            if(yw)print'(a,4i4,2f12.8)',
     *      '#IVIV',jj_abs,ii_abs,jj_abs,ii_abs,a_jiji
         enddo
      enddo
! 4. avbv
! 7. aibv vaib
      call avbv(is,js,om1,om2,aqbsijij,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,
     *noacs(is),noacs(is),msymoa,ywtot,msym)
      call avbv(js,is,om2,om1,aqbsjiji,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,
     *noacs(js),noacs(js),msymoa,ywtot,msym)
C      do al=1,noacs(is)
C         al_a=numacs(al,is)
C         aal_a=insinv(al_a)
C         aal_abs=insinv(al_a+sum(isym(1:is-1)))
C         do be=1,noacs(is)
C            be_a=numacs(be,is)
C            bbe_a=insinv(be_a)
C            bbe_abs=insinv(be_a+sum(isym(1:is-1)))
C            do v=inac(js)+1,nononacs(js)
C               v_a=numnonacs(v,js)
C               vv_a=insinv(v_a)
C               vv_abs=insinv(v_a+sum(isym(1:js-1)))
C!       4.
C               qs=0
C               a_avbv=0.d0
C               if(al>=be) then
C                  do q=1,isymoa(js)
C                     do s=1,q
C                        qs=qs+1
C                        del1=om2(q,v_a)*om2(s,v_a)
C                        if(q/=s) del=del1+del1
C                        if(q==s) then
C                           del1=del1*aqbsijij(al,be,qs)
C                        else
C                           del1=del1*
C     *                     (aqbsijij(al,be,qs)+aqbsijij(be,al,qs))
C                        endif
C                        a_avbv=a_avbv+del1
C                     enddo
C                  enddo
C                  if(yw)print'(a,4i4,2f12.8)',
C     *            '#VAVB',aal_abs,vv_abs,bbe_abs,vv_abs,a_avbv
C               endif
C!        7. aibv
C               do i=1,inac(js)
C                  i_a=numnonacs(i,js)
C                  ii_a=insinv(i_a)
C                  ii_abs=insinv(i_a+sum(isym(1:js-1)))
C                  qs=0
C                  a_aibv=0.d0
C                  do q=1,isymoa(js)
C                     do s=1,q
C                        qs=qs+1
C                        del1=om2(q,i_a)*om2(s,v_a)
C                        if(q/=s) then
C                           del2=om2(q,v_a)*om2(s,i_a)
C                           del=del1+del2
C                        else
C                           del=del1
C                        endif
C                        if(q/=s) then
C                           del=del1*aqbsijij(al,be,qs)
C     *                     +del2*aqbsijij(be,al,qs)
C                        else
C                           del=del1*aqbsijij(al,be,qs)
C                        endif
C                        a_aibv=a_aibv+del
C                     enddo
C                  enddo
C                  if(yw) then
C                     print'(a,4i4,2f12.8)','#AIBV'
C     *               ,aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv
C                  endif
C               enddo
C!       7.  vaib
C            enddo
C         enddo
C      enddo
! 7. abiv abvi
      do al=1,noacs(is)
         al_a=numacs(al,is)
         aal_a=insinv(al_a)
         aal_abs=insinv(al_a+sum(isym(1:is-1)))
         do be=1,noacs(js)
            be_a=numacs(be,js)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:js-1)))
!      7. abiv
            do v=inac(js)+1,nononacs(js)
               v_a=numnonacs(v,js)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:js-1)))
               qs=0
               do i=1,inac(is)
                  i_a=numnonacs(i,is)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:is-1)))
                  rs=0
                  a_abiv=0.d0
                  do r=1,isymoa(is)
                     do s=1,isymoa(js)
                        rs=rs+1
                        del=om1(r,i_a)*om2(s,v_a)*abrs(al,be,rs)
                        a_abiv=a_abiv+del
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,ii_abs,vv_abs,a_abiv,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#ABIV'
     *               ,aal_abs,bbe_abs,ii_abs,vv_abs,a_abiv
                  endif
               enddo
            enddo
!      7. abvi
            do v=inac(is)+1,nononacs(is)
               v_a=numnonacs(v,is)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:is-1)))
               qs=0
               do i=1,inac(js)
                  i_a=numnonacs(i,js)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:js-1)))
                  rs=0
                  a_abvi=0.d0
                  do r=1,isymoa(is)
                     do s=1,isymoa(js)
                        rs=rs+1
                        del=om1(r,v_a)*om2(s,i_a)*abrs(al,be,rs)
                        a_abvi=a_abvi+del
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,vv_abs,ii_abs,a_abvi,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#ABVI'
     *               ,aal_abs,bbe_abs,vv_abs,ii_abs,a_abvi
                  endif
               enddo
            enddo
         enddo
      enddo
! 7. avib aivb
      do al=1,noacs(is)
         al_a=numacs(al,is)
         aal_a=insinv(al_a)
         aal_abs=insinv(al_a+sum(isym(1:is-1)))
         do be=1,noacs(js)
            be_a=numacs(be,js)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:js-1)))
! 7. avib
            do v=inac(js)+1,nononacs(js)
               v_a=numnonacs(v,js)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:js-1)))
               do i=1,inac(is)
                  i_a=numnonacs(i,is)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:is-1)))
                  qr=0
                  a_avib=0.d0
                  do q=1,isymoa(js)
                     do r=1,isymoa(is)
                        qr=qr+1
                        del=om1(r,i_a)*om2(q,v_a)*aqrb(al,be,qr)
                        a_avib=a_avib+del
                     enddo
                  enddo
               call stoijkl(aal_abs,vv_abs,ii_abs,bbe_abs,a_avib,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#AVIB'
     *               ,aal_abs,vv_abs,ii_abs,bbe_abs,a_avib
                  endif
               enddo
            enddo
! 7. aivb
            do v=inac(is)+1,nononacs(is)
               v_a=numnonacs(v,is)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:is-1)))
               do i=1,inac(js)
                  i_a=numnonacs(i,js)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:js-1)))
                  qr=0
                  a_aivb=0.d0
                  do q=1,isymoa(js)
                     do r=1,isymoa(is)
                        qr=qr+1
                        del=om2(q,i_a)*om1(r,v_a)*aqrb(al,be,qr)
                        a_aivb=a_aivb+del
                     enddo
                  enddo
               call stoijkl(aal_abs,ii_abs,vv_abs,bbe_abs,a_aivb,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#AIVB'
     *               ,aal_abs,ii_abs,vv_abs,bbe_abs,a_aivb
                  endif
               enddo
            enddo
         enddo
      enddo
! 5. abcd
! 9. abcv
! 11. abci
      do al=1,noacs(is)
         al_a=numacs(al,is)
         aal_a=insinv(al_a)
         aal_abs=insinv(al_a+sum(isym(1:is-1)))
         do be=1,noacs(js)
            be_a=numacs(be,js)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:js-1)))
            cd=0
            do ga=1,noacs(is)
               ga_a=numacs(ga,is)
               gga_a=insinv(ga_a)
               gga_abs=insinv(ga_a+sum(isym(1:is-1)))
!        5.
               if(ga<=al) then
                  ifin=noacs(js)
                  if(al==ga) ifin=be
                  do de=1,ifin
                     de_a=numacs(de,js)
                     dde_a=insinv(de_a)
                     dde_abs=insinv(de_a+sum(isym(1:js-1)))
                     a_abcd=0.d0
                     rs=0
                     do r=1,isymoa(is)
                        do s=1,isymoa(js)
                           rs=rs+1
                           del=abrs(al,be,rs)*om1(r,ga_a)*om2(s,de_a)
                           a_abcd=a_abcd+del
                        enddo
                     enddo
               call stoijkl(aal_abs,bbe_abs,gga_abs,dde_abs,a_abcd,72)
                     if(yw)print'(a,4i4,f12.8)',
     *               '#ABCD',aal_abs,bbe_abs,gga_abs,dde_abs,a_abcd
                  enddo
               endif
!         9.
               do v=inac(js)+1,nononacs(js)
                  v_a=numnonacs(v,js)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:js-1)))
                  a_abcv=0.d0
                  rs=0
                  do r=1,isymoa(is)
                     do s=1,isymoa(js)
                        rs=rs+1
                        del=om1(r,ga_a)*om2(s,v_a)
                        a_abcv=a_abcv+del*abrs(al,be,rs)
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,gga_abs,vv_abs,a_abcv,72)
                  if(yw)print'(a,4i4,f12.8)',
     *            '#ABCV',aal_abs,bbe_abs,gga_abs,vv_abs,a_abcv
               enddo
!        11.
               do i=1,inac(js)
                  i_a=numnonacs(i,js)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:js-1)))
                  a_abci=0.d0
                  rs=0
                  do r=1,isymoa(is)
                     do s=1,isymoa(js)
                        rs=rs+1
                        del=om1(r,ga_a)*om2(s,i_a)
                        a_abci=a_abci+del*abrs(al,be,rs)
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,gga_abs,ii_abs,a_abci,72)
                  if(yw)print'(a,4i4,f12.8)',
     *            '#ABCI',aal_abs,bbe_abs,gga_abs,ii_abs,a_abci
               enddo
            enddo
            do ga=1,noacs(js)
               ga_a=numacs(ga,js)
               gga_a=insinv(ga_a)
               gga_abs=insinv(ga_a+sum(isym(1:js-1)))
!         9.
               do v=inac(is)+1,nononacs(is)
                  v_a=numnonacs(v,is)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:is-1)))
                  a_abcv=0.d0
                  rs=0
                  do r=1,isymoa(is)
                     do s=1,isymoa(js)
                        rs=rs+1
                        del=om1(r,v_a)*om2(s,ga_a)
                        a_abcv=a_abcv+del*abrs(al,be,rs)
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,vv_abs,gga_abs,a_abcv,72)
                  if(yw)print'(a,4i4,f12.8)',
     *            '#ABVC',aal_abs,bbe_abs,vv_abs,gga_abs,a_abcv
               enddo
!        11.
               do i=1,inac(is)
                  i_a=numnonacs(i,is)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:is-1)))
                  a_abci=0.d0
                  rs=0
                  do r=1,isymoa(is)
                     do s=1,isymoa(js)
                        rs=rs+1
                        del=om1(r,i_a)*om2(s,ga_a)
                        a_abci=a_abci+del*abrs(al,be,rs)
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,ii_abs,gga_abs,a_abci,72)
                  if(yw)print'(a,4i4,f12.8)',
     *            '#ABIC',aal_abs,bbe_abs,ii_abs,gga_abs,a_abci
               enddo
            enddo
         enddo
      enddo
! 6. (ijiv)
      do i=1,inac(is)
         i_a=numnonacs(i,is)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:is-1)))
         do j=1,inac(js)
            j_a=numnonacs(j,js)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:js-1)))
            do v=inac(js)+1,nononacs(js)
               v_a=numnonacs(v,js)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:js-1)))
               qs=0
               a_ijiv=0.d0
               do q=1,isymoa(js)
                  do s=1,q
                     qs=qs+1
                     del=iqis(i,qs)*om2(q,j_a)*om2(s,v_a)
                     if(q/=s) del=del+
     *               iqis(i,qs)*om2(q,v_a)*om2(s,j_a)
                     a_ijiv=del+a_ijiv
                  enddo
               enddo
               call stoijkl(ii_abs,jj_abs,ii_abs,vv_abs,a_ijiv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IJIV',ii_abs,jj_abs,ii_abs,vv_abs,a_ijiv
            enddo
         enddo
      enddo
! 6.  (viji)
      do i=1,inac(js)
         i_a=numnonacs(i,js)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:js-1)))
         do j=1,inac(is)
            j_a=numnonacs(j,is)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:is-1)))
            do v=inac(is)+1,nononacs(is)
               v_a=numnonacs(v,is)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:is-1)))
               qs=0
               a_ijiv=0.d0
               do q=1,isymoa(is)
                  do s=1,q
                     qs=qs+1
                     del=piri(i,qs)*om1(q,j_a)*om1(s,v_a)
                     if(q/=s) del=del+
     *               piri(i,qs)*om1(q,v_a)*om1(s,j_a)
                     a_ijiv=del+a_ijiv
                  enddo
               enddo
               call stoijkl(vv_abs,ii_abs,jj_abs,ii_abs,a_ijiv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#VIJI',vv_abs,ii_abs,jj_abs,ii_abs,a_ijiv
            enddo
         enddo
      enddo
! 8.  iaiv  aivi
! 10.  iaij  aiji
      do i=1,inac(is)
         i_a=numnonacs(i,is)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:is-1)))
         do al=1,noacs(js)
            al_a=numacs(al,js)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:js-1)))
!       8. iaiv
            do v=inac(js)+1,nononacs(js)
               v_a=numnonacs(v,js)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:js-1)))
               qs=0
               a_iaiv=0.d0
               do q=1,isymoa(js)
                  do s=1,q
                     qs=qs+1
                     del=om2(q,al_a)*om2(s,v_a)
                     if(q/=s) del=del+om2(s,al_a)*om2(q,v_a)
                     a_iaiv=a_iaiv+del*iqis(i,qs)
                  enddo
               enddo
               call stoijkl(ii_abs,aal_abs,ii_abs,vv_abs,a_iaiv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IAIV',ii_abs,aal_abs,ii_abs,vv_abs,a_iaiv
            enddo
!      10. iaij
            do j=1,inac(js)
               j_a=numnonacs(j,js)
               jj_a=insinv(j_a)
               jj_abs=insinv(j_a+sum(isym(1:js-1)))
               qs=0
               a_iaij=0.d0
               do q=1,isymoa(js)
                  do s=1,q
                     qs=qs+1
                     del=om2(q,al_a)*om2(s,j_a)
                     if(q/=s) del=del+om2(q,j_a)*om2(s,al_a)
                     a_iaij=a_iaij+del*iqis(i,qs)
                  enddo
               enddo
               call stoijkl(ii_abs,aal_abs,ii_abs,jj_abs,a_iaij,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IAIJ',ii_abs,aal_abs,ii_abs,jj_abs,a_iaij
            enddo
         enddo
      enddo
      do i=1,inac(js)
         i_a=numnonacs(i,js)
         ii_a=insinv(i_a)
         ii_abs=insinv(i_a+sum(isym(1:js-1)))
         do al=1,noacs(is)
            al_a=numacs(al,is)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:is-1)))
!       8. aivi
            do v=inac(is)+1,nononacs(is)
               v_a=numnonacs(v,is)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:is-1)))
               qs=0
               a_iaiv=0.d0
               do q=1,isymoa(is)
                  do s=1,q
                     qs=qs+1
                     del=om1(q,al_a)*om1(s,v_a)
                     if(q/=s) del=del+om1(s,al_a)*om1(q,v_a)
                     a_iaiv=a_iaiv+del*piri(i,qs)
                  enddo
               enddo
               call stoijkl(aal_abs,ii_abs,vv_abs,ii_abs,a_iaiv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#AIVI',aal_abs,ii_abs,vv_abs,ii_abs,a_iaiv
            enddo
!      10. aiji
            do j=1,inac(is)
               j_a=numnonacs(j,is)
               jj_a=insinv(j_a)
               jj_abs=insinv(j_a+sum(isym(1:is-1)))
               qs=0
               a_iaij=0.d0
               do q=1,isymoa(is)
                  do s=1,q
                     qs=qs+1
                     del=om1(q,al_a)*om1(s,j_a)
                     if(q/=s) del=del+om1(q,j_a)*om1(s,al_a)
                     a_iaij=a_iaij+del*piri(i,qs)
                  enddo
               enddo
               call stoijkl(aal_abs,ii_abs,jj_abs,ii_abs,a_iaij,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#AIJI',aal_abs,ii_abs,jj_abs,ii_abs,a_iaij
            enddo
         enddo
      enddo
      deallocate(iqis,piri,abrs,aqbsijij,aqbsjiji)
      return
      end



       subroutine avbv(is,js,om1,om2,aqbsijij,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,
     *iaqbs1,iaqbs2,msymoa,ywtot,msym)
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension noacs(*),insinv(*),numacs(maxorbcas,nsym)
      dimension aqbsijij(iaqbs1,iaqbs2,*),isym(*),isymoa(*),inac(*)
      dimension nononacs(*),numnonacs(msym,nsym)
      dimension om1(msymoa,*),om2(msymoa,*)
      integer ip,pq,al,be,ab,pr,qr,al_a,be_a,aal_a,bbe_a,v,v_a,vv_a
      integer ga,ga_a,gga_a,de,de_a,dde_a,cd
      integer vv_abs,aal_abs,bbe_abs,gga_abs,dde_abs
      yw=.false.;yw=yw.or.ywtot
! 4. avbv
! 7. aibv vaib
      if(yw)print*,'entree avbv'
      do al=1,noacs(is)
         al_a=numacs(al,is)
         aal_a=insinv(al_a)
         aal_abs=insinv(al_a+sum(isym(1:is-1)))
         do be=1,noacs(is)
            be_a=numacs(be,is)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:is-1)))
            do v=inac(js)+1,nononacs(js)
               v_a=numnonacs(v,js)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:js-1)))
!       4.
               qs=0
               a_avbv=0.d0
               if(al>=be) then
                  do q=1,isymoa(js)
                     do s=1,q
                        qs=qs+1
                        del1=om2(q,v_a)*om2(s,v_a)
                        if(q/=s) del=del1+del1
                        if(q==s) then
                           del1=del1*aqbsijij(al,be,qs)
                        else
                           del1=del1*
     *                     (aqbsijij(al,be,qs)+aqbsijij(be,al,qs))
                        endif
                        a_avbv=a_avbv+del1
                     enddo
                  enddo
               call stoijkl(aal_abs,vv_abs,bbe_abs,vv_abs,a_avbv,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#VAVB',aal_abs,vv_abs,bbe_abs,vv_abs,a_avbv
               endif
!        7. aibv
               do i=1,inac(js)
                  i_a=numnonacs(i,js)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:js-1)))
                  qs=0
                  a_aibv=0.d0
                  do q=1,isymoa(js)
                     do s=1,q
                        qs=qs+1
                        del1=om2(q,i_a)*om2(s,v_a)
                        if(q/=s) then
                           del2=om2(q,v_a)*om2(s,i_a)
                           del=del1+del2
                        else
                           del=del1
                        endif
                        if(q/=s) then
                           del=del1*aqbsijij(al,be,qs)
     *                     +del2*aqbsijij(be,al,qs)
                        else
                           del=del1*aqbsijij(al,be,qs)
                        endif
                        a_aibv=a_aibv+del
                     enddo
                  enddo
               call stoijkl(aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#AIBV'
     *               ,aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv
                  endif
               enddo
!       7.  vaib
            enddo
         enddo
      enddo
      if(yw)print*,'sortie avbv'
      return
      end
