      subroutine tijkl_saijkl
      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(:,:) :: abrs12,abrs34
      real(8),allocatable,dimension(:,:) :: abrs13,abrs24
      real(8),allocatable,dimension(:,:) :: abrs14,abrs23
      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
      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(abrs12(noacs(is)*noacs(js),isymoa(ks)*isymoa(ls)))
      allocate(abrs34(noacs(ks)*noacs(ls),isymoa(is)*isymoa(js)))
      allocate(abrs13(noacs(is)*noacs(ks),isymoa(js)*isymoa(ls)))
      allocate(abrs14(noacs(is)*noacs(ls),isymoa(js)*isymoa(ks)))
      allocate(abrs23(noacs(js)*noacs(ks),isymoa(is)*isymoa(ls)))
      allocate(abrs24(noacs(js)*noacs(ls),isymoa(is)*isymoa(ks)))
      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)
      om3(1:isymoa(ks),1:isym(ks))=om(1:isymoa(ks),1:isym(ks),ks)
      om4(1:isymoa(ls),1:isym(ls))=om(1:isymoa(ls),1:isym(ls),ls)
      
      abrs12=0
      abrs13=0
      abrs14=0
      abrs23=0
      abrs24=0
      abrs34=0
 
      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=(p-1)*isymoa(ks)+r
         ps=(p-1)*isymoa(ls)+s
         qr=(q-1)*isymoa(ks)+r
         qs=(q-1)*isymoa(ls)+s
         rs=(r-1)*isymoa(ls)+s
         call ijkl_abrs(is,js,noacs,numacs,om1,om2
     *   ,abrs12,maxorbcas,nsym,
     *   noacs(is)*noacs(js),msymoa,vv,p,q,rs,ywtot)
         call ijkl_abrs(ks,ls,noacs,numacs,om3,om4
     *   ,abrs34,maxorbcas,nsym,
     *   noacs(ks)*noacs(ls),msymoa,vv,r,s,pq,ywtot)

         call ijkl_aqbs(is,ks,noacs,numacs,om1,om3
     *   ,abrs13,maxorbcas,nsym,
     *   noacs(is)*noacs(ks),msymoa,vv,p,r,qs,ywtot)
         call ijkl_aqbs(is,ls,noacs,numacs,om1,om4
     *   ,abrs14,maxorbcas,nsym,
     *   noacs(is)*noacs(ls),msymoa,vv,p,s,qr,ywtot)
         call ijkl_aqbs(js,ks,noacs,numacs,om2,om3
     *   ,abrs23,maxorbcas,nsym,
     *   noacs(js)*noacs(ks),msymoa,vv,q,r,ps,ywtot)
         call ijkl_aqbs(js,ls,noacs,numacs,om2,om4
     *   ,abrs24,maxorbcas,nsym,
     *   noacs(js)*noacs(ls),msymoa,vv,q,s,pr,ywtot)
      enddo
! 7. abiv aibv
      call ijkl_abiv(is,js,ks,ls,om3,om4,
     *abrs12,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(is)*noacs(js),msymoa,ywtot,msym)
      call ijkl_abiv(ks,ls,is,js,om1,om2,
     *abrs34,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(ks)*noacs(ls),msymoa,ywtot,msym)

      call ijkl_aibv(is,js,ks,ls,om2,om4,
     *abrs13,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(is)*noacs(ks),msymoa,ywtot,msym)
      call ijkl_aibv(is,js,ls,ks,om2,om3,
     *abrs14,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(is)*noacs(ls),msymoa,ywtot,msym)
      call ijkl_aibv(js,is,ks,ls,om1,om4,
     *abrs23,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(js)*noacs(ks),msymoa,ywtot,msym)
      call ijkl_aibv(js,is,ls,ks,om1,om3,
     *abrs24,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(js)*noacs(ls),msymoa,ywtot,msym)

! 5. abcd
      call ijkl_abcd(is,js,ks,ls,om3,om4,
     *abrs12,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(is)*noacs(js),msymoa,ywtot,msym)


! 9. abcv
! 11. abci
      call ijkl_abcv(is,js,ks,ls,om3,om4,
     *abrs12,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(is)*noacs(js),msymoa,ywtot,msym)
      call ijkl_abcv(ks,ls,is,js,om1,om2,
     *abrs34,noacs,numacs,insinv
     *,isym,isymoa,inac,nononacs,numnonacs,
     *maxorbcas,nsym,noacs(ks)*noacs(ls),msymoa,ywtot,msym)
      deallocate(abrs12,abrs34,abrs23,abrs24,abrs13,abrs14)
      return
      end

       subroutine ijkl_aibv(is,js,ks,ls,om2,om4,
     *abrs13,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 abrs13(iabrs,*),isym(*),isymoa(*),inac(*)
      dimension nononacs(*),numnonacs(msym,nsym)
      dimension om4(msymoa,*),om2(msymoa,*)
      integer al,be,ab,al_a,be_a,aal_a,bbe_a,v,v_a,vv_a
      integer vv_abs,aal_abs,bbe_abs
      yw=.false.;yw=yw.or.ywtot
      if(yw) print*,'entree ijkl_aibv'
! 7. 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(ks)
            ab=ab+1
            be_a=numacs(be,ks)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:ks-1)))
!        7. aibv
            do v=inac(ls)+1,nononacs(ls)
               v_a=numnonacs(v,ls)
               vv_a=insinv(v_a)
               vv_abs=insinv(v_a+sum(isym(1:ls-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)))
                  qs=0
                  a_aibv=0.d0
                  do q=1,isymoa(js)
                     do s=1,isymoa(ls)
                        qs=qs+1
                        del=om2(q,i_a)*om4(s,v_a)
                        a_aibv=a_aibv+del*abrs13(ab,qs)
                     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
            enddo
!        7. avbi
            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(ls)
                  i_a=numnonacs(i,ls)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:ls-1)))
                  qs=0
                  a_aibv=0.d0
                  do q=1,isymoa(js)
                     do s=1,isymoa(ls)
                        qs=qs+1
                        del=om2(q,v_a)*om4(s,i_a)
                        a_aibv=a_aibv+del*abrs13(ab,qs)
                     enddo
                  enddo
                  call stoijkl(aal_abs,vv_abs,bbe_abs,ii_abs,a_aibv,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#AVBI'
     *               ,aal_abs,vv_abs,bbe_abs,ii_abs,a_aibv
                  endif
               enddo
            enddo
         enddo
      enddo
      return
      end

       subroutine ijkl_abiv(is,js,ks,ls,om3,om4,
     *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 om4(msymoa,*),om3(msymoa,*)
      integer al,be,ab,al_a,be_a,aal_a,bbe_a,v,v_a,vv_a
      integer vv_abs,aal_abs,bbe_abs
      yw=.false.;yw=yw.or.ywtot
      if(yw) print*,'entree ijkl_abiv'
      ab=0
! 7. abvi/abiv
      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)
            ab=ab+1
            be_a=numacs(be,js)
            bbe_a=insinv(be_a)
            bbe_abs=insinv(be_a+sum(isym(1:js-1)))
!        7. abvi
            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
               do i=1,inac(ls)
                  i_a=numnonacs(i,ls)
                  ii_a=insinv(i_a)
                  ii_abs=insinv(i_a+sum(isym(1:ls-1)))
                  rs=0
                  a_abvi=0.d0
                  do r=1,isymoa(ks)
                     do s=1,isymoa(ls)
                        rs=rs+1
                        del=om3(r,v_a)*om4(s,i_a)
                        a_abvi=a_abvi+del*abrs(ab,rs)
                     enddo
                  enddo
                  call stoijkl(vv_abs,ii_abs,aal_abs,bbe_abs,a_abvi,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#ABVI'
     *               ,vv_abs,ii_abs,aal_abs,bbe_abs,a_abvi
                  endif
               enddo
            enddo
!        7. abiv
               rs=0
            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(ls)+1,nononacs(ls)
                  v_a=numnonacs(v,ls)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:ls-1)))
                  rs=0
                  a_abiv=0.d0
                  do r=1,isymoa(ks)
                     do s=1,isymoa(ls)
                        rs=rs+1
                        del=om3(r,i_a)*om4(s,v_a)
                        a_abiv=a_abiv+del*abrs(ab,rs)
                     enddo
                  enddo
                  call stoijkl(vv_abs,ii_abs,aal_abs,bbe_abs,a_abiv,72)
                  if(yw) then
                     print'(a,4i4,2f12.8)','#ABIV'
     *               ,vv_abs,ii_abs,aal_abs,bbe_abs,a_abiv
                  endif
               enddo
            enddo
         enddo
      enddo
      if(yw) print*,'sortie ijkl_abiv'
      return
      end
! 5. abcd
! 9. abcv
! 11. abci
       subroutine ijkl_abcd(is,js,ks,ls,om3,om4,
     *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 om4(msymoa,*),om3(msymoa,*)
      integer al,be,ab,al_a,be_a,aal_a,bbe_a
      integer ga,ga_a,gga_a,de,de_a,dde_a
      integer aal_abs,bbe_abs,gga_abs,dde_abs
      integer r,s,rs
      yw=.false.;yw=yw.or.ywtot
      ab=0
      if(yw)print'(a,20i4)'
     *,'entree ijkl_abcd noacs',is,js,ks,ls,noacs((/is,js,ks,ls/))
      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)))
            ab=ab+1
            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.
               do de=1,noacs(ls)
                  de_a=numacs(de,ls)
                  dde_a=insinv(de_a)
                  dde_abs=insinv(de_a+sum(isym(1:ls-1)))
                  a_abcd=0.d0
                  rs=0
                  do r=1,isymoa(ks)
                     do s=1,isymoa(ls)
                        rs=rs+1
                        del=abrs(ab,rs)*om3(r,ga_a)*om4(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
            enddo
         enddo
      enddo
      return
      end
       subroutine ijkl_abcv(is,js,ks,ls,om3,om4,
     *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 om4(msymoa,*),om3(msymoa,*)
      integer al,be,ab,al_a,be_a,aal_a,bbe_a
      integer ga,ga_a,gga_a,de,de_a,dde_a
      integer aal_abs,bbe_abs,gga_abs,dde_abs
      integer v,v_avv_a,vv_abs
      integer r,s,rs
      yw=.false.;yw=yw.or.ywtot
      ab=0
      if(yw)print'(a,20i4)'
     *,'entree ijkl_abcd noacs',is,js,ks,ls,noacs((/is,js,ks,ls/))
      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)))
            ab=ab+1
            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)))
!      9.
               do v=1,nononacs(ls)
                  v_a=numnonacs(v,ls)
                  vv_a=insinv(v_a)
                  vv_abs=insinv(v_a+sum(isym(1:ls-1)))
                  a_abcv=0.d0
                  rs=0
                  do r=1,isymoa(ks)
                     do s=1,isymoa(ls)
                        rs=rs+1
                        del=om3(r,ga_a)*om4(s,v_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
            enddo
            do ga=1,noacs(ls)
               ga_a=numacs(ga,ls)
               gga_a=insinv(ga_a)
               gga_abs=insinv(ga_a+sum(isym(1:ls-1)))
!      9.
               do v=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,isymoa(ls)
                        rs=rs+1
                        del=om3(r,v_a)*om4(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
            enddo
         enddo
      enddo
      return
      end
       subroutine ijkl_abrs(is,js,noacs,numacs,om1,om2,
     * abrs1,maxorbcas,nsym,iabrs,msymoa,vv,p,q,rs
     *,ywtot)
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      integer al,al_a,be,be_a,p,q,rs,ab
      dimension om1(msymoa,*),om2(msymoa,*)
      dimension noacs(*),numacs(maxorbcas,nsym)
      dimension abrs1(iabrs,*)
! abrs
      ab=0
      do al=1,noacs(is)
         al_a=numacs(al,is)
         do be=1,noacs(js)
            be_a=numacs(be,js)
            ab=ab+1
            del=om1(p,al_a)*om2(q,be_a)
            abrs1(ab,rs)=abrs1(ab,rs)+del*vv
         enddo
      enddo
      return
      end
       subroutine ijkl_aqbs(is,ks,noacs,numacs,om1,om3
     *,abrs13,maxorbcas,nsym,
     *iabrs,msymoa,vv,p,r,qs
     *,ywtot)
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      integer al,al_a,be,be_a,p,r,qs,ab
      dimension om1(msymoa,*),om3(msymoa,*)
      dimension noacs(*),numacs(maxorbcas,nsym)
      dimension abrs13(iabrs,*)
! abrs
      ab=0
      do al=1,noacs(is)
         al_a=numacs(al,is)
         do be=1,noacs(ks)
            be_a=numacs(be,ks)
            ab=ab+1
            del=om1(p,al_a)*om3(r,be_a)
            abrs13(ab,qs)=abrs13(ab,qs)+del*vv
         enddo
      enddo
      return
      end
