      SUBROUTINE tce_mo2e_offset_intorb(l_a_offset,k_a_offset,size)
C     $Id: tce_mo2e_offset_intorb.F 21239 2011-10-20 18:01:54Z kowalski $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     v ( g3 g4 g1 g2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
#include "tce_main.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
c new offset
      INTEGER length1
      INTEGER ipiece_l,i_counter,ipos,i
      INTEGER g3a,g4a,g1a,g2a
      INTEGER size_last
c
      INTEGER addr
      INTEGER g3b
      INTEGER g4b
      INTEGER g1b
      INTEGER g2b
      INTEGER IROW,ICOL,IRES
      INTEGER INDEX_PAIR
c 
      INTEGER key_test,offset_test,index_point
c 
c
      length = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &    ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1))))
     &    .eq. irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN       
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c 
c new offset
c idividex from tce.fh
c
      length1=0
      ipiece_l=length/idiv2e
      if(ipiece_l*idiv2e.eq.length) then
       length1=idiv2e
      else if(ipiece_l*idiv2e.lt.length) then
       length1=idiv2e+1
      end if
      if(length1.eq.0) CALL ERRQUIT('tce_mo2e_offset length1',0,MA_ERR)
      IF(.not.MA_PUSH_GET(mt_int,6*(length1+1)+1,'noname',
     &l_a_offset,k_a_offset)) CALL ERRQUIT('tce_t2_offset',0,MA_ERR)
      int_mb(k_a_offset) = length1
      addr = 0
      size = 0
      i_counter=0
      ipos=1
c
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1)))) .eq. 
     &irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      IRES=INDEX_PAIR(IROW,ICOL)
      i_counter=i_counter+1
      if(addr.eq.0) then
       int_mb(k_a_offset+ipos)=g2b - 1 + (noa+nva) * 
     &(g1b - 1 + (noa+nva) * (g4b-
     & 1 + (noa+nva) * (g3b - 1)))
cc       int_mb(k_a_offset+ipos) = IRES
       int_mb(k_a_offset+(length1+1)+ipos)=size
       int_mb(k_a_offset+2*(length1+1)+ipos)=g3b !first do loop
       int_mb(k_a_offset+3*(length1+1)+ipos)=g4b
       int_mb(k_a_offset+4*(length1+1)+ipos)=g1b
       int_mb(k_a_offset+5*(length1+1)+ipos)=g2b !last  do loop
       ipos=ipos+1
      end if
      if(i_counter.eq.ipiece_l) then
       int_mb(k_a_offset+ipos)=g2b - 1 + 
     &(noa+nva) * (g1b - 1 + (noa+nva) * (g4b-
     & 1 + (noa+nva) * (g3b - 1)))
cc       int_mb(k_a_offset+ipos) = IRES
       int_mb(k_a_offset+(length1+1)+ipos)=size
       int_mb(k_a_offset+2*(length1+1)+ipos)=g3b !first do loop
       int_mb(k_a_offset+3*(length1+1)+ipos)=g4b
       int_mb(k_a_offset+4*(length1+1)+ipos)=g1b
       int_mb(k_a_offset+5*(length1+1)+ipos)=g2b !last  do loop
       ipos=ipos+1
       i_counter=0
      end if
      addr = addr + 1
      size_last=size
      g3a=g3b !first do loop
      g4a=g4b
      g1a=g1b
      g2a=g2b !last  do loop
      addr = addr + 1
      size = size + int_mb(k_range_alpha+g3b-1) * 
     &int_mb(k_range_alpha+g4b-1) * int_mb(k_range_alpha+g1b-1) * 
     &int_mb(k_range_alpha+g2b-1)
      END IF
c      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c new offset
      if(i_counter.ne.0) then
       int_mb(k_a_offset+ipos)=g2a - 1 + (noa+nva) * 
     & (g1a - 1 + (noa+nva) * (g4a-
     & 1 + (noa+nva) * (g3a - 1)))
cc       int_mb(k_a_offset+ipos) = IRES
       int_mb(k_a_offset+(length1+1)+ipos)=size_last
       int_mb(k_a_offset+2*(length1+1)+ipos)=g3a !first do loop
       int_mb(k_a_offset+3*(length1+1)+ipos)=g4a
       int_mb(k_a_offset+4*(length1+1)+ipos)=g1a
       int_mb(k_a_offset+5*(length1+1)+ipos)=g2a !last  do loop
      end if
c
      RETURN
      END
c
c
c
      SUBROUTINE tce_mo2e_offset_intorb_old(l_a_offset,k_a_offset,size)
C     $Id: tce_mo2e_offset_intorb.F 21239 2011-10-20 18:01:54Z kowalski $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     v ( g3 g4 g1 g2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
#include "tce_main.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER g3b
      INTEGER g4b
      INTEGER g1b
      INTEGER g2b
      INTEGER IROW,ICOL,IRES
      INTEGER INDEX_PAIR
c
      length = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &    ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1))))
     &    .eq. irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN       
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c 
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('tce_mo2e_offset',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1)))) .eq. 
     &irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      addr = addr + 1
      IRES=INDEX_PAIR(IROW,ICOL)
      int_mb(k_a_offset+addr) = IRES
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range_alpha+g3b-1) * 
     &int_mb(k_range_alpha+g4b-1) * int_mb(k_range_alpha+g1b-1) * 
     &int_mb(k_range_alpha+g2b-1)
      END IF
c      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
c
c
c
      SUBROUTINE tce_mo2e_pairs(l_a_offset,k_a_offset,size)
C     $Id: tce_mo2e_offset_intorb.F 21239 2011-10-20 18:01:54Z kowalski $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     v ( g3 g4 g1 g2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
#include "tce_main.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER g3b
      INTEGER g4b
      INTEGER g1b
      INTEGER g2b
      INTEGER IROW,ICOL,IRES
      INTEGER INDEX_PAIR
      INTEGER I
      INTEGER ISPAIR
      INTEGER XOFFSET
      INTEGER IBEFORE
c
      length = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      ISPAIR = 0 
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &    ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1))))
     &    .eq. irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      ISPAIR=1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF(ISPAIR.EQ.1) length=length+1
      END DO
      END DO
c
c length test
      if(length.ne.((noa+nva)*(noa+nva+1))/2) 
     &  CALL ERRQUIT('tce_mo2e_pairs',0,MA_ERR)
c
      IF (.not.MA_PUSH_GET(mt_int,3*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('tce_mo2e_offset',0,MA_ERR)
      do i=1,3*length+1
       int_mb(k_a_offset+i-1)=0
      enddo  
      int_mb(k_a_offset) = length
      addr = 0
      xoffset = 0
      ibefore = 0
cc      size = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
        int_mb(k_a_offset+2*length+addr+1) = ibefore     
       size = 0
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1)))) .eq.
     &irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      size = size + int_mb(k_range_alpha+g3b-1) *
     &int_mb(k_range_alpha+g4b-1) * int_mb(k_range_alpha+g1b-1) *
     &int_mb(k_range_alpha+g2b-1)
      ibefore=ibefore+1 
      END IF
c      END IF
      END IF
      END IF
      END DO
      END DO
       if(size.ne.0) then
        addr = addr + 1
        int_mb(k_a_offset+addr)=size
        int_mb(k_a_offset+length+addr)=xoffset
        xoffset = xoffset + size
       else
        addr = addr + 1 
        int_mb(k_a_offset+addr)=0
        int_mb(k_a_offset+length+addr)=0
       end if
      END DO
      END DO
      RETURN
      END
c
c
c
      SUBROUTINE tce_mo2e_pairs_act(l_a_offset,k_a_offset,size)
C     $Id: tce_mo2e_offset_intorb.F 21239 2011-10-20 18:01:54Z kowalski $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     v ( g3 g4 g1 g2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
#include "tce_main.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER g3b
      INTEGER g4b
      INTEGER g1b
      INTEGER g2b
      INTEGER IROW,ICOL,IRES
      INTEGER INDEX_PAIR
      INTEGER I
      INTEGER ISPAIR
      INTEGER XOFFSET
      INTEGER IBEFORE
      LOGICAL is_active_4_o
c
      length = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      ISPAIR = 0 
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &    ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1))))
     &    .eq. irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      ISPAIR=1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF(ISPAIR.EQ.1) length=length+1
      END DO
      END DO
c
c  length test
      if(length.ne.((noa+nva)*(noa+nva+1))/2) 
     &  CALL ERRQUIT('tce_mo2e_pairs',0,MA_ERR)
c
      IF (.not.MA_PUSH_GET(mt_int,3*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('tce_mo2e_offset',0,MA_ERR)
      do i=1,3*length+1
       int_mb(k_a_offset+i-1)=0
      enddo  
      int_mb(k_a_offset) = length
      addr = 0
      xoffset = 0
      ibefore = 0
cc      size = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
        int_mb(k_a_offset+2*length+addr+1) = ibefore     
       size = 0
      IROW=INDEX_PAIR(g4b,g3b)
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF(.not.((g3b.gt.noa).and.(g4b.gt.noa).and.(g1b.gt.noa).and.
     &   (g2b.gt.noa).and.(.not.is_active_4_o(g3b,g4b,g1b,g2b)))) THEN
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1)))) .eq.
     &irrep_v) THEN
cc      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      size = size + int_mb(k_range_alpha+g3b-1) *
     &int_mb(k_range_alpha+g4b-1) * int_mb(k_range_alpha+g1b-1) *
     &int_mb(k_range_alpha+g2b-1)
      ibefore=ibefore+1 
      END IF
c      END IF
      END IF
      END IF
      END IF
      END DO
      END DO
       if(size.ne.0) then
        addr = addr + 1
        int_mb(k_a_offset+addr)=size
        int_mb(k_a_offset+length+addr)=xoffset
        xoffset = xoffset + size
       else
        addr = addr + 1 
        int_mb(k_a_offset+addr)=0
        int_mb(k_a_offset+length+addr)=0
       end if
      END DO
      END DO
      RETURN
      END
c
c
      SUBROUTINE tce_mo2e_offset_intorb_act(l_a_offset,k_a_offset,size)
C     $Id: tce_mo2e_offset_intorb.F 21239 2011-10-20 18:01:54Z kowalski $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     v ( g3 g4 g1 g2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
#include "tce_main.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
c new offset
      INTEGER length1
      INTEGER ipiece_l,i_counter,ipos,i
      INTEGER g3a,g4a,g1a,g2a
      INTEGER size_last
c
      INTEGER addr
      INTEGER g3b
      INTEGER g4b
      INTEGER g1b
      INTEGER g2b
      INTEGER IROW,ICOL,IRES
      INTEGER INDEX_PAIR
c 
      INTEGER key_test,offset_test,index_point
c 
      LOGICAL is_active_4_o
c
      length = 0
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF(.not.((g3b.gt.noa).and.(g4b.gt.noa).and.(g1b.gt.noa).and.
     &   (g2b.gt.noa).and.(.not.is_active_4_o(g3b,g4b,g1b,g2b)))) THEN
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &    ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1))))
     &    .eq. irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN       
      length = length + 1
      END IF
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c 
c new offset
c idividex from tce.fh
c
      length1=0
      ipiece_l=length/idiv2e
      if(ipiece_l*idiv2e.eq.length) then
       length1=idiv2e
      else if(ipiece_l*idiv2e.lt.length) then
       length1=idiv2e+1
      end if
      if(length1.eq.0) CALL ERRQUIT('tce_mo2e_offset length1',0,MA_ERR)
      IF(.not.MA_PUSH_GET(mt_int,6*(length1+1)+1,'noname',
     &l_a_offset,k_a_offset)) CALL ERRQUIT('tce_t2_offset',0,MA_ERR)
      int_mb(k_a_offset) = length1
      addr = 0
      size = 0
      i_counter=0
      ipos=1
c
      DO g3b = 1,noa+nva   !j
      DO g4b = g3b,noa+nva !i
      DO g1b = 1,noa+nva   !l
      DO g2b = g1b,noa+nva !k
      IF(.not.((g3b.gt.noa).and.(g4b.gt.noa).and.(g1b.gt.noa).and.
     &   (g2b.gt.noa).and.(.not.is_active_4_o(g3b,g4b,g1b,g2b)))) THEN
      IF (int_mb(k_spin_alpha+g3b-1)+int_mb(k_spin_alpha+g4b-1).eq.
     &int_mb(k_spin_alpha+g1b-1)+int_mb(k_spin_alpha+g2b-1)) THEN
      IF (ieor(int_mb(k_sym_alpha+g3b-1),ieor(int_mb(k_sym_alpha+g4b-1),
     &ieor(int_mb(k_sym_alpha+g1b-1),int_mb(k_sym_alpha+g2b-1)))) .eq. 
     &irrep_v) THEN
      IROW=INDEX_PAIR(g4b,g3b)
      ICOL=INDEX_PAIR(g2b,g1b)
      IF(IROW.GE.ICOL) THEN
      IRES=INDEX_PAIR(IROW,ICOL)
      i_counter=i_counter+1
      if(addr.eq.0) then
       int_mb(k_a_offset+ipos)=g2b - 1 + (noa+nva) * 
     &(g1b - 1 + (noa+nva) * (g4b-
     & 1 + (noa+nva) * (g3b - 1)))
cc       int_mb(k_a_offset+ipos) = IRES
       int_mb(k_a_offset+(length1+1)+ipos)=size
       int_mb(k_a_offset+2*(length1+1)+ipos)=g3b !first do loop
       int_mb(k_a_offset+3*(length1+1)+ipos)=g4b
       int_mb(k_a_offset+4*(length1+1)+ipos)=g1b
       int_mb(k_a_offset+5*(length1+1)+ipos)=g2b !last  do loop
       ipos=ipos+1
      end if
      if(i_counter.eq.ipiece_l) then
       int_mb(k_a_offset+ipos)=g2b - 1 + 
     &(noa+nva) * (g1b - 1 + (noa+nva) * (g4b-
     & 1 + (noa+nva) * (g3b - 1)))
cc       int_mb(k_a_offset+ipos) = IRES
       int_mb(k_a_offset+(length1+1)+ipos)=size
       int_mb(k_a_offset+2*(length1+1)+ipos)=g3b !first do loop
       int_mb(k_a_offset+3*(length1+1)+ipos)=g4b
       int_mb(k_a_offset+4*(length1+1)+ipos)=g1b
       int_mb(k_a_offset+5*(length1+1)+ipos)=g2b !last  do loop
       ipos=ipos+1
       i_counter=0
      end if
      addr = addr + 1
      size_last=size
      g3a=g3b !first do loop
      g4a=g4b
      g1a=g1b
      g2a=g2b !last  do loop
      addr = addr + 1
      size = size + int_mb(k_range_alpha+g3b-1) * 
     &int_mb(k_range_alpha+g4b-1) * int_mb(k_range_alpha+g1b-1) * 
     &int_mb(k_range_alpha+g2b-1)
      END IF
c      END IF
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c new offset
      if(i_counter.ne.0) then
       int_mb(k_a_offset+ipos)=g2a - 1 + (noa+nva) * 
     & (g1a - 1 + (noa+nva) * (g4a-
     & 1 + (noa+nva) * (g3a - 1)))
       int_mb(k_a_offset+(length1+1)+ipos)=size_last
       int_mb(k_a_offset+2*(length1+1)+ipos)=g3a !first do loop
       int_mb(k_a_offset+3*(length1+1)+ipos)=g4a
       int_mb(k_a_offset+4*(length1+1)+ipos)=g1a
       int_mb(k_a_offset+5*(length1+1)+ipos)=g2a !last  do loop
      end if
c

c
      RETURN
      END
c
c
c
      INTEGER FUNCTION INDEX_SINGLE(I)
      IMPLICIT NONE
      INTEGER I 
      INDEX_SINGLE=(I*(I-1))/2
      RETURN 
      END
c
      INTEGER FUNCTION INDEX_PAIR(I,J)
      IMPLICIT NONE
      INTEGER I,J
      INDEX_PAIR=(I*(I-1))/2+J
      RETURN
      END       
c
      INTEGER FUNCTION INDEX_POINT(I,J,N)
      IMPLICIT NONE
      INTEGER I,J,N
c I <= J
      INDEX_POINT=(N*(N+1))/2-((N-I)*(N-I+1))/2-(N-J)
      RETURN
      END
