      subroutine tijkl_saiikk
      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(:,:) :: iirs,pqii,abrs,pqab
      real(8),allocatable,dimension(:,:,:) :: aqbs
      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
      integer(2),dimension(4,lblock) :: jdx4
      real(8),dimension(lblock) :: value2
      
      
      
      allocatable insinvinv(:)
      allocatable pqrs(:,:,:,:)
      yw=.false.;yw=yw.or.ywtot
      
      
      
      allocate(iirs(isym(is),num1(isymoa(ks)+1)))
      allocate(pqii(isym(ks),num1(isymoa(is)+1)))
      allocate(abrs(num1(noacs(is)+1),num1(isymoa(ks)+1)))
      allocate(pqab(num1(noacs(ks)+1),num1(isymoa(is)+1)))
      allocate(aqbs(noacs(is),noacs(ks),isymoa(is)*isymoa(ks)))
      ii=lblock
      om1(1:isymoa(is),1:isym(is))=om(1:isymoa(is),1:isym(is),is)
      om2(1:isymoa(ks),1:isym(ks))=om(1:isymoa(ks),1:isym(ks),ks)
C      print*,'om1'
C      call mscript(om1(1:isymoa(is),1:isym(is)))
C      print*,'om2'
C      call mscript(om2(1:isymoa(ks),1:isym(ks)))
      iirs=0.d0
      pqii=0.d0
      abrs=0.d0
      pqab=0.d0
      aqbs=0.d0
      parb=0.d0
      yt=.true.
C      if(yt) then
C         allocate(insinvinv(norb))
C         do k=1,norb
C            insinvinv(insinv(k))=k
C         enddo
C         allocate
C     *   (pqrs(isymoa(is),isymoa(js),isymoa(ks),isymoa(ls)))
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(q,p,r,s)=vv
C            pqrs(p,q,s,r)=vv
C            pqrs(q,p,s,r)=vv
C            pqrs(r,s,p,q)=vv
C            pqrs(s,r,p,q)=vv
C            pqrs(r,s,q,p)=vv
C            pqrs(s,r,q,p)=vv
C         enddo
C         ii=lblock
C        print*,'is,js,ks,ls',is,js,ks,ls
C         do i=11,11
C            i_abs=ins(insinvinv(i)-sum(isym(1:is-1)))
C            do j=11,11
C               j_abs=ins(insinvinv(j)-sum(isym(1:js-1)))
C               do k=10,10
C                  k_abs=ins(insinvinv(k)-sum(isym(1:ks-1)))
C                  do l=10,10
C                     l_abs=ins(insinvinv(l)-sum(isym(1:ls-1)))
C                     ai=0.d0
C      print*,'i_abs,j_abs,k_abs,l_abs',i_abs,j_abs,k_abs,l_abs
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*om(p,i_abs,is)*om(q,j_abs,js)
C     *                           *om(r,k_abs,ks)*om(s,l_abs,ls)
C!         print'(a,4i4,7f12.8)','vv',p,q,r,s,vv,ai
C!     * ,om(p,i_abs,is),om(q,j_abs,js),om(r,k_abs,ks),om(s,l_abs,ls)
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
CC         AIiijv=0.d0
CC         do i=5,5,7
CC            i_abs=insinvinv(i)
CC            do j=12,12,7
CC               j_abs=insinvinv(j)
CC               do r=1,isymoa(is)
CC                  do s=1,isymoa(is)
CC                     ai=0.d0
CC                     do p=1,isymoa(is)
CC                        do q=1,isymoa(is)
CC                           vv=pqrs(p,q,r,s)
CC                           ai=ai+vv*om1(p,i_abs)*om1(q,j_abs)
CC                        enddo
CC                     enddo
CCC                           print'(4i4,f12.8,a)'
CCC        *                  ,i,j,r,s,ai,' AIJRS'
CC                  enddo
CC               enddo
CC      
CC               do q=1,isymoa(is)
CC                  do s=1,isymoa(is)
CC                     ai2=0.d0
CC                     do p=1,isymoa(is)
CC                        do r=1,isymoa(is)
CC                           vv=pqrs(p,q,r,s)
CC                           ai2=ai2+vv*om1(p,i_abs)*om1(r,j_abs)
CCC           if(i==5.and.q==3.and.j==5.and.s==3)print'(a,2f12.8,4i4)',
CCC        *  'Aiqjs',vv*om1(p,i_abs)*om1(r,j_abs),ai2,p,q,r,s
CC                        enddo
CC                     enddo
CC                     if(q>=s)print'(4i4,f12.8,a)'
CC     *               ,i,q,j,s,ai2,' AIQJS'
CC                     aiiijv=aiiijv+ai2*om1(q,7)*om1(s,7)
CC                     print'(4f12.8,2i4,f12.8,a)',ai2*om1(q,7)*om1(s,7)
CC     *               ,ai2,om1(q,7),om1(s,7),q,s,AIiijv,'aiiijv'
CC                  enddo
CC               enddo
CC               print*,'AIiijv',AIiijv
CC            enddo
CC         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=num1(p)+q
         pr=(p-1)*isymoa(ks)+r
         ps=(p-1)*isymoa(ks)+s
         qr=(q-1)*isymoa(ks)+r
         qs=(q-1)*isymoa(ks)+s
         rs=num1(r)+s
! Jiirs
         do i=1,inac(is)
            i_abs=numnonacs(i,is)
            del=vv*om1(p,i_abs)*om1(q,i_abs)
            if(p/=q) del=del+del
            iirs(i,rs)=iirs(i,rs)+del
         enddo
! Jpqii
         do i=1,inac(ks)
            i_abs=numnonacs(i,ks)
            del=vv*om2(r,i_abs)*om2(s,i_abs)
            if(r/=s) del=del+del
            pqii(i,pq)=pqii(i,pq)+del
         enddo
! abrs
         ab=0
         do al=1,noacs(is)
            al_a=numacs(al,is)
            do be=1,al
               be_a=numacs(be,is)
               ab=ab+1
               del=om1(p,al_a)*om1(q,be_a)
               if(p/=q) del=del+om1(q,al_a)*om1(p,be_a)
               abrs(ab,rs)=abrs(ab,rs)+del*vv
            enddo
         enddo
! pqab
         ab=0
         do al=1,noacs(ks)
            al_a=numacs(al,ks)
            do be=1,al
               be_a=numacs(be,ks)
               ab=ab+1
               del=om2(r,al_a)*om2(s,be_a)
               if(r/=s) del=del+om2(s,al_a)*om2(r,be_a)
               pqab(ab,pq)=pqab(ab,pq)+del*vv
            enddo
         enddo
! aqbs
         do al=1,noacs(is)
            al_a=numacs(al,is)
            do be=1,noacs(ks)
               be_a=numacs(be,ks)
               del=om1(p,al_a)*om2(r,be_a)
               aqbs(al,be,qs)=aqbs(al,be,qs)+del*vv
               if(r/=s) then
                  del=om1(p,al_a)*om2(s,be_a)
                  aqbs(al,be,qr)=aqbs(al,be,qr)+del*vv
               endif
               if(p/=q) then
                  del=om1(q,al_a)*om2(r,be_a)
                  aqbs(al,be,ps)=aqbs(al,be,ps)+del*vv
                  if(r/=s) then
                     del=om1(q,al_a)*om2(s,be_a)
                     aqbs(al,be,pr)=aqbs(al,be,pr)+del*vv
                  endif
               endif
            enddo
         enddo
      enddo
! 1. iijj
! 3. iivv
         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,nononacs(ks)
               j_a=numnonacs(j,ks)
               jj_a=insinv(j_a)
               jj_abs=insinv(j_a+sum(isym(1:ks-1)))
               rs=0
               a_iijj=0.d0
               do r=1,isymoa(ks)
                  ifac=2
                  do s=1,r
                     rs=rs+1
                     if(r==s) ifac=1
                     del=iirs(i,rs)*om2(r,j_a)*om2(s,j_a)*ifac
                     a_iijj=a_iijj+del
                  enddo
               enddo
               call stoijkl(ii_abs,ii_abs,jj_abs,jj_abs,a_iijj,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIJJ',ii_abs,ii_abs,jj_abs,jj_abs,a_iijj
            enddo
         enddo
! 3. vvii
         do i=1,inac(ks)
            i_a=numnonacs(i,ks)
            ii_a=insinv(i_a)
            ii_abs=insinv(i_a+sum(isym(1:ks-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)))
               pq=0
               a_iijj=0.d0
               do p=1,isymoa(is)
                  ifac=2
                  do q=1,p
                     pq=pq+1
                     if(p==q) ifac=1
                     del=pqii(i,pq)*om1(p,v_a)*om1(q,v_a)*ifac
                     a_iijj=a_iijj+del
                  enddo
               enddo
               call stoijkl(vv_abs,vv_abs,ii_abs,ii_abs,a_iijj,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#VVII',vv_abs,vv_abs,ii_abs,ii_abs,a_iijj
            enddo
         enddo
! 2. iiab
         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(ks)
               al_a=numacs(al,ks)
               aal_a=insinv(al_a)
               aal_abs=insinv(al_a+sum(isym(1:ks-1)))
               do be=1,al
                  be_a=numacs(be,ks)
                  bbe_a=insinv(be_a)
                  bbe_abs=insinv(be_a+sum(isym(1:ks-1)))
                  rs=0
                  a_iiab=0.d0
                  do r=1,isymoa(ks)
                     do s=1,r
                        rs=rs+1
                        del=iirs(i,rs)*om2(r,al_a)*om2(s,be_a)
                        if(r/=s)
     *                  del=del+iirs(i,rs)*om2(s,al_a)*om2(r,be_a)
                        a_iiab=a_iiab+del
                     enddo
                  enddo
               call stoijkl(ii_abs,ii_abs,aal_abs,bbe_abs,a_iiab,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#IIAB',ii_abs,ii_abs,aal_abs,bbe_abs,a_iiab
               enddo
            enddo
         enddo
! 2. abii
         do i=1,inac(ks)
            i_a=numnonacs(i,ks)
            ii_a=insinv(i_a)
            ii_abs=insinv(i_a+sum(isym(1:ks-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)))
                  rs=0
                  a_iiab=0.d0
                  do r=1,isymoa(is)
                     do s=1,r
                        rs=rs+1
                        del=pqii(i,rs)*om1(r,al_a)*om1(s,be_a)
                        if(r/=s)
     *                  del=del+pqii(i,rs)*om1(s,al_a)*om1(r,be_a)
                        a_iiab=a_iiab+del
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,ii_abs,ii_abs,a_iiab,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#ABII',aal_abs,bbe_abs,ii_abs,ii_abs,a_iiab
               enddo
            enddo
         enddo
! 4. abvv
! 7. abiv
         ab=0
         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
               ab=ab+1
               be_a=numacs(be,is)
               bbe_a=insinv(be_a)
               bbe_abs=insinv(be_a+sum(isym(1:is-1)))
               do v=inac(ks)+1,nononacs(ks)
                  v_a=numnonacs(v,ks)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:ks-1)))
                  rs=0
                  a_abvv=0.d0
!       4. abvv
                  do r=1,isymoa(ks)
                     do s=1,r
                        rs=rs+1
                        del=om2(r,v_a)*om2(s,v_a)
                        if(r/=s) del=del+del
                        a_abvv=a_abvv+del*abrs(ab,rs)
                     enddo
                  enddo
               call stoijkl(aal_abs,bbe_abs,vv_abs,vv_abs,a_abvv,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#ABVV',aal_abs,bbe_abs,vv_abs,vv_abs,a_abvv
!        7. abiv
                  do i=1,inac(ks)
                     i_a=numnonacs(i,ks)
                     ii_a=insinv(i_a)
                     ii_abs=insinv(i_a+sum(isym(1:ks-1)))
                     rs=0
                     a_abvi=0.d0
                     do r=1,isymoa(ks)
                        do s=1,r
                           rs=rs+1
                           del1=om2(r,i_a)*om2(s,v_a)
                           if(r/=s) then
                              del2=om2(r,v_a)*om2(s,i_a)
                              del=del1+del2
                           else
                              del=del1
                           endif
                           a_abvi=a_abvi+del*abrs(ab,rs)
                        enddo
                     enddo
                        if(al>=be) then
               call stoijkl(aal_abs,bbe_abs,vv_abs,ii_abs,a_abvi,72)
                        endif
                     if(yw) then
                        if(al>=be) then
                           print'(a,4i4,2f12.8)','#ABVI'
     *                     ,aal_abs,bbe_abs,vv_abs,ii_abs,a_abvi
                        endif
                     endif
                  enddo
               enddo
            enddo
         enddo
! 4. vvab
! 7. viab
         ab=0
         do al=1,noacs(ks)
            al_a=numacs(al,ks)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:ks-1)))
            do be=1,al
               ab=ab+1
               be_a=numacs(be,ks)
               bbe_a=insinv(be_a)
               bbe_abs=insinv(be_a+sum(isym(1:ks-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)))
!       4. vvab
                  pq=0
                  a_abvv=0.d0
                  do p=1,isymoa(is)
                     do q=1,p
                        pq=pq+1
                        del=om1(p,v_a)*om1(q,v_a)
                        if(p/=q) del=del+del
                        a_abvv=a_abvv+del*pqab(ab,pq)
                     enddo
                  enddo
               call stoijkl(vv_abs,vv_abs,aal_abs,bbe_abs,a_abvv,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#VVAB',vv_abs,vv_abs,aal_abs,bbe_abs,a_abvv
!        7. viab
                  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_abvi=0.d0
                     do r=1,isymoa(is)
                        do s=1,r
                           rs=rs+1
                           del1=om1(r,i_a)*om1(s,v_a)
                           if(r/=s) then
                              del2=om1(r,v_a)*om1(s,i_a)
                              del=del1+del2
                           else
                              del=del1
                           endif
                           a_abvi=a_abvi+del*pqab(ab,rs)
                        enddo
                     enddo
                        if(al>=be) then
               call stoijkl(vv_abs,ii_abs,aal_abs,bbe_abs,a_abvi,72)
                        endif
                     if(yw) then
                        if(al>=be) then
                           print'(a,4i4,2f12.8)','#VIAB'
     *                     ,vv_abs,ii_abs,aal_abs,bbe_abs,a_abvi
                        endif
                     endif
                  enddo
               enddo
            enddo
         enddo
! 7. aibv
      call aibv_avbi(is,ks,om1,om2,aqbs,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,
     *noacs(is),noacs(ks),msymoa,ywtot,msym)
! 5. abcd
! 9. abcv
! 11. abci
         call abcd_abcv_abci(is,ks,om1,om2,abrs,noacs,numacs,insinv
     *   ,isym,isymoa,inac,nononacs,numnonacs,
     *   maxorbcas,nsym,num1(noacs(is)+1),msymoa,ywtot,msym)
         call abcd_abcv_abci(ks,is,om2,om1,pqab,noacs,numacs,insinv
     *   ,isym,isymoa,inac,nononacs,numnonacs,
     *   maxorbcas,nsym,num1(noacs(ks)+1),msymoa,ywtot,msym)
*! 6.  (iijv)  (ivjj)
         call iijv(is,ks,om1,om2,iirs,noacs,numacs,insinv
     *   ,isym,isymoa,inac,nononacs,numnonacs,
     *   maxorbcas,nsym,isym(is),msymoa,ywtot,msym)
         call iijv(ks,is,om2,om1,pqii,noacs,numacs,insinv
     *   ,isym,isymoa,inac,nononacs,numnonacs,
     *   maxorbcas,nsym,isym(ks),msymoa,ywtot,msym)
*! 8. iiav
*! 10.  iija
         call iiav_iija(is,ks,om1,om2,iirs,noacs,numacs,insinv
     *   ,isym,isymoa,inac,nononacs,numnonacs,
     *   maxorbcas,nsym,isym(is),msymoa,ywtot,msym)
*! 8. avii
*! 10. iajj
         call iiav_iija(ks,is,om2,om1,pqii,noacs,numacs,insinv
     *   ,isym,isymoa,inac,nononacs,numnonacs,
     *   maxorbcas,nsym,isym(ks),msymoa,ywtot,msym)
      deallocate(iirs,pqii,abrs)
      return
      end
       subroutine aibv_avbi(is,ks,om1,om2,aqbs,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 aqbs(iaqbs1,iaqbs2,*),isym(*),isymoa(*),inac(*)
      dimension nononacs(*),numnonacs(msym,nsym)
      dimension om1(msymoa,*),om2(msymoa,*)
      integer vv_abs,vv_a,v_a,al,al_a,aal_a,aal_abs,be_a,bbe_a,bbe_abs
      yw=.false.;yw=yw.or.ywtot
      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(ks)
            be_a=numacs(be,ks)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:ks-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)))
               do v=inac(ks)+1,nononacs(ks)
                  v_a=numnonacs(v,ks)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:ks-1)))
                  qs=0
                  a_aibv=0.d0
                  do q=1,isymoa(is)
                     do s=1,isymoa(ks)
                        qs=qs+1
                        del=om1(q,i_a)*om2(s,v_a)
                        a_aibv=a_aibv+del*aqbs(al,be,qs)
                     enddo
                  enddo
               call stoijkl(aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#AIBV',aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv
               enddo
            enddo
            do i=1,inac(ks)
               i_a=numnonacs(i,ks)
               ii_a=insinv(i_a)
               ii_abs=insinv(i_a+sum(isym(1:ks-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_aibv=0.d0
                  do q=1,isymoa(is)
                     do s=1,isymoa(ks)
                        qs=qs+1
                        del=om1(q,v_a)*om2(s,i_a)
                        a_aibv=a_aibv+del*aqbs(al,be,qs)
                     enddo
                  enddo
               call stoijkl(aal_abs,vv_abs,bbe_abs,ii_abs,a_aibv,72)
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#AVBI',aal_abs,vv_abs,bbe_abs,ii_abs,a_aibv
               enddo
            enddo
         enddo
      enddo
      return
      end



       subroutine abcd_abcv_abci(is,ks,om1,om2,abrs,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,iabrs,msymoa
     *,ywtot,msym)
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension noacs(*),insinv(*),numacs(maxorbcas,nsym)
      dimension abrs(iabrs,*),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
      if(yw)print*,'entree abcd_abcv_abci is,ks',is,ks
      ab=0
      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
            ab=ab+1
            be_a=numacs(be,is)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:is-1)))
            cd=0
            do ga=1,noacs(ks)
               ga_a=numacs(ga,ks)
               gga_a=insinv(ga_a)
               gga_abs=insinv(ga_a+sum(isym(1:ks-1)))
!     5.
               if(is>ks) then
               do de=1,ga
                  de_a=numacs(de,ks)
                  dde_a=insinv(de_a)
                  dde_abs=insinv(de_a+sum(isym(1:ks-1)))
                  a_abcd=0.d0
                  rs=0
                  do r=1,isymoa(ks)
                     do s=1,r
                        rs=rs+1
                        del=abrs(ab,rs)*om2(r,ga_a)*om2(s,de_a)
                        if(r/=s) del=del+
     *                  abrs(ab,rs)*om2(r,de_a)*om2(s,ga_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(ks)+1,nononacs(ks)
                  v_a=numnonacs(v,ks)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:ks-1)))
                  a_abcv=0.d0
                  rs=0
                  do r=1,isymoa(ks)
                     do s=1,r
                        rs=rs+1
                        del=om2(r,ga_a)*om2(s,v_a)
                        if(r/=s) del=del+om2(r,v_a)*om2(s,ga_a)
                        a_abcv=a_abcv+del*abrs(ab,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. abci
               do i=1,inac(ks)
                  i_a=numnonacs(i,ks)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:ks-1)))
                  a_abci=0.d0
                  rs=0
                  do r=1,isymoa(ks)
                     do s=1,r
                        rs=rs+1
                        del=om2(r,ga_a)*om2(s,i_a)
                        if(r/=s) del=del+om2(r,i_a)*om2(s,ga_a)
                        a_abci=a_abci+del*abrs(ab,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
         enddo
      enddo
      return
      end
       subroutine iijv(is,ks,om1,om2,iirs,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,iiirs,msymoa
     *,ywtot,msym)
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension noacs(*),insinv(*),numacs(maxorbcas,nsym)
      dimension iirs(iiirs,*),isym(*),isymoa(*),inac(*)
      dimension nononacs(*),numnonacs(msym,nsym)
      dimension om1(msymoa,*),om2(msymoa,*)
      integer vv_abs,vv_a,v_a
      real(8) iirs
      yw=.false.;yw=yw.or.ywtot
! 6.  (iijv)
      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(ks)
            j_a=numnonacs(j,ks)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:ks-1)))
            do v=inac(ks)+1,nononacs(ks)
               v_a=numnonacs(v,ks)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:ks-1)))
               rs=0
               a_iijv=0.d0
               do r=1,isymoa(ks)
                  do s=1,r
                     rs=rs+1
                     del=iirs(i,rs)*om2(r,j_a)*om2(s,v_a)
                     if(r/=s) del=del+
     *               iirs(i,rs)*om2(r,v_a)*om2(s,j_a)
                     a_iijv=a_iijv+del
                  enddo
               enddo
               call stoijkl(vv_abs,jj_abs,ii_abs,ii_abs,a_iijv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIJV',vv_abs,jj_abs,ii_abs,ii_abs,a_iijv
            enddo
         enddo
      enddo
      return
      end
       subroutine iiav_iija(is,ks,om1,om2,iirs,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,maxorbcas,nsym,iiirs,msymoa
     *,ywtot,msym)
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension noacs(*),insinv(*),numacs(maxorbcas,nsym)
      dimension iirs(iiirs,*),isym(*),isymoa(*),inac(*)
      dimension nononacs(*),numnonacs(msym,nsym)
      dimension om1(msymoa,*),om2(msymoa,*)
      integer vv_abs,vv_a,v_a,al,al_a,aal_a,aal_abs
      real(8) iirs
      yw=.false.;yw=yw.or.ywtot
      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(ks)
            al_a=numacs(al,ks)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:ks-1)))
! 8. iiav  avii
            do v=inac(ks)+1,nononacs(ks)
               v_a=numnonacs(v,ks)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:ks-1)))
               rs=0
               a_iiav=0.d0
               do r=1,isymoa(ks)
                  do s=1,r
                     rs=rs+1
                     del=om2(r,al_a)*om2(s,v_a)
                     if(r/=s) del=del+om2(r,v_a)*om2(s,al_a)
                     a_iiav=a_iiav+del*iirs(i,rs)
                  enddo
               enddo
               call stoijkl(vv_abs,aal_abs,ii_abs,ii_abs,a_iiav,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIAV',vv_abs,aal_abs,ii_abs,ii_abs,a_iiav
            enddo
! 10.  iija  iajj
            do j=1,inac(ks)
               j_a=numnonacs(j,ks)
               jj_a=insinv(j_a)
               jj_abs=insinv(j_a+sum(isym(1:ks-1)))
               rs=0
               a_iiaj=0.d0
               do r=1,isymoa(ks)
                  do s=1,r
                     rs=rs+1
                     del=om2(r,al_a)*om2(s,j_a)
                     if(r/=s) del=del+om2(r,j_a)*om2(s,al_a)
                     a_iiaj=a_iiaj+del*iirs(i,rs)
                  enddo
               enddo
               call stoijkl(aal_abs,jj_abs,ii_abs,ii_abs,a_iiaj,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIAJ',aal_abs,jj_abs,ii_abs,ii_abs,a_iiaj
            enddo
         enddo
      enddo
      return
      end
