      subroutine tijkl_saiiii
      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,iris,abrs
      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 al_abs,be_abs,aal_abs,bbe_abs,vv_abs
      integer ga_abs,gga_abs,de_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(is)+1)))
      allocate(iris(isym(is),num1(isymoa(is)+1)))
      allocate(abrs(num1(noacs(is)+1),num1(isymoa(is)+1)))
      allocate(aqbs(noacs(is),noacs(is),num1(isymoa(is)+1)))
      ii=lblock
      om1(1:isymoa(is),1:isym(is))=om(1:isymoa(is),1:isym(is),is)
      iirs=0.d0
      iris=0.d0
      abrs=0.d0
      aqbs=0.d0
!      aqbsc=0.d0
C      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(is),isymoa(is),isymoa(is)))
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         do i=11,11
C            iz=itsymoa(i)
C            i_abs=ins(insinvinv(i)-sum(isym(1:iz-1)))
C            do j=11,11
C               jz=itsymoa(j)
C               j_abs=ins(insinvinv(j)-sum(isym(1:jz-1)))
C               do k=11,11
C                  kz=itsymoa(k)
C                  k_abs=ins(insinvinv(k)-sum(isym(1:kz-1)))
C                  do l=11,11
C                     lz=itsymoa(l)
C                     l_abs=ins(insinvinv(l)-sum(isym(1:lz-1)))
C                     ai=0.d0
C                     do p=1,isymoa(iz)
C                        do q=1,isymoa(jz)
C                           do r=1,isymoa(kz)
C                              do s=1,isymoa(lz)
C                                 vv=pqrs(p,q,r,s)
C                                 ai=ai+vv*om(p,i_abs,iz)*om(q,j_abs,jz)
C     *                           *om(r,k_abs,kz)*om(s,l_abs,lz)
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         AIiijv=0.d0
C         do i=5,5,7
C            i_abs=insinvinv(i)
C            do j=12,12,7
C               j_abs=insinvinv(j)
C               do r=1,isymoa(is)
C                  do s=1,isymoa(is)
C                     ai=0.d0
C                     do p=1,isymoa(is)
C                        do q=1,isymoa(is)
C                           vv=pqrs(p,q,r,s)
C                           ai=ai+vv*om1(p,i_abs)*om1(q,j_abs)
C                        enddo
C                     enddo
CC                           print'(4i4,f12.8,a)'
CC        *                  ,i,j,r,s,ai,' AIJRS'
C                  enddo
C               enddo
C
C               do q=1,isymoa(is)
C                  do s=1,isymoa(is)
C                     ai2=0.d0
C                     do p=1,isymoa(is)
C                        do r=1,isymoa(is)
C                           vv=pqrs(p,q,r,s)
C                           ai2=ai2+vv*om1(p,i_abs)*om1(r,j_abs)
CC           if(i==5.and.q==3.and.j==5.and.s==3)print'(a,2f12.8,4i4)',
CC        *  'Aiqjs',vv*om1(p,i_abs)*om1(r,j_abs),ai2,p,q,r,s
C                        enddo
C                     enddo
C                     if(q>=s)print'(4i4,f12.8,a)'
C     *               ,i,q,j,s,ai2,' AIQJS'
C                     aiiijv=aiiijv+ai2*om1(q,7)*om1(s,7)
C                     print'(4f12.8,2i4,f12.8,a)',ai2*om1(q,7)*om1(s,7)
C     *               ,ai2,om1(q,7),om1(s,7),q,s,AIiijv,'aiiijv'
C                  enddo
C               enddo
C               print*,'AIiijv',AIiijv
C            enddo
C         enddo
C         rewind 11
C         deallocate(pqrs,insinvinv)
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=num1(p)+r
         ps=num1(p)+s
         qr=num1(max(q,r))+min(q,r)
         qs=num1(max(q,s))+min(q,s)
         rs=num1(r)+s
         do i=1,inac(is)
            i_abs=numnonacs(i,is)
! Jiirs
            del=vv*om1(p,i_abs)*om1(q,i_abs)
            if(p/=q) del=del+del
            iirs(i,rs)=iirs(i,rs)+del
            !print'(a,4i4,f12.8)','1iirs',i,r,s,rs,iirs(i,rs)
            if(pq/=rs) then
               del=vv*om1(r,i_abs)*om1(s,i_abs)
               if(r/=s) del=del+del
               iirs(i,pq)=iirs(i,pq)+del
            !print'(a,4i4,f12.8)','2iirs',i,p,q,pq,iirs(i,pq)
            endif
! Kiris
            if(q>=s)
     *      iris(i,qs)=iris(i,qs)+vv*om1(p,i_abs)*om1(r,i_abs)
            if(r/=s.and.q>=r) iris(i,qr)=iris(i,qr)+vv
     *      *om1(p,i_abs)*om1(s,i_abs)
            if(p/=q) then
               iris(i,ps)=iris(i,ps)+vv
     *         *om1(q,i_abs)*om1(r,i_abs)
               if(r/=s) iris(i,pr)=iris(i,pr)+vv
     *         *om1(q,i_abs)*om1(s,i_abs)
            endif
            if(pq==rs) cycle
            if(s>=q)
     *      iris(i,qs)=iris(i,qs)+vv*om1(r,i_abs)*om1(p,i_abs)
            if(r/=s.and.r>=q) iris(i,qr)=iris(i,qr)+vv
     *      *om1(s,i_abs)*om1(p,i_abs)
            if(p/=q) then
               if(r/=s.and.r>=p)
     *         iris(i,pr)=iris(i,pr)+vv
     *         *om1(q,i_abs)*om1(s,i_abs)
            endif
         enddo
         ab=0
         do al=1,noacs(is)
            al_a=numacs(al,is)
            do be=1,noacs(is)
               be_a=numacs(be,is)
               if(al>=be) ab=ab+1
! abrs
               if(al>=be) then
                  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
                  if(pq/=rs) then
                     del=om1(r,al_a)*om1(s,be_a)
                     if(r/=s) del=del+om1(s,al_a)*om1(r,be_a)
                     abrs(ab,pq)=abrs(ab,pq)+del*vv
                  endif
               endif
! aqbs
      !print*,'int lue',p,q,r,s,aqbs(1,6)
C          yab=al==1.and.be==1
               if(q>=s)aqbs(al,be,qs)=aqbs(al,be,qs)+
     *         vv*om1(p,al_a)*om1(r,be_a)
C         if(yab.and.qs==6.and.q>=s)print'(a,2f12.8,6i4)','aqbs1',
C     *    vv*om1(p,al_a)*om1(r,be_a),aqbs(al,be,qs),p,r,q,s
               if(p/=q) aqbs(al,be,ps)=aqbs(al,be,ps)+vv
     *         *om1(q,al_a)*om1(r,be_a)
C          if(p/=q.and.yab.and.ps==6)print'(a,2f12.8,6i4)','aqbs2',
C     *    vv*om1(q,al_a)*om1(r,be_a),aqbs(al,be,ps),q,r,p,s
               if(r/=s) then
                  if(q>=r)aqbs(al,be,qr)=aqbs(al,be,qr)+vv
     *            *om1(p,al_a)*om1(s,be_a)
C          if(yab.and.qr==6.and.q>=r)print'(a,2f12.8,6i4)','aqbs3',
C     *    vv*om1(p,al_a)*om1(s,be_a),aqbs(al,be,qr),p,s,q,r
                  if(p/=q) aqbs(al,be,pr)=aqbs(al,be,pr)+vv
     *            *om1(q,al_a)*om1(s,be_a)
C          if(p/=q.and.yab.and.pr==6)print'(a,2f12.8,6i4)','aqbs4',
C     *    vv*om1(q,al_a)*om1(s,be_a),aqbs(al,be,pr),r,s,p,q
               endif
               if(pq==rs) cycle
               if(s>=q)aqbs(al,be,qs)=aqbs(al,be,qs)+
     *         vv*om1(r,al_a)*om1(p,be_a)
!C          if(yab.and.qs==6.and.s>=q)print'(a,2f12.8,6i4)','aqbs5',
!C     *    vv*om1(r,al_a)*om1(p,be_a),aqbs(al,be,qs),r,p,q,s
!               if(p/=q) aqbs(al,be,ps)=aqbs(al,be,ps)+vv
!     *         *om1(r,al_a)*om1(q,be_a)
!          if(p/=q.and.yab.and.ps==2)print'(a,2f12.8,6i4)','aqbs6',
!     *    vv*om1(r,al_a)*om1(q,be_a),aqbs(al,be,ps),r,q,p,s
               if(r/=s) then
                  if(r>=q)aqbs(al,be,qr)=aqbs(al,be,qr)+vv
     *            *om1(s,al_a)*om1(p,be_a)
C          if(yab.and.qr==6.and.r>=q)print'(a,2f12.8,6i4)','aqbs7',
C     *    vv*om1(s,al_a)*om1(p,be_a),aqbs(al,be,qr),s,p,q,r
                  if(p/=q.and.r>=p)
     *            aqbs(al,be,pr)=aqbs(al,be,pr)+vv
     *            *om1(s,al_a)*om1(q,be_a)
C          if(p/=q.and.yab.and.pr==6.and.r>=p)
C     *    print'(a,2f12.8,6i4)','aqbs8',
C     *    vv*om1(s,al_a)*om1(q,be_a),aqbs(al,be,pr),s,q,p,r
               endif
!  aqbsc
!                        aqbsc(ab,q,s)=aqbsc(ab,q,s)+
!     *                  vv*om1(p,al_a)*om1(r,be_a)
!                        if(p/=q) aqbsc(ab,p,s)=aqbsc(ab,p,s)+vv
!     *                  *om1(q,al_a)*om1(r,be_a)
!                        if(r/=s) then
!                           aqbsc(ab,q,r)=aqbsc(ab,q,r)+vv
!     *                     *om1(p,al_a)*om1(s,be_a)
!                           if(p/=q) aqbsc(ab,p,r)=aqbsc(ab,p,r)+vv
!     *                     *om1(r,al_a)*om1(s,be_a)
!                        endif
!                        if(pq==rs) cycle
!                        aqbsc(ab,s,q)=aqbsc(ab,s,q)+
!     *                  vv*om1(r,al_a)*om1(p,be_a)
!                        if(p/=q) aqbsc(ab,s,p)=aqbsc(ab,s,p)+vv
!     *                  *om1(r,al_a)*om1(q,be_a)
!                        if(r/=s) then
!                           aqbsc(ab,r,q)=aqbsc(ab,r,q)+vv
!     *                     *om1(s,al_a)*om1(p,be_a)
!                           if(p/=q) aqbsc(ab,r,p)=aqbsc(ab,r,p)+vv
!     *                     *om1(s,al_a)*om1(q,be_a)
!                        endif
!                     enddo
            enddo
         enddo
      enddo
!               !print*,'aqbsc'
!               !call mscript(aqbsc(1,:,:))
         !do r=1,isymoa(is)
         !do s=1,r
         !   rs=(r-1)*r/2+s
           !print'(a,4i4,f12.8)','iirs',1,1,r,s,iirs(1,rs)
            !print'(a,3i4,f12.8)','i,r,s,iris',1,r,r,iris(1,rs)
           !print'(a,4i4,f12.8)','a,b,r,s,abrs',5,5,r,s,abrs(1,rs)
          !print'(a,4i4,f12.8)','a,b,r,s,abrs',12,5,r,s,abrs(2,rs)
           !print'(a,4i4,f12.8)','a,q,b,s,AqBs',5,r,5,s,aqbs(1,1,rs)
          !print'(4i4,f12.8,a)',5,r,12,s,aqbs(1,2,rs),' a,q,b,s,aqbs'
          !print'(4i4,f12.8,a)',12,r,5,s,aqbs(2,1,rs),' a,q,b,s,aqbs'
         !enddo
         !enddo
! the block of pqrs integrals of sym is is is is was read
! tables iirs... were filled
! 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. iijj  ijij
! 3. iivv  iviv
      if(yw)print*,'section  iijj  ijij iivv  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)))
         do j=i,nononacs(is)
            j_a=numnonacs(j,is)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:is-1)))
            rs=0
            a_iijj=0.d0
            a_ijij=0.d0
            do r=1,isymoa(is)
               ifac=2
               do s=1,r
                  rs=rs+1
                  if(r==s) ifac=1
                  del=iirs(i,rs)*om1(r,j_a)*om1(s,j_a)*ifac
                  a_iijj=a_iijj+del
C         print'(a,5i3,3f12.8)',
C     *   'iirs',i,rs,r,s,j_a,iirs(i,rs),om1(r,j_a),om1(s,j_a)
                  if(i==j) cycle
                  del=iris(i,rs)*om1(r,j_a)*om1(s,j_a)*ifac
                  a_ijij=a_ijij+del
               enddo
            enddo
            call stoijkl(ii_abs,ii_abs,jj_abs,jj_abs,a_iijj,72)
            if(ii_abs/=jj_abs)
     *      call stoijkl(ii_abs,jj_abs,ii_abs,jj_abs,a_ijij,72)
            if(yw) then
               print'(a,4i4,2f12.8)',
     *         '#IIJJ',ii_abs,ii_abs,jj_abs,jj_abs,a_iijj
               if(ii_abs/=jj_abs) print'(a,4i4,2f12.8)',
     *         '#IJIJ',ii_abs,jj_abs,ii_abs,jj_abs,
     *         a_ijij
            endif
         enddo
      enddo
      if(yw)print*,'section  iiaa iaia'
! 2. iiaa iaia
      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,noacs(is)
            j_a=numacs(j,is)
            jj_a=insinv(j_a)
            jj_abs=insinv(j_a+sum(isym(1:is-1)))
            rs=0
            a_iijj=0.d0
            a_ijij=0.d0
            do r=1,isymoa(is)
               ifac=2
               do s=1,r
                  rs=rs+1
                  if(r==s) ifac=1
                  del=iirs(i,rs)*om1(r,j_a)*om1(s,j_a)*ifac
                  a_iijj=a_iijj+del
                  del=iris(i,rs)*om1(r,j_a)*om1(s,j_a)*ifac
                  a_ijij=a_ijij+del
               enddo
            enddo
            call stoijkl(ii_abs,ii_abs,jj_abs,jj_abs,a_iijj,72)
            call stoijkl(ii_abs,jj_abs,ii_abs,jj_abs,a_ijij,72)
            if(yw) then
               print'(a,4i4,2f12.8)',
     *         '#IIAA',ii_abs,ii_abs,jj_abs,jj_abs,a_iijj
               print'(a,4i4,2f12.8)',
     *         '#IAIA',ii_abs,jj_abs,ii_abs,jj_abs,a_ijij
            endif
         enddo
      enddo
! 2. iiab iaib  a/=b
      if(yw)print*,'section  iiab iaib  a/=b'
      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(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-1
               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
               a_iaib=0.d0
               do r=1,isymoa(is)
                  do s=1,r
                     rs=rs+1
                     del=iirs(i,rs)*om1(r,al_a)*om1(s,be_a)
                     if(r/=s)
     *               del=del+iirs(i,rs)*om1(s,al_a)*om1(r,be_a)
                     a_iiab=a_iiab+del
                     del=iris(i,rs)*om1(r,al_a)*om1(s,be_a)
                     if(r/=s)
     *               del=del+iris(i,rs)*om1(s,al_a)*om1(r,be_a)
                     a_iaib=a_iaib+del
                  enddo
               enddo
            call stoijkl(ii_abs,ii_abs,aal_abs,bbe_abs,a_iiab,72)
            call stoijkl(ii_abs,aal_abs,ii_abs,bbe_abs,a_iaib,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIAB',ii_abs,ii_abs,aal_abs,bbe_abs,a_iiab
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IAIB',ii_abs,aal_abs,ii_abs,bbe_abs,a_iaib
            enddo
         enddo
      enddo
      if(yw)print*,'section  vvab vavb  abir aibv'
! 4. vvab vavb
! 7. abir aibv
      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,noacs(is)
            if(al>=be) then
               ab=ab+1
            else
               ab1=num1(be)+al
            endif
            be_a=numacs(be,is)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_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)))
               rs=0
               a_vvab=0.d0
               a_vavb=0.d0
!       4.
               if(al>=be) then
                  do r=1,isymoa(is)
                     do s=1,r
                        rs=rs+1
                        del1=om1(r,v_a)*om1(s,v_a)
                        if(r/=s) then
                           del=del1+del1
                        else
                           del=del1
                        endif
                        a_vvab=a_vvab+del*abrs(ab,rs)
                        if(r==s) then
                           del1=del1*aqbs(al,be,rs)
                        else
                           del1=del1*
     *                     (aqbs(al,be,rs)+aqbs(be,al,rs))
                        endif
                        a_vavb=a_vavb+del1
C      if(al==2.and.be==1.and.v==inac(is)+1)
C     *print'(4f12.8,2i4,f12.8,a)',
C     *aqbs(al,be,rs)*om1(r,v_a)*om1(s,v_a)
C     * ,aqbs(al,be,rs),om1(r,v_a),om1(s,v_a),r,s,a_vavb,'aaqbs'
C      if(r/=s.and.al==2.and.be==1.and.v==inac(is)+1)
C     *print'(4f12.8,2i4,f12.8,a)',
C     *aqbs(al,be,rs)*om1(r,v_a)*om1(s,v_a)
C     * ,aqbs(al,be,rs),om1(r,v_a),om1(s,v_a),r,s,a_vavb,'aaqbs'
                     enddo
                  enddo
            call stoijkl(vv_abs,vv_abs,aal_abs,bbe_abs,a_vvab,72)
            call stoijkl(vv_abs,aal_abs,vv_abs,bbe_abs,a_vavb,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)',
     *               '#VVAB',vv_abs,vv_abs,aal_abs,bbe_abs,a_vvab
                     print'(a,4i4,2f12.8)',
     *               '#VAVB',vv_abs,aal_abs,vv_abs,bbe_abs,a_vavb
                  endif
               endif
!        7.
               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_viab=0.d0
                  a_aibv=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
                        if(al>=be) then
                           a_viab=a_viab+del*abrs(ab,rs)
                        endif
                        if(r/=s) then
                           del=del1*aqbs(al,be,rs)
     *                     +del2*aqbs(be,al,rs)
                        else
                           del=del1*aqbs(al,be,rs)
                        endif
                        a_aibv=a_aibv+del
C     if(al==1.and.be==1.and.i==1.and.v==inac(is)+1)
C    *print'(a,4f12.8,2i4,f12.8)',
C    *'aaqbs',aqbs(al,be,rs)*om1(r,i_a)*om1(s,v_a)
C    * ,aqbs(al,be,rs),om1(r,i_a),om1(s,v_a),r,s,a_aibv
C     if(r/=s.and.al==1.and.be==1.and.i==1.and.v==inac(is)+1)
C    *print'(a,4f12.8,2i4,f12.8)',
C    *'aaqbs',aqbs(al,be,rs)*om1(r,v_a)*om1(s,i_a)
C    * ,aqbs(al,be,rs),om1(r,v_a),om1(s,i_a),r,s,a_aibv
                     enddo
                  enddo
                  if(al>=be)
     *      call stoijkl(vv_abs,ii_abs,aal_abs,bbe_abs,a_viab,72)
            call stoijkl(aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv,72)
                  if(yw) then
                     if(al>=be) then
                        print'(a,4i4,2f12.8)','#VIAB'
     *                  ,vv_abs,ii_abs,aal_abs,bbe_abs,a_viab
                     endif
                     print'(a,4i4,2f12.8)','#AIBV'
     *               ,aal_abs,ii_abs,bbe_abs,vv_abs,a_aibv
                  endif
               enddo
            enddo
         enddo
      enddo
! 5. abcd
! 9. abcv
! 11. iabc
      if(yw)print*,'section  abcd abcv iabc'
      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(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=ga
                  if(al==ga) ifin=be
                  do de=1,ifin
                     de_a=numacs(de,is)
                     dde_a=insinv(de_a)
                     dde_abs=insinv(de_a+sum(isym(1:is-1)))
                     a_abcd=0.d0
                     rs=0
                     do r=1,isymoa(is)
                        do s=1,r
                           rs=rs+1
                           del=abrs(ab,rs)*om1(r,ga_a)*om1(s,de_a)
                           if(r/=s) del=del+
     *                     abrs(ab,rs)*om1(r,de_a)*om1(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(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,r
                        rs=rs+1
                        del=om1(r,ga_a)*om1(s,v_a)
                        if(r/=s) del=del+om1(r,v_a)*om1(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.
               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,r
                        rs=rs+1
                        del=om1(r,ga_a)*om1(s,i_a)
                        if(r/=s) del=del+om1(r,i_a)*om1(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
! 6. (ijiv)  (iijv)
      if(yw)print*,'section  ijiv 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(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)))
               rs=0
               a_iijv=0.d0
               a_ijiv=0.d0
               do r=1,isymoa(is)
                  do s=1,r
                     rs=rs+1
                     del=iirs(i,rs)*om1(r,j_a)*om1(s,v_a)
                     if(r/=s) del=del+
     *               iirs(i,rs)*om1(r,v_a)*om1(s,j_a)
                     a_iijv=a_iijv+del
                     if(i/=j) then
                        del=iris(i,rs)*om1(r,j_a)*om1(s,v_a)
C       if(i==1.and.j==1.and.vv_a==13)print'(a,f12.8,2i4,3f12.8,2i4)',
C     * 'IIjv',del,r,s,iris(i,rs),om1(r,j_a),om1(s,v_a),j_a,v_a
                        if(r/=s) del=del+
     *                  iris(i,rs)*om1(r,v_a)*om1(s,j_a)
C       if(i==1.and.j==1.and.vv_a==13.and.r/=s)
C     * print'(a,f12.8,2i4,3f12.8,2i4)',
C     *'IIjv',iris(i,rs)*om1(r,v_a)*om1(s,j_a),r,s,
C     * iris(i,rs),om1(r,v_a),om1(s,j_a),j_a,v_a
                        a_ijiv=del+a_ijiv
                     endif
                  enddo
               enddo
            call stoijkl(vv_abs,jj_abs,ii_abs,ii_abs,a_iijv,72)
            if(i/=j)
     *      call stoijkl(vv_abs,ii_abs,jj_abs,ii_abs,a_ijiv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIJV',vv_abs,jj_abs,ii_abs,ii_abs,a_iijv
               if(yw.and.i/=j)print'(a,4i4,2f12.8)',
     *         '#IJIV',vv_abs,ii_abs,jj_abs,ii_abs,a_ijiv
            enddo
         enddo
      enddo
! 8. iiav  iaiv
! 10.  iija  iaij
      if(yw)print*,'section  iiav  iaiv iija  iaij'
      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(is)
            al_a=numacs(al,is)
            aal_a=insinv(al_a)
            aal_abs=insinv(al_a+sum(isym(1:is-1)))
!       8.
            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)))
               rs=0
               a_iiav=0.d0
               a_iaiv=0.d0
               do r=1,isymoa(is)
                  do s=1,r
                     rs=rs+1
                     del=om1(r,al_a)*om1(s,v_a)
                     if(r/=s) del=del+om1(r,v_a)*om1(s,al_a)
                     a_iiav=a_iiav+del*iirs(i,rs)
                     a_iaiv=a_iaiv+del*iris(i,rs)
                  enddo
               enddo
            call stoijkl(vv_abs,aal_abs,ii_abs,ii_abs,a_iiav,72)
            call stoijkl(vv_abs,ii_abs,aal_abs,ii_abs,a_iaiv,72)
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IIAV',vv_abs,aal_abs,ii_abs,ii_abs,a_iiav
               if(yw)print'(a,4i4,2f12.8)',
     *         '#IAIV',vv_abs,ii_abs,aal_abs,ii_abs,a_iaiv
            enddo
!      10.
            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)))
               rs=0
               a_iiaj=0.d0
               a_iaij=0.d0
               do r=1,isymoa(is)
                  do s=1,r
                     rs=rs+1
                     del=om1(r,al_a)*om1(s,j_a)
                     if(r/=s) del=del+om1(r,j_a)*om1(s,al_a)
                     a_iiaj=a_iiaj+del*iirs(i,rs)
                     if(i/=j) a_iaij=a_iaij+del*iris(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
               if(i/=j) then
                  if(yw)print'(a,4i4,2f12.8)',
     *            '#IAIJ',aal_abs,ii_abs,jj_abs,ii_abs,a_iaij
                   call stoijkl(aal_abs,ii_abs,jj_abs,ii_abs,a_iaij,72)
               endif
            enddo
         enddo
      enddo
      deallocate(iirs,iris,abrs,aqbs)
      return
      end
