      SUBROUTINE icsd_t2(d_f1,d_i0,d_t1,d_t2,d_v2,k_f1_offset,k_i0_offse
     &t,k_t1_offset,k_t2_offset,k_v2_offset,size_t1,size_t2,d_c2,iter)
c
c new parameters in procedure call size_t1,size_t2,d_c2
c d_c2 is assumed to be created before icsd_t2 is called
c d_c2 is also deleted outside of icsd_t2
c
c
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_v + = 1 * v ( p3 p4 h1 h2 )_v
C     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( h10 ) * t ( p3 h10 )_t * i1 ( h10 p4 h1 h2 )_v
C         i1 ( h10 p3 h1 h2 )_v + = 1 * v ( h10 p3 h1 h2 )_v
C         i1 ( h10 p3 h1 h2 )_vt + = 1/2 * Sum ( h11 ) * t ( p3 h11 )_t * i2 ( h10 h11 h1 h2 )_v
C             i2 ( h10 h11 h1 h2 )_v + = -1 * v ( h10 h11 h1 h2 )_v
C             i2 ( h10 h11 h1 h2 )_vt + = 1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * i3 ( h10 h11 h2 p5 )_v
C                 i3 ( h10 h11 h1 p5 )_v + = 1 * v ( h10 h11 h1 p5 )_v
C                 i3 ( h10 h11 h1 p5 )_vt + = -1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h10 h11 p5 p6 )_v
C             i2 ( h10 h11 h1 h2 )_vt + = -1/2 * Sum ( p7 p8 ) * t ( p7 p8 h1 h2 )_t * v ( h10 h11 p7 p8 )_v
C         i1 ( h10 p3 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * i2 ( h10 p3 h2 p5 )_v
C             i2 ( h10 p3 h1 p5 )_v + = 1 * v ( h10 p3 h1 p5 )_v
C             i2 ( h10 p3 h1 p5 )_vt + = -1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h10 p3 p5 p6 )_v
C         i1 ( h10 p3 h1 h2 )_ft + = -1 * Sum ( p5 ) * t ( p3 p5 h1 h2 )_t * i2 ( h10 p5 )_f
C             i2 ( h10 p5 )_f + = 1 * f ( h10 p5 )_f
C             i2 ( h10 p5 )_vt + = -1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 h10 p5 p6 )_v
C         i1 ( h10 p3 h1 h2 )_vt + = 1 * P( 2 ) * Sum ( h7 p9 ) * t ( p3 p9 h1 h7 )_t * i2 ( h7 h10 h2 p9 )_v
C             i2 ( h7 h10 h1 p9 )_v + = 1 * v ( h7 h10 h1 p9 )_v
C             i2 ( h7 h10 h1 p9 )_vt + = 1 * Sum ( p5 ) * t ( p5 h1 )_t * v ( h7 h10 p5 p9 )_v
C         i1 ( h10 p3 h1 h2 )_vt + = 1/2 * Sum ( p5 p6 ) * t ( p5 p6 h1 h2 )_t * v ( h10 p3 p5 p6 )_v
C     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * i1 ( p3 p4 h2 p5 )_v
C         i1 ( p3 p4 h1 p5 )_v + = 1 * v ( p3 p4 h1 p5 )_v
C         i1 ( p3 p4 h1 p5 )_vt + = -1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( p3 p4 p5 p6 )_v
C     i0 ( p3 p4 h1 h2 )_tf + = -1 * P( 2 ) * Sum ( h9 ) * t ( p3 p4 h1 h9 )_t * i1 ( h9 h2 )_f
C         i1 ( h9 h1 )_f + = 1 * f ( h9 h1 )_f
C         i1 ( h9 h1 )_ft + = 1 * Sum ( p8 ) * t ( p8 h1 )_t * i2 ( h9 p8 )_f
C             i2 ( h9 p8 )_f + = 1 * f ( h9 p8 )_f
C             i2 ( h9 p8 )_vt + = 1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 h9 p6 p8 )_v
C         i1 ( h9 h1 )_vt + = -1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 h9 h1 p6 )_v
C         i1 ( h9 h1 )_vt + = -1/2 * Sum ( h8 p6 p7 ) * t ( p6 p7 h1 h8 )_t * v ( h8 h9 p6 p7 )_v
C     i0 ( p3 p4 h1 h2 )_tf + = 1 * P( 2 ) * Sum ( p5 ) * t ( p3 p5 h1 h2 )_t * i1 ( p4 p5 )_f
C         i1 ( p3 p5 )_f + = 1 * f ( p3 p5 )_f
C         i1 ( p3 p5 )_vt + = -1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 p3 p5 p6 )_v
C         i1 ( p3 p5 )_vt + = -1/2 * Sum ( h7 h8 p6 ) * t ( p3 p6 h7 h8 )_t * v ( h7 h8 p5 p6 )_v
C     i0 ( p3 p4 h1 h2 )_vt + = -1/2 * Sum ( h11 h9 ) * t ( p3 p4 h9 h11 )_t * i1 ( h9 h11 h1 h2 )_v
C         i1 ( h9 h11 h1 h2 )_v + = -1 * v ( h9 h11 h1 h2 )_v
C         i1 ( h9 h11 h1 h2 )_vt + = 1 * P( 2 ) * Sum ( p8 ) * t ( p8 h1 )_t * i2 ( h9 h11 h2 p8 )_v
C             i2 ( h9 h11 h1 p8 )_v + = 1 * v ( h9 h11 h1 p8 )_v
C             i2 ( h9 h11 h1 p8 )_vt + = 1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h9 h11 p6 p8 )_v
C         i1 ( h9 h11 h1 h2 )_vt + = -1/2 * Sum ( p5 p6 ) * t ( p5 p6 h1 h2 )_t * v ( h9 h11 p5 p6 )_v
C     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 4 ) * Sum ( h6 p5 ) * t ( p3 p5 h1 h6 )_t * i1 ( h6 p4 h2 p5 )_v
C         i1 ( h6 p3 h1 p5 )_v + = 1 * v ( h6 p3 h1 p5 )_v
C         i1 ( h6 p3 h1 p5 )_vt + = -1 * Sum ( p7 ) * t ( p7 h1 )_t * v ( h6 p3 p5 p7 )_v
C         i1 ( h6 p3 h1 p5 )_vt + = -1/2 * Sum ( h8 p7 ) * t ( p3 p7 h1 h8 )_t * v ( h6 h8 p5 p7 )_v
C     i0 ( p3 p4 h1 h2 )_vt + = 1/2 * Sum ( p5 p6 ) * t ( p5 p6 h1 h2 )_t * v ( p3 p4 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "util.fh"
#include "errquit.fh"
#include "tce.fh"
c when local copies of  T1/X1 tensors are used,  d_t1 refers to k_t1_local (kk)
c local copies of the most important 2-dimensional intermediates
c icsd_t2_4(...) and icsd_t2_5(...) (kk)
      INTEGER d_i0
      INTEGER k_i0_offset
      INTEGER d_v2
      INTEGER k_v2_offset
      INTEGER d_t1
      INTEGER k_t1_offset
      INTEGER d_i1
      INTEGER k_i1_offset
      INTEGER d_t2
      INTEGER k_t2_offset
      INTEGER l_i1_offset
      INTEGER size_i1
      INTEGER d_i2
      INTEGER k_i2_offset
      INTEGER l_i2_offset
      INTEGER size_i2
      INTEGER d_i3
      INTEGER k_i3_offset
      INTEGER l_i3_offset
      INTEGER size_i3
      INTEGER d_f1
      INTEGER k_f1_offset
c PETA
      integer d_c2
      integer d_i1_2
      integer d_i2_2a,d_i2_2b,d_i2_2c,d_i2_2d
      integer d_i3_2
      integer d_i1_3
      integer d_i2_3
      integer d_i1_4
      integer d_i2_4
      integer d_i1_5
      integer d_i1_6
      integer d_i2_6
      integer d_i1_7
      integer d_i1_vt
      integer l_i1_2_offset,k_i1_2_offset
      integer l_i2_2a_offset,k_i2_2a_offset
      integer l_i2_2b_offset,k_i2_2b_offset
      integer l_i2_2c_offset,k_i2_2c_offset
      integer l_i2_2d_offset,k_i2_2d_offset
      integer l_i3_2_offset,k_i3_2_offset
      integer l_i1_3_offset,k_i1_3_offset
      integer l_i2_3_offset,k_i2_3_offset
      integer l_i1_4_offset,k_i1_4_offset
      integer l_i2_4_offset,k_i2_4_offset
      integer l_i1_5_offset,k_i1_5_offset
      integer l_i1_6_offset,k_i1_6_offset
      integer l_i2_6_offset,k_i2_6_offset
      integer l_i1_7_offset,k_i1_7_offset
      integer l_i1_vt_offset,k_i1_vt_offset
c
      integer l_i1_4_local,k_i1_4_local
      integer l_i1_5_local,k_i1_5_local
c
      integer size_i1_2
      integer size_i2_2a,size_i2_2b,size_i2_2c,size_i2_2d
      integer size_i3_2
      integer size_i1_3
      integer size_i2_3
      integer size_i1_4
      integer size_i2_4
      integer size_i1_5
      integer size_i1_6
      integer size_i2_6
      integer size_i1_7
      integer size_i1_vt     
      integer level_x,iter
      integer size_t1,size_t2
      integer layer1,layer2,layer3,layer4
c ----- independent counters -----
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
      integer num_count
      integer ctx
      parameter(num_count=41)
c --------------------------------
c - T1/X1 LOCALIZATION -------------------
      integer l_i1_local,k_i1_local
c ---------------------------------------
      CHARACTER*255 filename
      logical nodezero         ! True if node 0
      double precision cpu     ! CPU sec counter
      double precision wall    ! WALL sec counter
c
      nodezero=(ga_nodeid().eq.0)
c
c --------------------------------
c ALL OFFSET OPENINGS HERE
      CALL OFFSET_icsd_t2_2_1(l_i1_2_offset,k_i1_2_offset,size_i1_2)
      CALL OFFSET_icsd_t2_2_2_1(l_i2_2a_offset,k_i2_2a_offset,
     &size_i2_2a)
      CALL OFFSET_icsd_t2_2_2_2_1(l_i3_2_offset,k_i3_2_offset,size_i3_2)
      CALL OFFSET_icsd_t2_2_4_1(l_i2_2c_offset,k_i2_2c_offset,
     &size_i2_2c)
      CALL OFFSET_icsd_t2_2_5_1(l_i2_2d_offset,k_i2_2d_offset,
     &size_i2_2d)
      CALL OFFSET_icsd_t2_4_1(l_i1_4_offset,k_i1_4_offset,size_i1_4)
      CALL OFFSET_icsd_t2_4_2_1(l_i2_4_offset,k_i2_4_offset,size_i2_4)
      CALL OFFSET_icsd_t2_5_1(l_i1_5_offset,k_i1_5_offset,size_i1_5)
      CALL OFFSET_icsd_t2_6_1(l_i1_6_offset,k_i1_6_offset,size_i1_6)
      CALL OFFSET_icsd_t2_6_2_1(l_i2_6_offset,k_i2_6_offset,size_i2_6)
      CALL OFFSET_icsd_t2_7_1(l_i1_7_offset,k_i1_7_offset,size_i1_7)
      CALL OFFSET_vt1ic_1_1(l_i1_vt_offset,k_i1_vt_offset,size_i1_vt)
c
c       if (.not.ma_push_get(mt_dbl,size_i1_4,'loc1',
c     1  l_i1_4_local,k_i1_4_local)) call errquit('tce:loc1p ',0,MA_ERR)
c
c       if (.not.ma_push_get(mt_dbl,size_i1_5,'loc2',
c     1  l_i1_5_local,k_i1_5_local)) call errquit('tce:loc1p ',0,MA_ERR)
c

      CALL TCE_FILENAME('icsd_t2_2_1_i1',filename)
      CALL CREATEFILE(filename,d_i1_2,size_i1_2)

      CALL TCE_FILENAME('icsd_t2_2_2_1_i2',filename)
      CALL CREATEFILE(filename,d_i2_2a,size_i2_2a)

      CALL TCE_FILENAME('icsd_t2_2_2_2_1_i3',filename)
      CALL CREATEFILE(filename,d_i3_2,size_i3_2)

      CALL TCE_FILENAME('icsd_t2_2_4_1_i2',filename)
      CALL CREATEFILE(filename,d_i2_2c,size_i2_2c)

      CALL TCE_FILENAME('icsd_t2_2_5_1_i2',filename)
      CALL CREATEFILE(filename,d_i2_2d,size_i2_2d)

      CALL TCE_FILENAME('icsd_t2_4_1_i1',filename)
      CALL CREATEFILE(filename,d_i1_4,size_i1_4)

      CALL TCE_FILENAME('icsd_t2_4_2_1_i2',filename)
      CALL CREATEFILE(filename,d_i2_4,size_i2_4)

      CALL TCE_FILENAME('icsd_t2_5_1_i1',filename)
      CALL CREATEFILE(filename,d_i1_5,size_i1_5)

      CALL TCE_FILENAME('icsd_t2_6_1_i1',filename)
      CALL CREATEFILE(filename,d_i1_6,size_i1_6)

      CALL TCE_FILENAME('icsd_t2_6_2_1_i2',filename)
      CALL CREATEFILE(filename,d_i2_6,size_i2_6)

      CALL TCE_FILENAME('icsd_t2_7_1_i1',filename)
      CALL CREATEFILE(filename,d_i1_7,size_i1_7)

      CALL TCE_FILENAME('vt1ic_1_1_i1',filename)
      CALL CREATEFILE(filename,d_i1_vt,size_i1_vt)
c
c
c

      if(iter.eq.1) then
c
c       layer1=int_mb(k_i0_offset)+int_mb(k_i1_2_offset)+
c     & int_mb(k_i2_2a_offset)+int_mb(k_i3_2_offset)+
c     & int_mb(k_i3_2_offset)+int_mb(k_i2_2a_offset)+
c     & int_mb(k_i2_2c_offset)+int_mb(k_i2_2c_offset)+
c     & int_mb(k_i2_2d_offset)+int_mb(k_i2_2d_offset)+
c     & int_mb(k_i1_2_offset)+int_mb(k_i0_offset)+
c     & int_mb(k_i1_4_offset)+int_mb(k_i2_4_offset)+
c     & int_mb(k_i2_4_offset)+int_mb(k_i1_4_offset)+
c     & int_mb(k_i1_4_offset)+int_mb(k_i1_5_offset)+
c     & int_mb(k_i1_5_offset)+int_mb(k_i1_5_offset)+
c     & int_mb(k_i1_6_offset)+int_mb(k_i2_6_offset)+
c     & int_mb(k_i2_6_offset)+int_mb(k_i1_6_offset)+
c     & int_mb(k_i1_7_offset)+int_mb(k_i1_7_offset)+
c     & int_mb(k_i1_7_offset)+int_mb(k_i1_vt_offset)+
c     & int_mb(k_i0_offset)
c       layer2=int_mb(k_i2_2a_offset)+int_mb(k_i1_2_offset)+
c     & int_mb(k_i1_2_offset)+int_mb(k_i1_4_offset)+
c     & int_mb(k_i1_6_offset)+int_mb(k_i0_offset)+
c     & int_mb(k_i0_offset)
c       layer3=int_mb(k_i1_2_offset)+int_mb(k_i0_offset)+
c     & int_mb(k_i0_offset)+int_mb(k_i0_offset)
c       layer4=int_mb(k_i0_offset)
c
      if(nodezero)  then
c       write(6,100)
c       write(6,101)'t2_1',int_mb(k_i0_offset)
c       write(6,101)'t2_2_1',int_mb(k_i1_2_offset)
c       write(6,101)'t2_2_2_1',int_mb(k_i2_2a_offset)
c       write(6,101)'t2_2_2_2_1',int_mb(k_i3_2_offset)
c       write(6,101)'t2_2_2_2_2',int_mb(k_i3_2_offset)
c       write(6,101)'t2_2_2_2',int_mb(k_i2_2a_offset)
c       write(6,101)'t2_2_2_3',int_mb(k_i2_2a_offset)
c       write(6,101)'t2_2_2',int_mb(k_i1_2_offset)
c       write(6,101)'t2_2_4_1',int_mb(k_i2_2c_offset)
c       write(6,101)'t2_2_4_2',int_mb(k_i2_2c_offset)
c       write(6,101)'t2_2_4',int_mb(k_i1_2_offset)
c       write(6,101)'t2_2_5_1',int_mb(k_i2_2d_offset)
c       write(6,101)'t2_2_5_2',int_mb(k_i2_2d_offset)
c       write(6,101)'t2_2_5',int_mb(k_i1_2_offset)
c       write(6,101)'t2_2_6',int_mb(k_i1_2_offset)
c       write(6,101)'t2_2',int_mb(k_i0_offset)
c       write(6,101)'t2_3x',int_mb(k_i0_offset)
c       write(6,101)'t2_4_1',int_mb(k_i1_4_offset)
c       write(6,101)'t2_4_2_1',int_mb(k_i2_4_offset)
c       write(6,101)'t2_4_2_2',int_mb(k_i2_4_offset)
c       write(6,101)'t2_4_2',int_mb(k_i1_4_offset)
c       write(6,101)'t2_4_3',int_mb(k_i1_4_offset)
c       write(6,101)'t2_4_4',int_mb(k_i1_4_offset)
c       write(6,101)'t2_4',int_mb(k_i0_offset)
c       write(6,101)'t2_5_1',int_mb(k_i1_5_offset)
c       write(6,101)'t2_5_2',int_mb(k_i1_5_offset)
c       write(6,101)'t2_5_3',int_mb(k_i1_5_offset)
c       write(6,101)'t2_5',int_mb(k_i0_offset)
c       write(6,101)'t2_6_1',int_mb(k_i1_6_offset)
c       write(6,101)'t2_6_2_1',int_mb(k_i2_6_offset)
c       write(6,101)'t2_6_2_2',int_mb(k_i2_6_offset)
c       write(6,101)'t2_6_2',int_mb(k_i1_6_offset)
c       write(6,101)'t2_6_3',int_mb(k_i1_6_offset)
c       write(6,101)'t2_6',int_mb(k_i0_offset)
c       write(6,101)'t2_7_1',int_mb(k_i1_7_offset)
c       write(6,101)'t2_7_2',int_mb(k_i1_7_offset)
c       write(6,101)'t2_7_3',int_mb(k_i1_7_offset)
c       write(6,101)'t2_7',int_mb(k_i0_offset)
c       write(6,101)'vt1ic_1_2',int_mb(k_i1_vt_offset)
c       write(6,101)'vt1ic_1',int_mb(k_i0_offset)
c       write(6,101)'t2_8',int_mb(k_i0_offset)
c       write(6,*)'                          '
c       write(6,102)
c       write(6,101)'layer 1',layer1
c       write(6,101)'layer 2',layer2
c       write(6,101)'layer 3',layer3
c       write(6,101)'layer 4',layer4
       write(6,103)
       call util_flush(6)
      end if
      end if
c
 100  format('SEMI-SERIAL EXECUTION OF T2')
 101  format(2x,a12,3x,i12)
 102  format('TASK POOL FOR VARIOUS T2 LAYERS')
 103  format('CCSD_T2_NTS --- OK')
c

c
c counters are opened here
c
      call nxt_ctx_create(num_count, ctx)
c
c
      do level_x=1,4    ! -----------------
c
      if(level_x.eq.1) then
      CALL icsd_t2_1(d_v2,k_v2_offset,d_i0,k_i0_offset,ctx,1)
      end if
c





c
      if(level_x.eq.1) then
      CALL icsd_t2_2_1(d_v2,k_v2_offset,d_i1_2,k_i1_2_offset,ctx,2)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_2_1(d_v2,k_v2_offset,d_i2_2a,k_i2_2a_offset,ctx,3)
      end if
c
      if(level_x.eq.1) then 
      CALL icsd_t2_2_2_2_1(d_v2,k_v2_offset,d_i3_2,k_i3_2_offset,ctx,4)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_2_2_2(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i3_2,
     &k_i3_2_offset,ctx,5)
      end if
c
      if(level_x.eq.2) then
      CALL icsd_t2_2_2_2(d_t1,k_t1_offset,d_i3_2,k_i3_2_offset,
     &d_i2_2a,k_i2_2a_offset,ctx,6)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_2_3(d_t2,k_t2_offset,d_v2,k_v2_offset,d_i2_2a,
     &k_i2_2a_offset,ctx,7)
      end if
c
      if(level_x.eq.3) then
      CALL icsd_t2_2_2(d_t1,k_t1_offset,d_i2_2a,k_i2_2a_offset,
     &d_i1_2,k_i1_2_offset,ctx,8)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_4_1(d_f1,k_f1_offset,d_i2_2c,k_i2_2c_offset,
     &ctx,9)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_4_2(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i2_2c,
     &k_i2_2c_offset,ctx,10)
      end if
c
      if(level_x.eq.2) then
      CALL icsd_t2_2_4(d_t2,k_t2_offset,d_i2_2c,k_i2_2c_offset,d_i1_2,
     &k_i1_2_offset,ctx,11)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_5_1(d_v2,k_v2_offset,d_i2_2d,k_i2_2d_offset,ctx,12)
      end if
c
      if(level_x.eq.1) then  
      CALL icsd_t2_2_5_2(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i2_2d,
     &k_i2_2d_offset,ctx,13)
      end if
c
      if(level_x.eq.2) then
      CALL icsd_t2_2_5(d_t2,k_t2_offset,d_i2_2d,k_i2_2d_offset,d_i1_2,
     &k_i1_2_offset,ctx,14)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_2_6(d_c2,k_t2_offset,d_v2,k_v2_offset,
     &d_i1_2,k_i1_2_offset,ctx,15)
      end if
c
      if(level_x.eq.4) then
      CALL icsd_t2_2(d_t1,k_t1_offset,d_i1_2,k_i1_2_offset,
     &d_i0,k_i0_offset,ctx,16)
      end if








c
      if(level_x.eq.1) then
      CALL licsd_t2_3x(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i0,
     &k_i0_offset,ctx,17)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_4_1(d_f1,k_f1_offset,d_i1_4,k_i1_4_offset,ctx,18)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_4_2_1(d_f1,k_f1_offset,d_i2_4,k_i2_4_offset,ctx,19)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_4_2_2(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i2_4,
     &k_i2_4_offset,ctx,20)
      end if
c
      if(level_x.eq.2) then 
      CALL icsd_t2_4_2(d_t1,k_t1_offset,d_i2_4,k_i2_4_offset,d_i1_4,
     &k_i1_4_offset,ctx,21)
      end if
c
c      IF (.not.MA_POP_STACK(l_i2_offset)) CALL ERRQUIT('icsd_t2',-1,MA_E
c     &RR)
c
      if(level_x.eq.1) then
      CALL icsd_t2_4_3(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i1_4,
     &k_i1_4_offset,ctx,22)
      end if
c
      if(level_x.eq.1) then 
      CALL icsd_t2_4_4(d_t2,k_t2_offset,d_v2,k_v2_offset,
     &d_i1_4,k_i1_4_offset,ctx,23)
      end if
c
c - T1/X1 LOCALIZATION ----------
c        if (.not.MA_PUSH_GET(mt_dbl,size_i1,'i1_local',
c     1      l_i1_local,k_i1_local))
c     1      call errquit('i1_local',1,MA_ERR)
c        call ma_zero(dbl_mb(k_i1_local),size_i1)
c    copy d_t1 ==> l_t1_local
c        call ga_get(d_i1,1,size_i1,1,1,dbl_mb(k_i1_local),1)
c -------------------------------
ccx      CALL icsd_t2_4(d_t2,k_t2_offset,d_i1,k_i1_offset,d_i0,k_i0_offset)
c
c
      if(level_x.eq.3) then
      CALL icsd_t2_4(d_t2,k_t2_offset,d_i1_4,k_i1_4_offset,
     &              d_i0,k_i0_offset,ctx,24)
      end if
c
      if(level_x.eq.1) then 
      CALL icsd_t2_5_1(d_f1,k_f1_offset,d_i1_5,k_i1_5_offset,ctx,25)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_5_2(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i1_5,
     &k_i1_5_offset,ctx,26)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_5_3(d_t2,k_t2_offset,d_v2,k_v2_offset,d_i1_5,
     &k_i1_5_offset,ctx,27)
      end if
c
c - T1/X1 LOCALIZATION ----------
c        if (.not.MA_PUSH_GET(mt_dbl,size_i1,'i1_local',
c     1      l_i1_local,k_i1_local))
c     1      call errquit('i1_local',1,MA_ERR)
c        call ma_zero(dbl_mb(k_i1_local),size_i1)
cc    copy d_t1 ==> l_t1_local
c        call ga_get(d_i1,1,size_i1,1,1,dbl_mb(k_i1_local),1)
c -------------------------------
ccx      CALL icsd_t2_5(d_t2,k_t2_offset,d_i1,k_i1_offset,d_i0,k_i0_offset)
c
      if(level_x.eq.2) then
      CALL icsd_t2_5(d_t2,k_t2_offset,d_i1_5,k_i1_5_offset,
     &               d_i0,k_i0_offset,ctx,28)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_6_1(d_v2,k_v2_offset,d_i1_6,k_i1_6_offset,ctx,29)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_6_2_1(d_v2,k_v2_offset,d_i2_6,k_i2_6_offset,ctx,30)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_6_2_2(d_t1,k_t1_offset,d_v2,k_v2_offset,d_i2_6,
     &k_i2_6_offset,ctx,31)
      end if
c
      if(level_x.eq.2) then
      CALL icsd_t2_6_2(d_t1,k_t1_offset,d_i2_6,k_i2_6_offset,
     &d_i1_6,k_i1_6_offset,ctx,32)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_6_3(d_t2,k_t2_offset,d_v2,k_v2_offset,
     &d_i1_6,k_i1_6_offset,ctx,33)
      end if
c
      if(level_x.eq.3) then
      CALL icsd_t2_6(d_t2,k_t2_offset,d_i1_6,k_i1_6_offset,d_i0,
     &k_i0_offset,ctx,34)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_7_1(d_v2,k_v2_offset,d_i1_7,k_i1_7_offset,ctx,35)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_7_2(d_t1,k_t1_offset,d_v2,k_v2_offset,
     &d_i1_7,k_i1_7_offset,ctx,36)
      end if
c
      if(level_x.eq.1) then
      CALL icsd_t2_7_3(d_t2,k_t2_offset,d_v2,k_v2_offset,
     &d_i1_7,k_i1_7_offset,ctx,37)
      end if
c
      if(level_x.eq.2) then
      CALL icsd_t2_7(d_t2,k_t2_offset,d_i1_7,k_i1_7_offset,
     &d_i0,k_i0_offset,ctx,38)
      end if
c
c
      if(level_x.eq.1) then
      CALL vt1ic_1_2(d_t1,k_t1_offset,d_v2,k_v2_offset,
     &d_i1_vt,k_i1_vt_offset,ctx,39)
      end if
c
      if(level_x.eq.2) then
      CALL vt1ic_1(d_t1,k_t1_offset,d_i1_vt,k_i1_vt_offset,
     &d_i0,k_i0_offset,ctx,40)
      end if
c
c
      if(level_x.eq.1) then 
      CALL icsd_t2_8(d_c2,k_t2_offset,d_v2,k_v2_offset,
     &d_i0,k_i0_offset,ctx,41)
      end if
c
cc        if(level_x.eq.1) then
c -----------------------------------
c      localize 2 intermediates
c -----------------------------------
c
cc        call ga_sync()
c
cc        call ma_zero(dbl_mb(k_i1_4_local),size_i1_4)
cc        call ga_get(d_i1_4,1,size_i1_4,1,1,dbl_mb(k_i1_4_local),1)
c
cc        call ma_zero(dbl_mb(k_i1_5_local),size_i1_5)
cc        call ga_get(d_i1_5,1,size_i1_5,1,1,dbl_mb(k_i1_5_local),1)
cc        end if

        call ga_sync()
 
      enddo ! -- level_x --------
c counters are closed here
      call nxt_ctx_destroy(ctx)
c
c closing files
c
      call deletefile(d_i1_vt)
      call deletefile(d_i1_7)
      call deletefile(d_i2_6)
      call deletefile(d_i1_6)
      call deletefile(d_i1_5)
      call deletefile(d_i2_4)
      call deletefile(d_i1_4)
      call deletefile(d_i2_2d)
      call deletefile(d_i2_2c)
      call deletefile(d_i3_2)
      call deletefile(d_i2_2a)
      call deletefile(d_i1_2)
c
c closing all OFFSETS
c
c      IF (.not.MA_POP_STACK(l_i1_5_local))
c     & CALL ERRQUIT('l_-1',-1,MA_ERR)
c      IF (.not.MA_POP_STACK(l_i1_4_local))
c     & CALL ERRQUIT('l_0',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i1_vt_offset))
     & CALL ERRQUIT('l_1',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i1_7_offset))
     & CALL ERRQUIT('l_2',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i2_6_offset))
     & CALL ERRQUIT('l_3',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i1_6_offset))
     & CALL ERRQUIT('l_4',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i1_5_offset))
     & CALL ERRQUIT('l_5',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i2_4_offset))
     & CALL ERRQUIT('l_6',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i1_4_offset))
     & CALL ERRQUIT('l_7',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i2_2d_offset))
     & CALL ERRQUIT('l_8',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i2_2c_offset))
     & CALL ERRQUIT('l_9',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i3_2_offset))
     & CALL ERRQUIT('l_10',-1,MA_ERR) 
      IF (.not.MA_POP_STACK(l_i2_2a_offset))
     & CALL ERRQUIT('l_11',-1,MA_ERR)
      IF (.not.MA_POP_STACK(l_i1_2_offset))
     & CALL ERRQUIT('l_12',-1,MA_ERR)
c
c
c
      RETURN
      END
      SUBROUTINE icsd_t2_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_v + = 1 * v ( p3 p4 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER p3b_1
      INTEGER p4b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      CALL TCE_RESTRICTED_4(p3b,p4b,h1b,h2b,p3b_1,p4b_1,h1b_1,h2b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb
     &(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_1',1,MA_ERR)
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p4b_1 - 1 + (noab
     &+nvab) * (p3b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p4b_1 - 1 + (noab
     &+nvab) * (p3b_1 - 1)))),h2b_1,h1b_1,p4b_1,p3b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_1',5,MA_ERR
     &)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( h10 ) * t ( p3 h10 )_t * i1 ( h10 p4 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER h10b
      INTEGER p3b_1
      INTEGER h10b_1
      INTEGER p4b_2
      INTEGER h10b_2
      INTEGER h1b_2
      INTEGER h2b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO h10b = 1,noab
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h10b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+h10b-1)) .eq. irrep_t) T
     &HEN
      CALL TCE_RESTRICTED_2(p3b,h10b,p3b_1,h10b_1)
      CALL TCE_RESTRICTED_4(p4b,h10b,h1b,h2b,p4b_2,h10b_2,h1b_2,h2b_2)
      dim_common = int_mb(k_range+h10b-1)
      dima_sort = int_mb(k_range+p3b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p4b-1) * int_mb(k_range+h1b-1) * int_mb
     &(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h10b_
     &1 - 1 + noab * (p3b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+h10b-1),1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
     & - 1 + noab * (h1b_2 - 1 + noab * (h10b_2 - 1 + noab * (p4b_2 - no
     &ab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p4b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1
     &),4,3,1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2',9,MA_ERR)
      IF ((p3b .le. p4b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((p4b .le. p3b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,3,4,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_v + = 1 * v ( h10 p3 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
      INTEGER next
      INTEGER nprocs
      INTEGER count
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER p3b_1
      INTEGER h10b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      CALL TCE_RESTRICTED_4(p3b,h10b,h1b,h2b,p3b_1,h10b_1,h1b_1,h2b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_m
     &b(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_1',1,MA_ERR)
      IF ((h10b .le. p3b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p3b_1 - 1 + (noab
     &+nvab) * (h10b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p3b_1 - 1 + (noab
     &+nvab) * (h10b_1 - 1)))),h2b_1,h1b_1,p3b_1,h10b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1
     &),4,3,1,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h10b-1),int_mb(k_range+p3b-1
     &),4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_1',5,MA_E
     &RR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_2_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      length = 0
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_2_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h10b
     & - 1 + noab * (p3b - noab - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int
     &_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_vt + = 1/2 * Sum ( h11 ) * t ( p3 h11 )_t * i2 ( h10 h11 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER h11b
      INTEGER p3b_1
      INTEGER h11b_1
      INTEGER h10b_2
      INTEGER h11b_2
      INTEGER h1b_2
      INTEGER h2b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO h11b = 1,noab
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h11b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+h11b-1)) .eq. irrep_t) T
     &HEN
      CALL TCE_RESTRICTED_2(p3b,h11b,p3b_1,h11b_1)
      CALL TCE_RESTRICTED_4(h10b,h11b,h1b,h2b,h10b_2,h11b_2,h1b_2,h2b_2)
      dim_common = int_mb(k_range+h11b-1)
      dima_sort = int_mb(k_range+p3b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h1b-1) * int_m
     &b(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h11b_
     &1 - 1 + noab * (p3b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+h11b-1),1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_2',5,MA_ERR)
      IF ((h11b .lt. h10b)) THEN
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
     & - 1 + noab * (h1b_2 - 1 + noab * (h10b_2 - 1 + noab * (h11b_2 - 1
     &)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h11b-1
     &),int_mb(k_range+h10b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-
     &1),4,3,2,1,-1.0d0)
      END IF
      IF ((h10b .le. h11b)) THEN
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
     & - 1 + noab * (h1b_2 - 1 + noab * (h11b_2 - 1 + noab * (h10b_2 - 1
     &)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-
     &1),4,3,1,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_2',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_2',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h10b-1),int_mb(k_range+p3b-1
     &),4,3,2,1,1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_2',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_2_1(d_a,k_a_offset,d_c,k_c_offset,
     & ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 h11 h1 h2 )_v + = -1 * v ( h10 h11 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER h10b_1
      INTEGER h11b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_mb(k_
     &range+h1b-1) * int_mb(k_range+h2b-1)
      CALL TCE_RESTRICTED_4(h10b,h11b,h1b,h2b,h10b_1,h11b_1,h1b_1,h2b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_
     &mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_2_1',1,MA_ERR)
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h10b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h10b_1 - 1)))),h2b_1,h1b_1,h11b_1,h10b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-
     &1),4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_2_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_2_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h11b-1),int_mb(k_range+h10b-
     &1),4,3,2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h11b - 1 + noab * (h10b - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_2_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_2_1',5,MA
     &_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_2_2_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 h11 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      length = 0
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_2_2_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h11b
     & - 1 + noab * (h10b - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * in
     &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_2_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 h11 h1 h2 )_vt + = 1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * i3 ( h10 h11 h2 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER h10b_2
      INTEGER h11b_2
      INTEGER h2b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) 
     &THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_mb(k_
     &range+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p5b,h1b,p5b_1,h1b_1)
      CALL TCE_RESTRICTED_4(h10b,h11b,h2b,p5b,h10b_2,h11b_2,h2b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_
     &mb(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_2_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p5b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_2_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_2_2',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - noab - 1 + nvab * (h2b_2 - 1 + noab * (h11b_2 - 1 + noab * (h10
     &b_2 - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+h2b-1),int_mb(k_range+p5b-
     &1),3,2,1,4,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_2_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_2_2',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_2_2',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_2_2',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h10b-1),int_mb(k_range+h1b-
     &1),3,2,4,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h11b - 1 + noab * (h10b - 1)))))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h10b-1),int_mb(k_range+h1b-
     &1),3,2,1,4,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (h11b - 1 + noab * (h10b - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_2_2',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_2_2',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_2_2_1(d_a,k_a_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i3 ( h10 h11 h1 p5 )_v + = 1 * v ( h10 h11 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER h10b_1
      INTEGER h11b_1
      INTEGER h1b_1
      INTEGER p5b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_mb(k_
     &range+h1b-1) * int_mb(k_range+p5b-1)
      CALL TCE_RESTRICTED_4(h10b,h11b,h1b,p5b,h10b_1,h11b_1,h1b_1,p5b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_
     &mb(k_range+h1b-1) * int_mb(k_range+p5b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_2_2_1',1,MA_ERR)
      IF ((h1b .le. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h10b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h10b_1 - 1)))),p5b_1,h1b_1,h11b_1,h10b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+p5b-
     &1),4,3,2,1,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_2_2_1',2,MA_ER
     &R)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_2_2_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h11b-1),int_mb(k_range+h10b-
     &1),4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h11b - 1 + noab * (h10b - 1)
     &))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_2_2_1',4,MA_ER
     &R)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_2_2_1',5,
     &MA_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_2_2_2_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i3 ( h10 h11 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER p5b
      length = 0
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_2_2_2_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h1b - 1 + noab 
     &* (h11b - 1 + noab * (h10b - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * in
     &t_mb(k_range+h1b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_2_2_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_o
     &ffset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i3 ( h10 h11 h1 p5 )_vt + = -1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h10 h11 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER h10b_2
      INTEGER h11b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_v,irrep_t)) 
     &THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_mb(k_
     &range+h1b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h1b,p6b_1,h1b_1)
      CALL TCE_RESTRICTED_4(h10b,h11b,p5b,p6b,h10b_2,h11b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_
     &mb(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_2_2_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_2_2_2',3,MA_ER
     &R)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_2_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_2_2_2',5,MA_ERR)
      IF ((p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h10b_2 - 1)))),p5b_2,p6b_2,h11b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-
     &1),4,2,1,3,-1.0d0)
      END IF
      IF ((p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h10b_2 - 1)))),p6b_2,p5b_2,h11b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-
     &1),3,2,1,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_2_2_2',6,MA_ER
     &R)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_2_2_2',7,
     &MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_2_2_2',8,
     &MA_ERR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_2_2_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h10b-1),int_mb(k_range+h1b-
     &1),3,2,4,1,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h11b - 1 + noab * (h10b - 1)
     &))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_2_2_2',10,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_2_2_2',11
     &,MA_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_2_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 h11 h1 h2 )_vt + = -1/2 * Sum ( p7 p8 ) * t ( p7 p8 h1 h2 )_t * v ( h10 h11 p7 p8 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p7b
      INTEGER p8b
      INTEGER p7b_1
      INTEGER p8b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER h10b_2
      INTEGER h11b_2
      INTEGER p7b_2
      INTEGER p8b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsuperp(2)
      INTEGER isuperp
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO h11b = h10b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b
     &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin
     &+h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m
     &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) 
     &THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * int_mb(k_
     &range+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p7b = noab+1,noab+nvab
      DO p8b = p7b,noab+nvab
      IF (int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p7b,p8b,h1b,h2b,p7b_1,p8b_1,h1b_1,h2b_1)
      CALL TCE_RESTRICTED_4(h10b,h11b,p7b,p8b,h10b_2,h11b_2,p7b_2,p8b_2)
      dim_common = int_mb(k_range+p7b-1) * int_mb(k_range+p8b-1)
      dima_sort = int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_2_3',2,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p8b_1 - noab - 1 + nvab * (p7b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p7b-1)
     &,int_mb(k_range+p8b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_2_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_2_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_2_3',5,MA_ERR)
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p8b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p8b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h10b_2 - 1)))),p8b_2,p7b_2,h11b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h11b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-
     &1),2,1,4,3,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_2_3',6,MA_ERR)
      nsuperp(1) = 1
      nsuperp(2) = 1
      isuperp = 1
      IF (p7b .eq. p8b) THEN
      nsuperp(isuperp) = nsuperp(isuperp) + 1
      ELSE
      isuperp = isuperp + 1
      END IF
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsuperp(1))/FACTORIAL(nsuperp(2)),dbl_mb(k_a_sort),dim_common,dbl_
     &mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_2_3',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_2_3',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_2_3',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h11b-1
     &),int_mb(k_range+h10b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-
     &1),2,1,4,3,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h11b - 1 + noab * (h10b - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_2_3',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_2_3',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * i2 ( h10 p3 h2 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER h10b_2
      INTEGER h2b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p5b,h1b,p5b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,h10b,h2b,p5b,p3b_2,h10b_2,h2b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_m
     &b(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_3',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p5b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_3',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - noab - 1 + nvab * (h2b_2 - 1 + noab * (h10b_2 - 1 + noab * (p3b
     &_2 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h2b-1),int_mb(k_range+p5b-1
     &),3,2,1,4,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_3',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_3',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_3',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_3',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1
     &),3,2,4,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1
     &),3,2,1,4,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_3',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_3_1(d_a,k_a_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 p3 h1 p5 )_v + = 1 * v ( h10 p3 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER p3b_1
      INTEGER h10b_1
      INTEGER h1b_1
      INTEGER p5b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+p5b-1)
      CALL TCE_RESTRICTED_4(p3b,h10b,h1b,p5b,p3b_1,h10b_1,h1b_1,p5b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_m
     &b(k_range+h1b-1) * int_mb(k_range+p5b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_3_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_3_1',1,MA_ERR)
      IF ((h10b .le. p3b) .and. (h1b .le. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p3b_1 - 1 + (noab
     &+nvab) * (h10b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p3b_1 - 1 + (noab
     &+nvab) * (h10b_1 - 1)))),p5b_1,h1b_1,p3b_1,h10b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+p5b-1
     &),4,3,1,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_3_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_3_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h10b-1),int_mb(k_range+p3b-1
     &),4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noa
     &b - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_3_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_3_1',5,MA
     &_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_2_3_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 p3 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER p5b
      length = 0
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_2_3_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h1b - 1 + noab 
     &* (h10b - 1 + noab * (p3b - noab - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int
     &_mb(k_range+h1b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_2_3_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 p3 h1 p5 )_vt + = -1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h10 p3 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER h10b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_3_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h1b,p6b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,h10b,p5b,p6b,p3b_2,h10b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_m
     &b(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_3_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_3_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_3_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_3_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_3_2',5,MA_ERR)
      IF ((h10b .le. p3b) .and. (p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))),p5b_2,p6b_2,p3b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p3b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1
     &),4,1,2,3,-1.0d0)
      END IF
      IF ((h10b .le. p3b) .and. (p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))),p6b_2,p5b_2,p3b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p3b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
     &),3,1,2,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_3_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_3_2',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_3_2',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_3_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1
     &),3,2,4,1,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noa
     &b - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_3_2',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_3_2',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_4(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_ft + = -1 * Sum ( p5 ) * t ( p3 p5 h1 h2 )_t * i2 ( h10 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p3b_1
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER h10b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_f,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_4',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p5b,h1b,h2b,p3b_1,p5b_1,h1b_1,h2b_1)
      CALL TCE_RESTRICTED_2(h10b,p5b,h10b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h1b-1) * int_mb
     &(k_range+h2b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_4',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_4',2,MA_ERR)
      IF ((p5b .lt. p3b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,-1.0d0)
      END IF
      IF ((p3b .le. p5b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p5b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p5b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,1,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_4',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_4',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_4',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - noab - 1 + nvab * (h10b_2 - 1)))
      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p5b-1),1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_4',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_4',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_4',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_4',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h10b-1
     &),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1
     &),4,1,3,2,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_4',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_4',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_4_1(d_a,k_a_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 p5 )_f + = 1 * f ( h10 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER p5b
      INTEGER dimc
      INTEGER h10b_1
      INTEGER p5b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p5b-
     &1).ne.4)) THEN
      IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+p5b-1)
      CALL TCE_RESTRICTED_2(h10b,p5b,h10b_1,p5b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h10b-1) * int_mb(k_range+p5b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_4_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_4_1',1,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p5b_1
     & - 1 + (noab+nvab) * (h10b_1 - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p5b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_4_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_4_1',3,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h10b-1),2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h10b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_4_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_4_1',5,MA
     &_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_2_4_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h10b
      INTEGER p5b
      length = 0
      DO h10b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) T
     &HEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p5b-
     &1).ne.4)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_2_4_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h10b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) T
     &HEN
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p5b-
     &1).ne.4)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h10b - 1)
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h10b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_2_4_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h10 p5 )_vt + = -1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 h10 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h10b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER h7b
      INTEGER p6b_1
      INTEGER h7b_1
      INTEGER h10b_2
      INTEGER h7b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h10b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p5b-
     &1).ne.4)) THEN
      IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+p5b-1)) .eq. ieor(irrep
     &_v,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h10b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_4_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      DO h7b = 1,noab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h7b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h7b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h7b,p6b_1,h7b_1)
      CALL TCE_RESTRICTED_4(h10b,h7b,p5b,p6b,h10b_2,h7b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1) * int_mb(k_range+h7b-1)
      dima_sort = 1
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1) * int_mb(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_4_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_4_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h7b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h7b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_4_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_4_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_4_2',5,MA_ERR)
      IF ((h7b .le. h10b) .and. (p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))),p5b_2,p6b_2,h10b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1
     &),4,2,1,3,-1.0d0)
      END IF
      IF ((h7b .le. h10b) .and. (p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))),p6b_2,p5b_2,h10b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
     &),3,2,1,4,1.0d0)
      END IF
      IF ((h10b .lt. h7b) .and. (p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))),p5b_2,p6b_2,h7b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1
     &),4,1,2,3,1.0d0)
      END IF
      IF ((h10b .lt. h7b) .and. (p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))),p6b_2,p5b_2,h7b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h7b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
     &),3,1,2,4,-1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_4_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_4_2',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_4_2',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_4_2',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h10b-1),2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h10b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_4_2',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_4_2',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_5(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_vt + = 1 * P( 2 ) * Sum ( h7 p9 ) * t ( p3 p9 h1 h7 )_t * i2 ( h7 h10 h2 p9 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p9b
      INTEGER h7b
      INTEGER p3b_1
      INTEGER p9b_1
      INTEGER h1b_1
      INTEGER h7b_1
      INTEGER h10b_2
      INTEGER h7b_2
      INTEGER h2b_2
      INTEGER p9b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_5',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p9b = noab+1,noab+nvab
      DO h7b = 1,noab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p9b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h7b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p9b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h7b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p9b,h1b,h7b,p3b_1,p9b_1,h1b_1,h7b_1)
      CALL TCE_RESTRICTED_4(h10b,h7b,h2b,p9b,h10b_2,h7b_2,h2b_2,p9b_2)
      dim_common = int_mb(k_range+p9b-1) * int_mb(k_range+h7b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h10b-1) * int_mb(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_5',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_5',2,MA_ERR)
      IF ((p9b .lt. p3b) .and. (h7b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h7b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p9b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p9b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h7b-1),int_mb(k_range+h1b-1)
     &,4,2,3,1,1.0d0)
      END IF
      IF ((p9b .lt. p3b) .and. (h1b .le. h7b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h7b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p9b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p9b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+h7b-1)
     &,3,2,4,1,-1.0d0)
      END IF
      IF ((p3b .le. p9b) .and. (h7b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h7b_1 - 1 + noab * (p9b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p9b-1),int_mb(k_range+h7b-1),int_mb(k_range+h1b-1)
     &,4,1,3,2,-1.0d0)
      END IF
      IF ((p3b .le. p9b) .and. (h1b .le. h7b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h7b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p9b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p9b-1),int_mb(k_range+h1b-1),int_mb(k_range+h7b-1)
     &,3,1,4,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_5',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_5',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_5',5,MA_ERR)
      IF ((h7b .le. h10b)) THEN
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p9b_2
     & - noab - 1 + nvab * (h2b_2 - 1 + noab * (h10b_2 - 1 + noab * (h7b
     &_2 - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h2b-1),int_mb(k_range+p9b-1
     &),3,2,1,4,1.0d0)
      END IF
      IF ((h10b .lt. h7b)) THEN
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p9b_2
     & - noab - 1 + nvab * (h2b_2 - 1 + noab * (h7b_2 - 1 + noab * (h10b
     &_2 - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+h7b-1),int_mb(k_range+h2b-1),int_mb(k_range+p9b-1
     &),3,1,2,4,-1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_5',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_5',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_5',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_5',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1
     &),4,2,3,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1
     &),4,2,1,3,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_5',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_5',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_5_1(d_a,k_a_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h7 h10 h1 p9 )_v + = 1 * v ( h7 h10 h1 p9 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h7b
      INTEGER h10b
      INTEGER h1b
      INTEGER p9b
      INTEGER dimc
      INTEGER h7b_1
      INTEGER h10b_1
      INTEGER h1b_1
      INTEGER p9b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h7b = 1,noab
      DO h10b = h7b,noab
      DO h1b = 1,noab
      DO p9b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN
      IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p9b-1)) THEN
      IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h7b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+p9b-1)
      CALL TCE_RESTRICTED_4(h7b,h10b,h1b,p9b,h7b_1,h10b_1,h1b_1,p9b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h7b-1) * int_mb(k_range+h10b-1) * int_m
     &b(k_range+h1b-1) * int_mb(k_range+p9b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_5_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_5_1',1,MA_ERR)
      IF ((h1b .le. p9b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h10b_1 - 1 + (noa
     &b+nvab) * (h7b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(p9b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h10b_1 - 1 + (noa
     &b+nvab) * (h7b_1 - 1)))),p9b_1,h1b_1,h10b_1,h7b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h1b-1),int_mb(k_range+p9b-1
     &),4,3,2,1,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_5_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_5_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p9b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h10b-1),int_mb(k_range+h7b-1
     &),4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p9b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h10b - 1 + noab * (h7b - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_5_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_5_1',5,MA
     &_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_2_5_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h7 h10 h1 p9 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h7b
      INTEGER h10b
      INTEGER h1b
      INTEGER p9b
      length = 0
      DO h7b = 1,noab
      DO h10b = h7b,noab
      DO h1b = 1,noab
      DO p9b = noab+1,noab+nvab
      IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p9b-1)) THEN
      IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_2_5_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h7b = 1,noab
      DO h10b = h7b,noab
      DO h1b = 1,noab
      DO p9b = noab+1,noab+nvab
      IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p9b-1)) THEN
      IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p9b - noab - 1 + nvab * (h1b - 1 + noab 
     &* (h10b - 1 + noab * (h7b - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h7b-1) * int_mb(k_range+h10b-1) * int
     &_mb(k_range+h1b-1) * int_mb(k_range+p9b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_2_5_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h7 h10 h1 p9 )_vt + = 1 * Sum ( p5 ) * t ( p5 h1 )_t * v ( h7 h10 p5 p9 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h7b
      INTEGER h10b
      INTEGER h1b
      INTEGER p9b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER h7b_2
      INTEGER h10b_2
      INTEGER p9b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h7b = 1,noab
      DO h10b = h7b,noab
      DO h1b = 1,noab
      DO p9b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN
      IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p9b-1)) THEN
      IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h7b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+p9b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_5_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p5b,h1b,p5b_1,h1b_1)
      CALL TCE_RESTRICTED_4(h7b,h10b,p9b,p5b,h7b_2,h10b_2,p9b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h7b-1) * int_mb(k_range+h10b-1) * int_m
     &b(k_range+p9b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_5_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_5_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p5b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_5_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_5_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_5_2',5,MA_ERR)
      IF ((p5b .le. p9b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p9b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p9b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))),p9b_2,p5b_2,h10b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p5b-1),int_mb(k_range+p9b-1
     &),4,2,1,3,1.0d0)
      END IF
      IF ((p9b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p9b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p9b_2 - 1 + (noab+nvab) * (h10b_2 - 1 + (noa
     &b+nvab) * (h7b_2 - 1)))),p5b_2,p9b_2,h10b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+p9b-1),int_mb(k_range+p5b-1
     &),3,2,1,4,-1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_5_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_5_2',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_5_2',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_5_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p9b-1)
     &,int_mb(k_range+h10b-1),int_mb(k_range+h7b-1),int_mb(k_range+h1b-1
     &),3,2,4,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p9b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h10b - 1 + noab * (h7b - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_5_2',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_5_2',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_2_6(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h10 p3 h1 h2 )_vt + = 1/2 * Sum ( p5 p6 ) * t ( p5 p6 h1 h2 )_t * v ( h10 p3 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h10b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p6b
      INTEGER p5b_1
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER p3b_2
      INTEGER h10b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsuperp(2)
      INTEGER isuperp
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h10b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_2_6',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      DO p6b = p5b,noab+nvab
      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p5b,p6b,h1b,h2b,p5b_1,p6b_1,h1b_1,h2b_1)
      CALL TCE_RESTRICTED_4(p3b,h10b,p5b,p6b,p3b_2,h10b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h10b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_2_6',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_2_6',2,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p6b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p6b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_2_6',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_2_6',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_2_6',5,MA_ERR)
      IF ((h10b .le. p3b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h10b_2 - 1)))),p6b_2,p5b_2,p3b_2,h10b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h10b-1
     &),int_mb(k_range+p3b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
     &),1,2,4,3,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_2_6',6,MA_ERR)
      nsuperp(1) = 1
      nsuperp(2) = 1
      isuperp = 1
      IF (p5b .eq. p6b) THEN
      nsuperp(isuperp) = nsuperp(isuperp) + 1
      ELSE
      isuperp = isuperp + 1
      END IF
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsuperp(1))/FACTORIAL(nsuperp(2)),dbl_mb(k_a_sort),dim_common,dbl_
     &mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_2_6',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_2_6',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_2_6',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h10b-1
     &),int_mb(k_range+p3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1
     &),2,1,4,3,1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h10b - 1 + noab * (p3b - noab - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_2_6',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_2_6',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * i1 ( p3 p4 h2 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER p4b_2
      INTEGER h2b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p5b,h1b,p5b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,p4b,h2b,p5b,p3b_2,p4b_2,h2b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb
     &(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_3',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p5b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_3',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - noab - 1 + nvab * (h2b_2 - 1 + noab * (p4b_2 - noab - 1 + nvab 
     &* (p3b_2 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h2b-1),int_mb(k_range+p5b-1)
     &,3,2,1,4,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_3',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_3',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_3',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_3',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,4,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,1,4,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_3',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_3_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p4 h1 p5 )_v + = 1 * v ( p3 p4 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER p3b_1
      INTEGER p4b_1
      INTEGER h1b_1
      INTEGER p5b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+p5b-1)
      CALL TCE_RESTRICTED_4(p3b,p4b,h1b,p5b,p3b_1,p4b_1,h1b_1,p5b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb
     &(k_range+h1b-1) * int_mb(k_range+p5b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_3_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_3_1',1,MA_ERR)
      IF ((h1b .le. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p4b_1 - 1 + (noab
     &+nvab) * (p3b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p4b_1 - 1 + (noab
     &+nvab) * (p3b_1 - 1)))),p5b_1,h1b_1,p4b_1,p3b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p5b-1)
     &,4,3,2,1,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_3_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_3_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b
     & - noab - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_3_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_3_1',5,MA_E
     &RR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_3_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p4 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER p5b
      length = 0
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_3_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h1b - 1 + noab 
     &* (p4b - noab - 1 + nvab * (p3b - noab - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_
     &mb(k_range+h1b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_3_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p4 h1 p5 )_vt + = -1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( p3 p4 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER p4b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_3_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h1b,p6b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,p4b,p5b,p6b,p3b_2,p4b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb
     &(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_3_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_3_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_3_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_3_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_3_2',5,MA_ERR)
      IF ((p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))),p5b_2,p6b_2,p4b_2,p3b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
     &,4,2,1,3,-1.0d0)
      END IF
      IF ((p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))),p6b_2,p5b_2,p4b_2,p3b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1)
     &,3,2,1,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_3_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_3_2',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_3_2',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_3_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,4,1,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b
     & - noab - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_3_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_3_2',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_4(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_tf + = -1 * P( 2 ) * Sum ( h9 ) * t ( p3 p4 h1 h9 )_t * i1 ( h9 h2 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER h9b
      INTEGER p3b_1
      INTEGER p4b_1
      INTEGER h1b_1
      INTEGER h9b_1
      INTEGER h9b_2
      INTEGER h2b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_t,irrep_f)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_4',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO h9b = 1,noab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h9b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h9b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p4b,h1b,h9b,p3b_1,p4b_1,h1b_1,h9b_1)
      CALL TCE_RESTRICTED_2(h9b,h2b,h9b_2,h2b_2)
      dim_common = int_mb(k_range+h9b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb
     &(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4',2,MA_ERR)
      IF ((h9b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h9b_1 - 1 + noab * (p4b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h9b-1),int_mb(k_range+h1b-1)
     &,4,2,1,3,-1.0d0)
      END IF
      IF ((h1b .le. h9b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h9b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p4b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+h9b-1)
     &,3,2,1,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_4',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_4',5,MA_ERR)
ccx      CALL GET_HASH_BLOCK_MA(dbl_mb(d_b),dbl_mb(k_b),dimb,
ccx     & int_mb(k_b_offset),(h2b_2
ccx     & - 1 + noab * (h9b_2 - 1)))
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
     & - 1 + noab * (h9b_2 - 1)))
c
      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h2b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_4',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_4',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,1,2,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_4',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_4_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h1 )_f + = 1 * f ( h9 h1 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h1b
      INTEGER dimc
      INTEGER h9b_1
      INTEGER h1b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h1b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. irrep_f) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      CALL TCE_RESTRICTED_2(h9b,h1b,h9b_1,h1b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4_1',1,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + (noab+nvab) * (h9b_1 - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4_1',3,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+h1b-1)
     &,int_mb(k_range+h9b-1),2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h9b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4_1',5,MA_E
     &RR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_4_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h1 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h9b
      INTEGER h1b
      length = 0
      DO h9b = 1,noab
      DO h1b = 1,noab
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
     &).ne.4)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_4_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h9b = 1,noab
      DO h1b = 1,noab
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
     &).ne.4)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = h1b - 1 + noab * (h9b - 1)
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_4_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h1 )_ft + = 1 * Sum ( p8 ) * t ( p8 h1 )_t * i2 ( h9 p8 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h1b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p8b
      INTEGER p8b_1
      INTEGER h1b_1
      INTEGER h9b_2
      INTEGER p8b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h1b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
     &f,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_4_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p8b = noab+1,noab+nvab
      IF (int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p8b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p8b,h1b,p8b_1,h1b_1)
      CALL TCE_RESTRICTED_2(h9b,p8b,h9b_2,p8b_2)
      dim_common = int_mb(k_range+p8b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p8b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p8b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_4_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_4_2',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p8b_2
     & - noab - 1 + nvab * (h9b_2 - 1)))
      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+p8b-1),1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_4_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_4_2',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4_2',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4_2',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h1b-1),1,2,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h9b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_4_2',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_4_2_1(d_a,k_a_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h9 p8 )_f + = 1 * f ( h9 p8 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER p8b
      INTEGER dimc
      INTEGER h9b_1
      INTEGER p8b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c ol dway      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p8b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p8b-1)) .eq. irrep_f) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+p8b-1)
      CALL TCE_RESTRICTED_2(h9b,p8b,h9b_1,p8b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h9b-1) * int_mb(k_range+p8b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4_2_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4_2_1',1,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p8b_1
     & - 1 + (noab+nvab) * (h9b_1 - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+p8b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4_2_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4_2_1',3,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p8b-1)
     &,int_mb(k_range+h9b-1),2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p8b -
     & noab - 1 + nvab * (h9b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4_2_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4_2_1',5,MA
     &_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_4_2_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h9 p8 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h9b
      INTEGER p8b
      length = 0
      DO h9b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p8b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p8b-1
     &).ne.4)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_4_2_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h9b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p8b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p8b-1
     &).ne.4)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h9b - 1)
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h9b-1) * int_mb(k_range+p8b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_4_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h9 p8 )_vt + = 1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 h9 p6 p8 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER p8b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER h7b
      INTEGER p6b_1
      INTEGER h7b_1
      INTEGER h9b_2
      INTEGER h7b_2
      INTEGER p8b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p8b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep_
     &v,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+p8b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_4_2_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      DO h7b = 1,noab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h7b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h7b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h7b,p6b_1,h7b_1)
      CALL TCE_RESTRICTED_4(h9b,h7b,p8b,p6b,h9b_2,h7b_2,p8b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1) * int_mb(k_range+h7b-1)
      dima_sort = 1
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1) * int_mb(k_range+p8b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4_2_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4_2_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h7b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h7b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4_2_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_4_2_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_4_2_2',5,MA_ERR)
      IF ((h7b .le. h9b) .and. (p6b .le. p8b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p8b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p8b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p8b_2,p6b_2,h9b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h9b-1),int_mb(k_range+p6b-1),int_mb(k_range+p8b-1)
     &,4,2,1,3,1.0d0)
      END IF
      IF ((h7b .le. h9b) .and. (p8b .lt. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p8b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p8b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p6b_2,p8b_2,h9b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h9b-1),int_mb(k_range+p8b-1),int_mb(k_range+p6b-1)
     &,3,2,1,4,-1.0d0)
      END IF
      IF ((h9b .lt. h7b) .and. (p6b .le. p8b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p8b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p8b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))),p8b_2,p6b_2,h7b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p8b-1)
     &,4,1,2,3,-1.0d0)
      END IF
      IF ((h9b .lt. h7b) .and. (p8b .lt. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p8b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p8b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))),p6b_2,p8b_2,h7b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h7b-1),int_mb(k_range+p8b-1),int_mb(k_range+p6b-1)
     &,3,1,2,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_4_2_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_4_2_2',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4_2_2',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4_2_2',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p8b-1)
     &,int_mb(k_range+h9b-1),2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p8b -
     & noab - 1 + nvab * (h9b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4_2_2',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_4_2_2',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_4_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h1 )_vt + = -1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 h9 h1 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h1b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER h7b
      INTEGER p6b_1
      INTEGER h7b_1
      INTEGER h9b_2
      INTEGER h7b_2
      INTEGER h1b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h1b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
     &v,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_4_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      DO h7b = 1,noab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h7b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h7b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h7b,p6b_1,h7b_1)
      CALL TCE_RESTRICTED_4(h9b,h7b,h1b,p6b,h9b_2,h7b_2,h1b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1) * int_mb(k_range+h7b-1)
      dima_sort = 1
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4_3',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h7b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h7b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_4_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_4_3',5,MA_ERR)
      IF ((h7b .le. h9b) .and. (h1b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (h1b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (h1b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p6b_2,h1b_2,h9b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h9b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
     &,3,2,1,4,1.0d0)
      END IF
      IF ((h9b .lt. h7b) .and. (h1b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (h1b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (h1b_2 - 1 + (noab+nvab) * (h7b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))),p6b_2,h1b_2,h7b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
     &,3,1,2,4,-1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_4_3',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_4_3',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4_3',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4_3',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h1b-1)
     &,int_mb(k_range+h9b-1),2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h9b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_4_3',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_4_4(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h1 )_vt + = -1/2 * Sum ( h8 p6 p7 ) * t ( p6 p7 h1 h8 )_t * v ( h8 h9 p6 p7 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h1b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER p7b
      INTEGER h8b
      INTEGER p6b_1
      INTEGER p7b_1
      INTEGER h1b_1
      INTEGER h8b_1
      INTEGER h9b_2
      INTEGER h8b_2
      INTEGER p6b_2
      INTEGER p7b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsuperp(2)
      INTEGER isuperp
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h1b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
     &v,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_4_4',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      DO p7b = p6b,noab+nvab
      DO h8b = 1,noab
      IF (int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h8b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),ieor(int_mb(k_sym+p7b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h8b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p6b,p7b,h1b,h8b,p6b_1,p7b_1,h1b_1,h8b_1)
      CALL TCE_RESTRICTED_4(h9b,h8b,p6b,p7b,h9b_2,h8b_2,p6b_2,p7b_2)
      dim_common = int_mb(k_range+p6b-1) * int_mb(k_range+p7b-1) * int_m
     &b(k_range+h8b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_4_4',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_4_4',2,MA_ERR)
      IF ((h8b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h8b_1 - 1 + noab * (p7b_1 - noab - 1 + nvab * (p6b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+p7b-1),int_mb(k_range+h8b-1),int_mb(k_range+h1b-1)
     &,4,3,2,1,-1.0d0)
      END IF
      IF ((h1b .le. h8b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h8b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p7b_1 - noab - 1 + nvab * (p6b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+h8b-1)
     &,3,4,2,1,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_4_4',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_4_4',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_4_4',5,MA_ERR)
      IF ((h8b .le. h9b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p7b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h8b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p7b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h9b_2 - 1 + (noab
     &+nvab) * (h8b_2 - 1)))),p7b_2,p6b_2,h9b_2,h8b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
     &,int_mb(k_range+h9b-1),int_mb(k_range+p6b-1),int_mb(k_range+p7b-1)
     &,2,1,4,3,1.0d0)
      END IF
      IF ((h9b .lt. h8b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p7b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p7b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h9b_2 - 1)))),p7b_2,p6b_2,h8b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h8b-1),int_mb(k_range+p6b-1),int_mb(k_range+p7b-1)
     &,1,2,4,3,-1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_4_4',6,MA_ERR)
      nsuperp(1) = 1
      nsuperp(2) = 1
      isuperp = 1
      IF (p6b .eq. p7b) THEN
      nsuperp(isuperp) = nsuperp(isuperp) + 1
      ELSE
      isuperp = isuperp + 1
      END IF
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsuperp(1))/FACTORIAL(nsuperp(2)),dbl_mb(k_a_sort),dim_common,dbl_
     &mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_4_4',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_4_4',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_4_4',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h1b-1),1,2,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h9b - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_4_4',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_4_4',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_5(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_tf + = 1 * P( 2 ) * Sum ( p5 ) * t ( p3 p5 h1 h2 )_t * i1 ( p4 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p3b_1
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER p4b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_t,irrep_f)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_5',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p5b,h1b,h2b,p3b_1,p5b_1,h1b_1,h2b_1)
      CALL TCE_RESTRICTED_2(p4b,p5b,p4b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h1b-1) * int_mb
     &(k_range+h2b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p4b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_5',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_5',2,MA_ERR)
      IF ((p5b .lt. p3b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,-1.0d0)
      END IF
      IF ((p3b .le. p5b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p5b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p5b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,1,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_5',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_5',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_5',5,MA_ERR)
ccx      CALL GET_HASH_BLOCK_MA(dbl_mb(d_b),dbl_mb(k_b),dimb,
ccx     & int_mb(k_b_offset),(p5b_2
ccx     & - noab - 1 + nvab * (p4b_2 - noab - 1)))
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - noab - 1 + nvab * (p4b_2 - noab - 1)))
c
      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p4b-1)
     &,int_mb(k_range+p5b-1),1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_5',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_5',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_5',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_5',9,MA_ERR)
      IF ((p3b .le. p4b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p4b-1)
     &,int_mb(k_range+h2b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,4,1,3,2,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((p4b .le. p3b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p4b-1)
     &,int_mb(k_range+h2b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,1,4,3,2,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_5',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_5',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_5_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p5 )_f + = 1 * f ( p3 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p5b
      INTEGER dimc
      INTEGER p3b_1
      INTEGER p5b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p5b-1)
      CALL TCE_RESTRICTED_2(p3b,p5b,p3b_1,p5b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p5b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_5_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_5_1',1,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p5b_1
     & - 1 + (noab+nvab) * (p3b_1 - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p5b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_5_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_5_1',3,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (p3b - noab - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_5_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_5_1',5,MA_E
     &RR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_5_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER p3b
      INTEGER p5b
      length = 0
      DO p3b = noab+1,noab+nvab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_5_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO p3b = noab+1,noab+nvab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (p3b - noab - 1)
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+p3b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_5_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p5 )_vt + = -1 * Sum ( h7 p6 ) * t ( p6 h7 )_t * v ( h7 p3 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER h7b
      INTEGER p6b_1
      INTEGER h7b_1
      INTEGER p3b_2
      INTEGER h7b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+p5b-1)) .eq. ieor(irrep_
     &v,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_5_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      DO h7b = 1,noab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h7b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h7b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h7b,p6b_1,h7b_1)
      CALL TCE_RESTRICTED_4(p3b,h7b,p5b,p6b,p3b_2,h7b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1) * int_mb(k_range+h7b-1)
      dima_sort = 1
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_5_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_5_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h7b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h7b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_5_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_5_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_5_2',5,MA_ERR)
      IF ((h7b .le. p3b) .and. (p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p5b_2,p6b_2,p3b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
     &,4,2,1,3,-1.0d0)
      END IF
      IF ((h7b .le. p3b) .and. (p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p6b_2,p5b_2,p3b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1)
     &,3,2,1,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_5_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_5_2',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_5_2',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_5_2',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (p3b - noab - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_5_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_5_2',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_5_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( p3 p5 )_vt + = -1/2 * Sum ( h7 h8 p6 ) * t ( p3 p6 h7 h8 )_t * v ( h7 h8 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER h7b
      INTEGER h8b
      INTEGER p3b_1
      INTEGER p6b_1
      INTEGER h7b_1
      INTEGER h8b_1
      INTEGER h7b_2
      INTEGER h8b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsubh(2)
      INTEGER isubh
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p5b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+p5b-1)) .eq. ieor(irrep_
     &v,irrep_t)) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_5_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      DO h7b = 1,noab
      DO h8b = h7b,noab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h
     &7b-1)+int_mb(k_spin+h8b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
     &k_sym+h7b-1),int_mb(k_sym+h8b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p6b,h7b,h8b,p3b_1,p6b_1,h7b_1,h8b_1)
      CALL TCE_RESTRICTED_4(h7b,h8b,p5b,p6b,h7b_2,h8b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1) * int_mb(k_range+h7b-1) * int_m
     &b(k_range+h8b-1)
      dima_sort = int_mb(k_range+p3b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_5_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_5_3',2,MA_ERR)
      IF ((p6b .lt. p3b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h8b_1
     & - 1 + noab * (h7b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p6b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h7b-1),int_mb(k_range+h8b-1)
     &,2,4,3,1,-1.0d0)
      END IF
      IF ((p3b .le. p6b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h8b_1
     & - 1 + noab * (h7b_1 - 1 + noab * (p6b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p6b-1),int_mb(k_range+h7b-1),int_mb(k_range+h8b-1)
     &,1,4,3,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_5_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_5_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_5_3',5,MA_ERR)
      IF ((p6b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p5b_2,p6b_2,h8b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h8b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
     &,4,2,1,3,-1.0d0)
      END IF
      IF ((p5b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h7b_2 - 1)))),p6b_2,p5b_2,h8b_2,h7b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h7b-1)
     &,int_mb(k_range+h8b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1)
     &,3,2,1,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_5_3',6,MA_ERR)
      nsubh(1) = 1
      nsubh(2) = 1
      isubh = 1
      IF (h7b .eq. h8b) THEN
      nsubh(isubh) = nsubh(isubh) + 1
      ELSE
      isubh = isubh + 1
      END IF
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsubh(1))/FACTORIAL(nsubh(2)),dbl_mb(k_a_sort),dim_common,dbl_mb(k
     &_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_5_3',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_5_3',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_5_3',9,MA_ERR)
      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),2,1,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p5b -
     & noab - 1 + nvab * (p3b - noab - 1)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_5_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_5_3',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_6(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vt + = -1/2 * Sum ( h11 h9 ) * t ( p3 p4 h9 h11 )_t * i1 ( h9 h11 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER h9b
      INTEGER h11b
      INTEGER p3b_1
      INTEGER p4b_1
      INTEGER h9b_1
      INTEGER h11b_1
      INTEGER h9b_2
      INTEGER h11b_2
      INTEGER h1b_2
      INTEGER h2b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsubh(2)
      INTEGER isubh
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_6',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO h9b = 1,noab
      DO h11b = h9b,noab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &9b-1)+int_mb(k_spin+h11b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h9b-1),int_mb(k_sym+h11b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p4b,h9b,h11b,p3b_1,p4b_1,h9b_1,h11b_1)
      CALL TCE_RESTRICTED_4(h9b,h11b,h1b,h2b,h9b_2,h11b_2,h1b_2,h2b_2)
      dim_common = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_6',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_6',2,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h11b_
     &1 - 1 + noab * (h9b_1 - 1 + noab * (p4b_1 - noab - 1 + nvab * (p3b
     &_1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h9b-1),int_mb(k_range+h11b-1
     &),2,1,4,3,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_6',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_6',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_6',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
     & - 1 + noab * (h1b_2 - 1 + noab * (h11b_2 - 1 + noab * (h9b_2 - 1)
     &))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1
     &),4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_6',6,MA_ERR)
      nsubh(1) = 1
      nsubh(2) = 1
      isubh = 1
      IF (h9b .eq. h11b) THEN
      nsubh(isubh) = nsubh(isubh) + 1
      ELSE
      isubh = isubh + 1
      END IF
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsubh(1))/FACTORIAL(nsubh(2)),dbl_mb(k_a_sort),dim_common,dbl_mb(k
     &_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_6',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_6',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_6',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_6',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_6',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_6_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h11 h1 h2 )_v + = -1 * v ( h9 h11 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER h9b_1
      INTEGER h11b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      CALL TCE_RESTRICTED_4(h9b,h11b,h1b,h2b,h9b_1,h11b_1,h1b_1,h2b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_m
     &b(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_6_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_6_1',1,MA_ERR)
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h9b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(h2b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h9b_1 - 1)))),h2b_1,h1b_1,h11b_1,h9b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1
     &),4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_6_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_6_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h11b-1),int_mb(k_range+h9b-1
     &),4,3,2,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_6_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_6_1',5,MA_E
     &RR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_6_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h11 h1 h2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      length = 0
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_6_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h11b
     & - 1 + noab * (h9b - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int
     &_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_6_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h11 h1 h2 )_vt + = 1 * P( 2 ) * Sum ( p8 ) * t ( p8 h1 )_t * i2 ( h9 h11 h2 p8 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p8b
      INTEGER p8b_1
      INTEGER h1b_1
      INTEGER h9b_2
      INTEGER h11b_2
      INTEGER h2b_2
      INTEGER p8b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_6_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p8b = noab+1,noab+nvab
      IF (int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p8b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p8b,h1b,p8b_1,h1b_1)
      CALL TCE_RESTRICTED_4(h9b,h11b,h2b,p8b,h9b_2,h11b_2,h2b_2,p8b_2)
      dim_common = int_mb(k_range+p8b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_m
     &b(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_6_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_6_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p8b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p8b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_6_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_6_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_6_2',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p8b_2
     & - noab - 1 + nvab * (h2b_2 - 1 + noab * (h11b_2 - 1 + noab * (h9b
     &_2 - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1
     &),3,2,1,4,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_6_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_6_2',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_6_2',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_6_2',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h9b-1),int_mb(k_range+h1b-1
     &),3,2,4,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1)))))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h9b-1),int_mb(k_range+h1b-1
     &),3,2,1,4,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (h11b - 1 + noab * (h9b - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_6_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_6_2',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_6_2_1(d_a,k_a_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h9 h11 h1 p8 )_v + = 1 * v ( h9 h11 h1 p8 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER p8b
      INTEGER dimc
      INTEGER h9b_1
      INTEGER h11b_1
      INTEGER h1b_1
      INTEGER p8b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+p8b-1)
      CALL TCE_RESTRICTED_4(h9b,h11b,h1b,p8b,h9b_1,h11b_1,h1b_1,p8b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_m
     &b(k_range+h1b-1) * int_mb(k_range+p8b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_6_2_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_6_2_1',1,MA_ERR)
      IF ((h1b .le. p8b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p8b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h9b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(p8b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
     &b+nvab) * (h9b_1 - 1)))),p8b_1,h1b_1,h11b_1,h9b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+p8b-1
     &),4,3,2,1,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_6_2_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_6_2_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p8b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h11b-1),int_mb(k_range+h9b-1
     &),4,3,2,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p8b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_6_2_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_6_2_1',5,MA
     &_ERR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_6_2_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h9 h11 h1 p8 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER p8b
      length = 0
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_6_2_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 
     &* (h11b - 1 + noab * (h9b - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int
     &_mb(k_range+h1b-1) * int_mb(k_range+p8b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_6_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
     &set,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i2 ( h9 h11 h1 p8 )_vt + = 1/2 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h9 h11 p6 p8 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER p8b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER h9b_2
      INTEGER h11b_2
      INTEGER p8b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO p8b = noab+1,noab+nvab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+p8b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+p8b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_6_2_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h1b,p6b_1,h1b_1)
      CALL TCE_RESTRICTED_4(h9b,h11b,p8b,p6b,h9b_2,h11b_2,p8b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_m
     &b(k_range+p8b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_6_2_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_6_2_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_6_2_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_6_2_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_6_2_2',5,MA_ERR)
      IF ((p6b .le. p8b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p8b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p8b_2
     & - 1 + (noab+nvab) * (p6b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h9b_2 - 1)))),p8b_2,p6b_2,h11b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+p6b-1),int_mb(k_range+p8b-1
     &),4,2,1,3,1.0d0)
      END IF
      IF ((p8b .lt. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p8b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p8b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h9b_2 - 1)))),p6b_2,p8b_2,h11b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+p8b-1),int_mb(k_range+p6b-1
     &),3,2,1,4,-1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_6_2_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_6_2_2',7,MA
     &_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_6_2_2',8,MA
     &_ERR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_6_2_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p8b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+h9b-1),int_mb(k_range+h1b-1
     &),3,2,4,1,1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p8b -
     & noab - 1 + nvab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1))
     &)))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_6_2_2',10,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_6_2_2',11,M
     &A_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_6_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h9 h11 h1 h2 )_vt + = -1/2 * Sum ( p5 p6 ) * t ( p5 p6 h1 h2 )_t * v ( h9 h11 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER h9b
      INTEGER h11b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p6b
      INTEGER p5b_1
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER h9b_2
      INTEGER h11b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsuperp(2)
      INTEGER isuperp
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO h9b = 1,noab
      DO h11b = h9b,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
     &h1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
     &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) T
     &HEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r
     &ange+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_6_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      DO p6b = p5b,noab+nvab
      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p5b,p6b,h1b,h2b,p5b_1,p6b_1,h1b_1,h2b_1)
      CALL TCE_RESTRICTED_4(h9b,h11b,p5b,p6b,h9b_2,h11b_2,p5b_2,p6b_2)
      dim_common = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_6_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_6_3',2,MA_ERR)
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p6b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p6b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_6_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_6_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_6_3',5,MA_ERR)
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h9b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h11b_2 - 1 + (noa
     &b+nvab) * (h9b_2 - 1)))),p6b_2,p5b_2,h11b_2,h9b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
     &,int_mb(k_range+h11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
     &),2,1,4,3,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_6_3',6,MA_ERR)
      nsuperp(1) = 1
      nsuperp(2) = 1
      isuperp = 1
      IF (p5b .eq. p6b) THEN
      nsuperp(isuperp) = nsuperp(isuperp) + 1
      ELSE
      isuperp = isuperp + 1
      END IF
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsuperp(1))/FACTORIAL(nsuperp(2)),dbl_mb(k_a_sort),dim_common,dbl_
     &mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_6_3',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_6_3',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_6_3',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h11b-1
     &),int_mb(k_range+h9b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1
     &),2,1,4,3,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1)))))
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_6_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_6_3',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_7(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 4 ) * Sum ( h6 p5 ) * t ( p3 p5 h1 h6 )_t * i1 ( h6 p4 h2 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER h6b
      INTEGER p3b_1
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER h6b_1
      INTEGER p4b_2
      INTEGER h6b_2
      INTEGER h2b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_7',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      DO h6b = 1,noab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h6b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h6b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p5b,h1b,h6b,p3b_1,p5b_1,h1b_1,h6b_1)
      CALL TCE_RESTRICTED_4(p4b,h6b,h2b,p5b,p4b_2,h6b_2,h2b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1) * int_mb(k_range+h6b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p4b-1) * int_mb(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_7',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_7',2,MA_ERR)
      IF ((p5b .lt. p3b) .and. (h6b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h6b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h1b-1)
     &,4,2,3,1,1.0d0)
      END IF
      IF ((p5b .lt. p3b) .and. (h1b .le. h6b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h6b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+h6b-1)
     &,3,2,4,1,-1.0d0)
      END IF
      IF ((p3b .le. p5b) .and. (h6b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h6b_1 - 1 + noab * (p5b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p5b-1),int_mb(k_range+h6b-1),int_mb(k_range+h1b-1)
     &,4,1,3,2,-1.0d0)
      END IF
      IF ((p3b .le. p5b) .and. (h1b .le. h6b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h6b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p5b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p5b-1),int_mb(k_range+h1b-1),int_mb(k_range+h6b-1)
     &,3,1,4,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_7',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_7',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_7',5,MA_ERR)
c *** peta *****
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(h6b_2 -1 + noab * (p5b_2 - noab -1 +nvab * (h2b_2 - 1 + noab *
     &( p4b_2 - noab -1 )))))
c **************
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p4b-1)
     &,int_mb(k_range+h6b-1),int_mb(k_range+h2b-1),int_mb(k_range+p5b-1)
     &,3,1,2,4,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_7',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_7',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_7',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_7',9,MA_ERR)
      IF ((p3b .le. p4b) .and. (h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,4,2,3,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((p3b .le. p4b) .and. (h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,4,2,1,3,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((p4b .le. p3b) .and. (h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,2,4,3,1,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
     & - 1)))))
      END IF
      IF ((p4b .le. p3b) .and. (h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,2,4,1,3,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_7',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_7',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_7_1(d_a,k_a_offset,d_c,k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h6 p3 h1 p5 )_v + = 1 * v ( h6 p3 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h6b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER p3b_1
      INTEGER h6b_1
      INTEGER h1b_1
      INTEGER p5b_1
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
c *** peta ***
      DO p3b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      DO h6b = 1,noab
c ************
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h6b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h6b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+p5b-1)
      CALL TCE_RESTRICTED_4(p3b,h6b,h1b,p5b,p3b_1,h6b_1,h1b_1,p5b_1)
      dim_common = 1
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h6b-1) * int_mb
     &(k_range+h1b-1) * int_mb(k_range+p5b-1)
      dima = dim_common * dima_sort
      IF (dima .gt. 0) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_7_1',0,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_7_1',1,MA_ERR)
      IF ((h6b .le. p3b) .and. (h1b .le. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p3b_1 - 1 + (noab
     &+nvab) * (h6b_1 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),
     &(p5b_1
     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (p3b_1 - 1 + (noab
     &+nvab) * (h6b_1 - 1)))),p5b_1,h1b_1,p3b_1,h6b_1)
      end if
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h6b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+p5b-1)
     &,4,3,1,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_7_1',2,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_7_1',3,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+h6b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,1.0d0)
c *** peta *****
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),
     &(h6b -1 + noab * (p5b - noab -1 +nvab * (h1b - 1 + noab * 
     &( p3b - noab -1 )))))
c **************
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_7_1',4,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_7_1',5,MA_E
     &RR)
      END IF
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_icsd_t2_7_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h6 p3 h1 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER p3b
      INTEGER h6b
      INTEGER h1b
      INTEGER p5b
      length = 0
c *** peta ****
      DO p3b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      DO h6b = 1,noab
c *************
      IF (int_mb(k_spin+h6b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h6b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+p3b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('icsd_t2_7_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
c *** peta ***
      DO p3b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      DO h6b = 1,noab
c ************
      IF (int_mb(k_spin+h6b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h6b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN
      IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+p3b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      addr = addr + 1
c *** peta ***
      int_mb(k_a_offset+addr) = h6b -1 + noab * (p5b - noab -1 +nvab * (
     &h1b - 1 + noab * ( p3b - noab -1 )))
c ************ 
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+p3b-1) * int_mb(k_range+h6b-1) * int_
     &mb(k_range+h1b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE icsd_t2_7_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h6 p3 h1 p5 )_vt + = -1 * Sum ( p7 ) * t ( p7 h1 )_t * v ( h6 p3 p5 p7 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h6b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p7b
      INTEGER p7b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER h6b_2
      INTEGER p5b_2
      INTEGER p7b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
c *** peta ***
      DO p3b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      DO h6b = 1,noab
c ************
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h6b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h6b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_7_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p7b = noab+1,noab+nvab
      IF (int_mb(k_spin+p7b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p7b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p7b,h1b,p7b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,h6b,p5b,p7b,p3b_2,h6b_2,p5b_2,p7b_2)
      dim_common = int_mb(k_range+p7b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h6b-1) * int_mb
     &(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_7_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_7_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p7b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p7b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_7_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_7_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_7_2',5,MA_ERR)
      IF ((h6b .le. p3b) .and. (p7b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))),p5b_2,p7b_2,p3b_2,h6b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h6b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+p7b-1),int_mb(k_range+p5b-1)
     &,4,1,2,3,-1.0d0)
      END IF
      IF ((h6b .le. p3b) .and. (p5b .le. p7b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p7b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p7b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))),p7b_2,p5b_2,p3b_2,h6b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h6b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+p5b-1),int_mb(k_range+p7b-1)
     &,3,1,2,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_7_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_7_2',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_7_2',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_7_2',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h6b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,4,1,-1.0d0)
c *** peta ***
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),
     &(h6b -1 + noab * (p5b - noab -1 +nvab * (h1b - 1 + noab *
     &( p3b - noab -1 )))))
c ************
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_7_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_7_2',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_7_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
     &t,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h6 p3 h1 p5 )_vt + = -1/2 * Sum ( h8 p7 ) * t ( p3 p7 h1 h8 )_t * v ( h6 h8 p5 p7 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h6b
      INTEGER h1b
      INTEGER p5b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p7b
      INTEGER h8b
      INTEGER p3b_1
      INTEGER p7b_1
      INTEGER h1b_1
      INTEGER h8b_1
      INTEGER h6b_2
      INTEGER h8b_2
      INTEGER p5b_2
      INTEGER p7b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
c *** peta ***
      DO p3b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO p5b = noab+1,noab+nvab
      DO h6b = 1,noab
c ************
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h6b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h6b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+p5b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_7_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO h8b = 1,noab
      DO p7b = noab+1,noab+nvab
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p7b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h8b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p7b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h8b-1)))) .eq. irrep_t) THEN
      CALL TCE_RESTRICTED_4(p3b,p7b,h1b,h8b,p3b_1,p7b_1,h1b_1,h8b_1)
      CALL TCE_RESTRICTED_4(h6b,h8b,p5b,p7b,h6b_2,h8b_2,p5b_2,p7b_2)
      dim_common = int_mb(k_range+p7b-1) * int_mb(k_range+h8b-1)
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+h6b-1) * int_mb(k_range+p5b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN





      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_7_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_7_3',2,MA_ERR)
      IF ((p7b .lt. p3b) .and. (h8b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h8b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p7b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p7b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h8b-1),int_mb(k_range+h1b-1)
     &,4,2,3,1,1.0d0)
      END IF
      IF ((p7b .lt. p3b) .and. (h1b .le. h8b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h8b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p3b_1 - noab - 1 + nvab * (p7b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p7b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h1b-1),int_mb(k_range+h8b-1)
     &,3,2,4,1,-1.0d0)
      END IF
      IF ((p3b .le. p7b) .and. (h8b .lt. h1b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (h8b_1 - 1 + noab * (p7b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p7b-1),int_mb(k_range+h8b-1),int_mb(k_range+h1b-1)
     &,4,1,3,2,-1.0d0)
      END IF
      IF ((p3b .le. p7b) .and. (h1b .le. h8b)) THEN
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h8b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p7b_1 - noab - 1 + nvab * (p3b_
     &1 - noab - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+h8b-1)
     &,3,1,4,2,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_7_3',3,MA_ERR)







      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_7_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_7_3',5,MA_ERR)
      IF ((h8b .lt. h6b) .and. (p7b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (h6b_2 - 1 + (noab
     &+nvab) * (h8b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (h6b_2 - 1 + (noab
     &+nvab) * (h8b_2 - 1)))),p5b_2,p7b_2,h6b_2,h8b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
     &,int_mb(k_range+h6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p5b-1)
     &,4,2,1,3,1.0d0)
      END IF
      IF ((h8b .lt. h6b) .and. (p5b .le. p7b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p7b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h6b_2 - 1 + (noab
     &+nvab) * (h8b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p7b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h6b_2 - 1 + (noab
     &+nvab) * (h8b_2 - 1)))),p7b_2,p5b_2,h6b_2,h8b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
     &,int_mb(k_range+h6b-1),int_mb(k_range+p5b-1),int_mb(k_range+p7b-1)
     &,3,2,1,4,-1.0d0)
      END IF
      IF ((h6b .le. h8b) .and. (p7b .lt. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (p7b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))),p5b_2,p7b_2,h8b_2,h6b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h6b-1)
     &,int_mb(k_range+h8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p5b-1)
     &,4,1,2,3,-1.0d0)
      END IF
      IF ((h6b .le. h8b) .and. (p5b .le. p7b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p7b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p7b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (h8b_2 - 1 + (noab
     &+nvab) * (h6b_2 - 1)))),p7b_2,p5b_2,h8b_2,h6b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h6b-1)
     &,int_mb(k_range+h8b-1),int_mb(k_range+p5b-1),int_mb(k_range+p7b-1)
     &,3,1,2,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_7_3',6,MA_ERR)








      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_7_3',7,MA_E
     &RR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_7_3',8,MA_E
     &RR)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_7_3',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h6b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
     &,4,2,3,1,-1.0d0/2.0d0)
c *** peta ***
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),
     &(h6b -1 + noab * (p5b - noab -1 +nvab * (h1b - 1 + noab *
     &( p3b - noab -1 )))))
c ************
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_7_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_7_3',11,MA_
     &ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE icsd_t2_8(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vt + = 1/2 * Sum ( p5 p6 ) * t ( p5 p6 h1 h2 )_t * v ( p3 p4 p5 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
c *** peta ***
c#include "util.fh"
c*************
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p6b
      INTEGER p5b_1
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER h2b_1
      INTEGER p3b_2
      INTEGER p4b_2
      INTEGER p5b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER nsuperp(2)
      INTEGER isuperp
      INTEGER l_c
      INTEGER k_c
      DOUBLE PRECISION FACTORIAL
c *** peta ****
c      logical nodezero         ! True if node 0
c      double precision cpu     ! CPU sec counter
c      double precision wall    ! WALL sec counter
c *************
c old way      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('icsd_t2_8',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      DO p6b = p5b,noab+nvab
      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_t) THEN
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL TCE_RESTRICTED_4(p5b,p6b,h1b,h2b,p5b_1,p6b_1,h1b_1,h2b_1)
      CALL TCE_RESTRICTED_4(p3b,p4b,p5b,p6b,p3b_2,p4b_2,p5b_2,p6b_2)
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9022)ga_nodeid(),cpu, wall
c             write(6,*)'      '
c             call util_flush(6)
      dim_common = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('icsd_t2_8',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &icsd_t2_8',2,MA_ERR)
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
     & - 1 + noab * (h1b_1 - 1 + noab * (p6b_1 - noab - 1 + nvab * (p5b_
     &1 - noab - 1)))))
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9020)ga_nodeid(),cpu, wall,h2b,h1b,p6b,p5b,dima
c             write(6,*)'      ' 
c             call util_flush(6)
c 
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+p6b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,2,1,1.0d0)
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9023)ga_nodeid(),cpu, wall
c             write(6,*)'      '
c             call util_flush(6)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('icsd_t2_8',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('icsd_t2_8',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &icsd_t2_8',5,MA_ERR)
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))))
      else
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (p5b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))),p6b_2,p5b_2,p4b_2,p3b_2)
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9021)ga_nodeid(),cpu, wall,p6b_2,p5b_2,p4b_2,p3b_2,
c     6                    dimb
c             write(6,*)'      '
c             call util_flush(6)
      end if
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1)
     &,2,1,4,3,1.0d0)
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9023)ga_nodeid(),cpu, wall
c             write(6,*)'      '
c             call util_flush(6)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('icsd_t2_8',6,MA_ERR)
      nsuperp(1) = 1
      nsuperp(2) = 1
      isuperp = 1
      IF (p5b .eq. p6b) THEN
      nsuperp(isuperp) = nsuperp(isuperp) + 1
      ELSE
      isuperp = isuperp + 1
      END IF
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,2.0d0/FACTORIAL(
     &nsuperp(1))/FACTORIAL(nsuperp(2)),dbl_mb(k_a_sort),dim_common,dbl_
     &mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9024)ga_nodeid(),cpu, wall
c             write(6,*)'      '
c             call util_flush(6)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('icsd_t2_8',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('icsd_t2_8',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &icsd_t2_8',9,MA_ERR)
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p4b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
     &,2,1,4,3,1.0d0/2.0d0)
c             cpu = - util_cpusec()
c             wall = - util_wallsec()
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
c             cpu = cpu + util_cpusec()
c             wall = wall + util_wallsec()
c             write(6,*)'      '
c             write(6,9025)ga_nodeid(),cpu, wall
c             write(6,*)'      '
c             call util_flush(6)
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('icsd_t2_8',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('icsd_t2_8',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
 9020 format('  T2 GA',i4,1x,'Cpu  wall ',2(f17.12,1x),1x,4i4,2x,i10)
 9021 format('  V2 GA',i4,1x,'Cpu  wall ',2(f17.12,1x),1x,4i4,2x,i10)
 9022 format('  TRANS',i4,1x,'Cpu  wall ',2(f17.12,1x))  
 9023 format('  SORT ',i4,1x,'Cpu  wall ',2(f17.12,1x))
 9024 format('  DGEMM',i4,1x,'Cpu  wall ',2(f17.12,1x))
 9025 format(' ADD_BL',i4,1x,'Cpu  wall ',2(f17.12,1x))
      RETURN
      END
cccx
cccx
cccx
cccx
cccx
cccx
cccx
cccx
cccx
c
c
c
      SUBROUTINE licsd_t2_3x(d_a,k_a_offset,d_b,k_b_offset,d_c,
     &k_c_offset,ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vt + = -1 * P( 2 ) * Sum ( p5 ) * t ( p5 h1 )_t * v ( p3 p4 h2 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
cc      INTEGER NXTVAL
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p5b
      INTEGER p5b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER p4b_2
      INTEGER h2b_2
      INTEGER p5b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
cc      EXTERNAL NXTVAL
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
cc      next = NXTVAL(nprocs)
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = p3b,noab+nvab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('licsd_t2_3',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p5b,h1b,p5b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,p4b,h2b,p5b,p3b_2,p4b_2,h2b_2,p5b_2)
      dim_common = int_mb(k_range+p5b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb
     &(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('licsd_t2_3',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &licsd_t2_3',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p5b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('licsd_t2_3',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('licsd_t2_3',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &licsd_t2_3',5,MA_ERR)
      IF ((h2b .le. p5b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p5b_2
     & - 1 + (noab+nvab) * (h2b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p5b_2
     & - 1 + (noab+nvab) * (h2b_2 - 1 + (noab+nvab) * (p4b_2 - 1 + (noab
     &+nvab) * (p3b_2 - 1)))),p5b_2,h2b_2,p4b_2,p3b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+h2b-1),int_mb(k_range+p5b-1)
     &,3,2,1,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('licsd_t2_3',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('licsd_t2_3',7,MA_ER
     &R)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('licsd_t2_3',8,MA_ER
     &R)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &licsd_t2_3',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,4,1,-1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+p4b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,1,4,1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('licsd_t2_3',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('licsd_t2_3',11,MA_E
     &RR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
cc      next = NXTVAL(-nprocs)
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
c
c
c
c
c
c
c
c
c
c
c
c
      SUBROUTINE vt1ic_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i0 ( p3 p4 h1 h2 )_vtt + = -1/2 * P( 2 ) * Sum ( h5 ) * t ( p3 h5 )_t * i1 ( h5 p4 h1 h2 )_vt
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
cc      INTEGER NXTVAL
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER p4b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER h5b
      INTEGER p3b_1
      INTEGER h5b_1
      INTEGER p4b_2
      INTEGER h5b_2
      INTEGER h1b_2
      INTEGER h2b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
cc      EXTERNAL NXTVAL
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
cc      next = NXTVAL(nprocs)
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO p4b = noab+1,noab+nvab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,ieor(irrep_t
     &,irrep_t))) THEN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('vt1ic_1',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO h5b = 1,noab
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h5b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+h5b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p3b,h5b,p3b_1,h5b_1)
      CALL TCE_RESTRICTED_4(p4b,h5b,h1b,h2b,p4b_2,h5b_2,h1b_2,h2b_2)
      dim_common = int_mb(k_range+h5b-1)
      dima_sort = int_mb(k_range+p3b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p4b-1) * int_mb(k_range+h1b-1) * int_mb
     &(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('vt1ic_1',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &vt1ic_1',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h5b_1
     & - 1 + noab * (p3b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
     &,int_mb(k_range+h5b-1),1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('vt1ic_1',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('vt1ic_1',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &vt1ic_1',5,MA_ERR)
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
     & - 1 + noab * (h1b_2 - 1 + noab * (h5b_2 - 1 + noab * (p4b_2 - noa
     &b - 1)))))
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p4b-1)
     &,int_mb(k_range+h5b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
     &,4,3,1,2,1.0d0)
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('vt1ic_1',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('vt1ic_1',7,MA_ERR)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('vt1ic_1',8,MA_ERR)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &vt1ic_1',9,MA_ERR)
      IF ((p3b .le. p4b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,4,3,2,1,-1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
     & - 1)))))
      END IF
      IF ((p4b .le. p3b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h1b-1),int_mb(k_range+p4b-1),int_mb(k_range+p3b-1)
     &,3,4,2,1,1.0d0/2.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
     & - 1)))))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('vt1ic_1',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('vt1ic_1',11,MA_ERR)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
cc      next = NXTVAL(-nprocs)
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
      SUBROUTINE OFFSET_vt1ic_1_1(l_a_offset,k_a_offset,size)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h5 p3 h1 h2 )_vt
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER p3b
      INTEGER h5b
      INTEGER h1b
      INTEGER h2b
      length = 0
      DO p3b = noab+1,noab+nvab
      DO h5b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+p3b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('vt1ic_1_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO p3b = noab+1,noab+nvab
      DO h5b = 1,noab
      DO h1b = 1,noab
      DO h2b = h1b,noab
      IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+p3b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h5b 
     &- 1 + noab * (p3b - noab - 1)))
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+p3b-1) * int_mb(k_range+h5b-1) * int_
     &mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
      RETURN
      END
      SUBROUTINE vt1ic_1_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset,
     &ctx,icounter)
C     $Id: icsd_t2.F 25219 2014-02-03 19:31:06Z 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     i1 ( h5 p3 h1 h2 )_vt + = -2 * P( 2 ) * Sum ( p6 ) * t ( p6 h1 )_t * v ( h5 p3 h2 p6 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a
      INTEGER k_a_offset
      INTEGER d_b
      INTEGER k_b_offset
      INTEGER d_c
      INTEGER k_c_offset
cc      INTEGER NXTVAL
      INTEGER next
      INTEGER nprocs
      INTEGER count
      INTEGER p3b
      INTEGER h5b
      INTEGER h1b
      INTEGER h2b
      INTEGER dimc
      INTEGER l_c_sort
      INTEGER k_c_sort
      INTEGER p6b
      INTEGER p6b_1
      INTEGER h1b_1
      INTEGER p3b_2
      INTEGER h5b_2
      INTEGER h2b_2
      INTEGER p6b_2
      INTEGER dim_common
      INTEGER dima_sort
      INTEGER dima
      INTEGER dimb_sort
      INTEGER dimb
      INTEGER l_a_sort
      INTEGER k_a_sort
      INTEGER l_a
      INTEGER k_a
      INTEGER l_b_sort
      INTEGER k_b_sort
      INTEGER l_b
      INTEGER k_b
      INTEGER l_c
      INTEGER k_c
cc      EXTERNAL NXTVAL
c old way      INTEGER NXTASK
c -------------------------
      INTEGER ctx,icounter
      external nxt_ctx_create, nxt_ctx_destroy, nxt_ctx_next
c -------------------------
c old way      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
cc      next = NXTVAL(nprocs)
c old way      next = NXTASK(nprocs, 1)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      DO p3b = noab+1,noab+nvab
      DO h5b = 1,noab
      DO h1b = 1,noab
      DO h2b = 1,noab
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+h5b-1
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+h5b-1) .eq. int_mb(k_spin+h
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb(
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
     &EN
      IF (next.eq.count) THEN
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+h5b-1) * int_mb(k_ra
     &nge+h1b-1) * int_mb(k_range+h2b-1)
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
     & ERRQUIT('vt1ic_1_2',0,MA_ERR)
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
      DO p6b = noab+1,noab+nvab
      IF (int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h1b-1)) THEN
      IF (ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
     &EN
      CALL TCE_RESTRICTED_2(p6b,h1b,p6b_1,h1b_1)
      CALL TCE_RESTRICTED_4(p3b,h5b,h2b,p6b,p3b_2,h5b_2,h2b_2,p6b_2)
      dim_common = int_mb(k_range+p6b-1)
      dima_sort = int_mb(k_range+h1b-1)
      dima = dim_common * dima_sort
      dimb_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h5b-1) * int_mb
     &(k_range+h2b-1)
      dimb = dim_common * dimb_sort
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
     & ERRQUIT('vt1ic_1_2',1,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
     &vt1ic_1_2',2,MA_ERR)
      CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     & int_mb(k_a_offset),(h1b_1
     & - 1 + noab * (p6b_1 - noab - 1)))
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p6b-1)
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('vt1ic_1_2',3,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
     & ERRQUIT('vt1ic_1_2',4,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
     &vt1ic_1_2',5,MA_ERR)
      IF ((h5b .le. p3b) .and. (h2b .le. p6b)) THEN
      if(.not.intorb) then
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
     & - 1 + (noab+nvab) * (h2b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h5b_2 - 1)))))
      else
      CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),
     &(p6b_2
     & - 1 + (noab+nvab) * (h2b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + (noab
     &+nvab) * (h5b_2 - 1)))),p6b_2,h2b_2,p3b_2,h5b_2)
      end if
      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h5b-1)
     &,int_mb(k_range+p3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p6b-1)
     &,3,1,2,4,1.0d0)
      END IF
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('vt1ic_1_2',6,MA_ERR)
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
     &t),dima_sort)
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('vt1ic_1_2',7,MA_ERR
     &)
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('vt1ic_1_2',8,MA_ERR
     &)
      END IF
      END IF
      END IF
      END DO
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
     &vt1ic_1_2',9,MA_ERR)
      IF ((h1b .le. h2b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h5b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,4,1,-2.0d0/1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
     & 1 + noab * (h1b - 1 + noab * (h5b - 1 + noab * (p3b - noab - 1)))
     &))
      END IF
      IF ((h2b .le. h1b)) THEN
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
     &,int_mb(k_range+h5b-1),int_mb(k_range+p3b-1),int_mb(k_range+h1b-1)
     &,3,2,1,4,2.0d0/1.0d0)
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
     & 1 + noab * (h2b - 1 + noab * (h5b - 1 + noab * (p3b - noab - 1)))
     &))
      END IF
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('vt1ic_1_2',10,MA_ERR)
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('vt1ic_1_2',11,MA_ER
     &R)
c --- new way ----
      call nxt_ctx_next(ctx, icounter, next)
c ----------------
      END IF
      count = count + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      END DO
      END DO
cc      next = NXTVAL(-nprocs)
c old way      next = NXTASK(-nprocs, 1)
c old way      call GA_SYNC()
      RETURN
      END
c
c
c
c
