diff --git a/src/NWints/sifs/build_sifs.sh b/src/NWints/sifs/build_sifs.sh
index e1c0123a52..b08cd970b5 100755
--- a/src/NWints/sifs/build_sifs.sh
+++ b/src/NWints/sifs/build_sifs.sh
@@ -24,3 +24,19 @@ cat > ibummr.patch <<EOF
 EOF
 patch -p0 < ibummr.patch
 rm -f ibummr.patch
+rm -f siftdy.patch
+cat > siftdy.patch <<EOF
+--- siftdy.F.org	2022-12-02 14:50:03.807903254 -0800
++++ siftdy.F	2022-12-02 14:54:13.969471516 -0800
+@@ -282,7 +282,7 @@
+ c
+ c     # default code: just return a dummy string.
+ c
+-      chrtdy = site // 'Machine=?  ??:??:?? ??-???-??'
++      chrtdy = site // 'Machine=unknown'
+ #endif 
+ c
+       return
+EOF
+patch -p0 < siftdy.patch
+rm -f siftdy.patch
diff --git a/src/mp2_grad/mp2_back_transform.F b/src/mp2_grad/mp2_back_transform.F
index 77d6cd2157..1d69db43a5 100644
--- a/src/mp2_grad/mp2_back_transform.F
+++ b/src/mp2_grad/mp2_back_transform.F
@@ -55,7 +55,8 @@ c
       integer l_c_t, k_c_t
       integer l_act, k_act, l_actsh, k_actsh
       integer twopdmunit
-      integer junk, ninseg, ierr, i, j, ish, ishlo, ishhi, shmax, tdim
+      integer junk(2), ninseg, ierr, i, j, ish, ishlo, ishhi, shmax,
+     t     tdim
       integer nsh, natoms, nactive, nblock
 c
       integer k_scr, l_scr, k_lab, l_lab, k_eri, l_eri, leneri, lenscr
@@ -475,7 +476,7 @@ c
          end do                 ! End of a
          call ga_sync()
         if (.not. rtdb_get(rtdb, 'mp2:copyback', mt_log, 1, mp2cpybck))
-     $    mp2cpybck=.false.
+     $    mp2cpybck=.true.
 
          if(mp2cpybck) then
             call mp2_copyback(g_buf,g_buf_trans)
@@ -1158,27 +1159,12 @@ c     check for boundaries of buff()
                write(6,*) ga_nodeid(),' i_1.gt.ihi ',i_1,ihi
                call errquit(' mp2copybck: i boundary passed ',0,0)
             endif
-#if 0
-            call ga_get(g_a_trans,i_0,i_1,
-     A           jlo,jhi,buff(i_0,jlo),i_ld)
-#else
             call ga_get(g_a_trans,i_0,i_1,
      A           jlo,jhi,buff,i_ld)
             call ga_put(g_a, i_0, i_1, jlo, jhi, buff, i_ld)
-#endif
          enddo
       endif
 c     everybody needs to have the buffer filled
       call ga_sync()
-cold      if(dowork) call ga_put(g_a, ilo, ihi, jlo, jhi, buff, ihi-ilo+1)
-      call ga_sync()
-#if 0
-      call ga_sync()
-      tr=ga_ddot(g_a,g_a)
-      tr_tr=ga_ddot(g_a_trans,g_a_trans)
-      if(abs(tr-tr_tr).gt.1d-6)then
-         if(ga_nodeid().eq.0)write(6,*) 'tr ',tr,' tr_tr ',tr_tr
-      endif
-#endif
       return
       end
diff --git a/src/mp2_grad/mp2_energy.F b/src/mp2_grad/mp2_energy.F
index 309b0cfdf7..1156530570 100644
--- a/src/mp2_grad/mp2_energy.F
+++ b/src/mp2_grad/mp2_energy.F
@@ -717,6 +717,10 @@ c
             endif
          endif
          call pstat_on(ps_laifock)
+         if (doprint) then
+            write(6,111) ' Start laifock', util_wallsec()
+            call util_flush(6)
+         end if
          call mp2_lai_fock_uhf_prepar(
      $        g_p_ab_a,g_p_ab_b,g_p_ij_a,g_p_ij_b,
      $        noa,nob,nva,nvb,g_tmpa, g_tmpb,nmo)
@@ -725,6 +729,10 @@ c
      $        noa,nob,nva,nvb,g_lai_a,g_lai_b,rtdb,tol2e_fock)
          call mp2_lai_fock_uhf_tidy(g_tmpa, g_tmpb)
          call pstat_off(ps_laifock)
+         if (doprint) then
+            write(6,111) ' Done laifock', util_wallsec()
+            call util_flush(6)
+         end if
 c
          if (omatrix) then
             call ga_print(g_lai_a)
@@ -782,11 +790,20 @@ c
          if(.not.ga_create(mt_dbl,nmo,nmo,'tot beta dens',nmo,0,
      $        g_p_tot_b))call errquit(
      $        'mp2_energy: ga_create failed',0, GA_ERR)
-c     
+c
+         if (doprint) then
+            write(6,111) ' Start make_tot_dens', util_wallsec()
+            call util_flush(6)
+         end if
+         
          call mp2_make_tot_dens(g_p_ij_a,g_p_ij_b,g_p_ab_a,g_p_ab_b,
      $        g_rhs,g_p_tot_a,g_p_tot_b,noa,nva,nob,nvb,nbf,nmo,
      $        int_mb(k_map_a), int_mb(k_map_b),
      $        g_vecs_a,g_vecs_b,basis,scftype)
+         if (doprint) then
+            write(6,111) ' Done make_tot_dens', util_wallsec()
+            call util_flush(6)
+         end if
 c
          if (otrace) then
             call mp2_print_trace_norm(g_p_tot_a,'g_p_tot_a',nmo)
@@ -931,6 +948,7 @@ c
       endif
 c     
       call ga_sync
+ 111  format(a,' at ', f10.1,'s')
 c     
       end
       subroutine mp2_print_trace_norm(g, text, n)
diff --git a/src/mp2_grad/mp2_make_tot_dens.F b/src/mp2_grad/mp2_make_tot_dens.F
index dcdff3e219..45fa16a229 100644
--- a/src/mp2_grad/mp2_make_tot_dens.F
+++ b/src/mp2_grad/mp2_make_tot_dens.F
@@ -26,6 +26,8 @@
       character*256 p_a_ao
       character*256 p_b_ao
       integer base
+      integer l_buf,k_buf
+      integer ilo,ihi,jlo,jhi,dowork
 c     
       call util_file_name('p_a_ao',.true.,.true.,p_a_ao)
       call util_file_name('p_b_ao',.true.,.true.,p_b_ao)
@@ -48,22 +50,48 @@ c$$$  call ga_put(g_p_tot_a,i,i,a+noa,a+noa,temp,1)
 c$$$  end do
 c$$$  end do
 c     
+      call ga_distribution(g_p_tot_a, ga_nodeid(), 
+     T     ilo, ihi, jlo, jhi)
+c     check if distrib by columns
+      if ((ilo.eq.0).and.(ihi.eq.-1))  then
+         dowork=0
+      else
+         if(ilo.ne.1.and.ihi.ne.nmo) call
+     R        errquit(' mp2maketotdens bug ',0,0)
+         dowork=1
+      endif
       ioff = 0
-      do i = 1+ga_nodeid(),noa,ga_nnodes() ! Loop thru SCF order
+      if(dowork.eq.1) then
+      do i = 1,noa
+         ii = map_a(i)
+         if(ii.ge.jlo.and.ii.le.jhi) then
          do a = 1,nva
-            ii = map_a(i)
             aa = map_a(a+noa)-noa
             ia = ioff+a+(i-1)*nva
             call ga_get(g_rhs,ia,ia,1,1,xx,1)
             call ga_put(g_p_tot_a,aa+noa,aa+noa,ii,ii,xx,1)
             call ga_put(g_p_tot_a,ii,ii,aa+noa,aa+noa,xx,1)
          end do
+         endif
       end do
-c     
-      call ga_copy_patch('n',g_p_ij_a,1,noa,1,noa,g_p_tot_a,
-     $     1,noa,1,noa)
-      call ga_copy_patch('n',g_p_ab_a,1,nva,1,nva,g_p_tot_a,
-     $     noa+1,nmo,noa+1,nmo)
+      if (.not. ma_push_get(mt_dbl, nmo, 'mp2: maket',
+     $     l_buf, k_buf)) call errquit
+     $     ('mp2: insufficient memory : bug ', nmo, MA_ERR)
+
+      do i=jlo,jhi
+         if(i.le.nob) then
+            call ga_get(g_p_ij_a,1,noa,i,i,dbl_mb(k_buf),noa)
+            call ga_put(g_p_tot_a,1,noa,i,i,dbl_mb(k_buf),noa)
+         else
+            call ga_get(g_p_ab_a,1,nva,i-noa,i-noa,dbl_mb(k_buf),nva)
+            call ga_put(g_p_tot_a,noa+1,nmo,i,i,dbl_mb(k_buf),nva)
+         endif
+      enddo
+      if (.not. ma_pop_stack(l_buf)) call errquit
+     $     ('mp2: pop_stack failed ', nmo, MA_ERR)
+      endif
+      call ga_mask_sync(.true.,.false.)
+      call ga_sync()
 c     
       if (scftype .eq. 'UHF') then
          base = (nva*noa)
@@ -71,15 +99,18 @@ c
          base = 0               ! Alpha is the same as beta
       end if
       ioff = base
-      do i = 1+ga_nodeid(),nob,ga_nnodes() ! Loop thru SCF order
+      if (dowork.eq.1) then
+      do i = 1,nob
+         ii = map_b(i)
+         if(ii.ge.jlo.and.ii.le.jhi) then
          do a = 1,nvb
-            ii = map_b(i)
             aa = map_b(a+nob)-nob
             ia = ioff+a+(i-1)*nvb
             call ga_get(g_rhs,ia,ia,1,1,xx,1)
             call ga_put(g_p_tot_b,aa+nob,aa+nob,ii,ii,xx,1)
             call ga_put(g_p_tot_b,ii,ii,aa+nob,aa+nob,xx,1)
          end do
+         endif
       end do
 c$$$  call ga_copy_patch('n',g_rhs,base+1,base+(nvb*nob),
 c$$$  $     1,1,g_p_tot_b,nob+1,nmo,1,nob)
@@ -90,11 +121,25 @@ c$$$  call ga_get(g_rhs,indx,indx,1,1,temp,1)
 c$$$  call ga_put(g_p_tot_b,i,i,a+nob,a+nob,temp,1)
 c$$$  end do
 c$$$  end do
-c     
-      call ga_copy_patch('n',g_p_ij_b,1,nob,1,nob,g_p_tot_b,
-     $     1,nob,1,nob)
-      call ga_copy_patch('n',g_p_ab_b,1,nvb,1,nvb,g_p_tot_b,
-     $     nob+1,nmo,nob+1,nmo)
+c
+      if (.not. ma_push_get(mt_dbl, nmo, 'mp2: maket',
+     $     l_buf, k_buf)) call errquit
+     $     ('mp2: insufficient memory : bug ', nmo, MA_ERR)
+
+      do i=jlo,jhi
+         if(i.le.nob) then
+            call ga_get(g_p_ij_b,1,nob,i,i,dbl_mb(k_buf),nob)
+            call ga_put(g_p_tot_b,1,nob,i,i,dbl_mb(k_buf),nob)
+         else
+            call ga_get(g_p_ab_b,1,nvb,i-nob,i-nob,dbl_mb(k_buf),nvb)
+            call ga_put(g_p_tot_b,nob+1,nmo,i,i,dbl_mb(k_buf),nvb)
+         endif
+      enddo
+      if (.not. ma_pop_stack(l_buf)) call errquit
+     $     ('mp2: pop_stack failed ', nmo, MA_ERR)
+      
+      endif
+      call ga_sync()
 c     
 *ga:1:0
       if(.not.ga_create(mt_dbl,nmo,nbf,'scratch',0,0,g_scratch))
diff --git a/src/mp2_grad/mp2_make_tot_wdens.F b/src/mp2_grad/mp2_make_tot_wdens.F
index a59215b2e2..a7a4da599f 100644
--- a/src/mp2_grad/mp2_make_tot_wdens.F
+++ b/src/mp2_grad/mp2_make_tot_wdens.F
@@ -46,7 +46,7 @@ c
       call ga_copy_patch('n',g_w_ai_a,1,noa_hi,1,nva,g_w_tot_a,
      $     1, noa_hi, noa_hi+1, nmo)
 c     
-      call ga_transpose(g_w_ai_a,g_w_ai_a_tr)
+      call mp2_transpwai(g_w_ai_a,g_w_ai_a_tr)
       call ga_copy_patch('n',g_w_ai_a_tr,1,nva,1,noa_hi,g_w_tot_a,
      $     noa_hi+1,nmo,1,noa_hi)
       call ga_copy_patch('n',g_w_ij_a,1,noa_hi,1,noa_hi,g_w_tot_a,
@@ -55,7 +55,7 @@ c
      $     noa_hi+1,nmo,noa_hi+1,nmo)
       call ga_copy_patch('n',g_w_ai_b,1,nob_hi,1,nvb,g_w_tot_b,
      $     1, nob_hi, nob_hi+1,nmo)
-      call ga_transpose(g_w_ai_b,g_w_ai_b_tr)
+      call mp2_transpwai(g_w_ai_b,g_w_ai_b_tr)
       call ga_copy_patch('n',g_w_ai_b_tr,1,nvb,1,nob_hi,g_w_tot_b,
      $     nob_hi+1,nmo,1,nob_hi)
       call ga_copy_patch('n',g_w_ij_b,1,nob_hi,1,nob_hi,g_w_tot_b,
@@ -148,3 +148,44 @@ c
 c
       end
 
+      subroutine mp2_transpwai(g,g_tr)
+      implicit none
+#include "mafdecls.fh"
+#include "global.fh"
+#include "errquit.fh"
+      integer g,g_tr
+c
+      integer ilo,ihi,jlo,jhi
+      integer i,j
+      integer k_buf,l_buf
+      integer n_row,n_col,gtype
+      integer dowork
+c
+      call ga_inquire(g_tr, gtype, n_row, n_col)
+      call ga_distribution(g_tr, ga_nodeid(), 
+     T     ilo, ihi, jlo, jhi)
+      if ((ilo.eq.0).and.(ihi.eq.-1))  then
+         dowork=0
+      else
+c     check if distrib by columns
+         if(ilo.ne.1.and.ihi.ne.n_row) call
+     R        errquit(' mp2transpwai bug ',0,0)
+         dowork=1
+      endif
+      if(dowork.eq.1) then
+         if (.not. ma_push_get(mt_dbl, n_row, 'mp2: wdens',
+     $        l_buf, k_buf)) call errquit
+     $        ('mp2: insufficient memory : bug ', n_row, MA_ERR)
+      do j=jlo,jhi
+         call ga_get(g,j,j,1,n_row,dbl_mb(k_buf),1)
+          if (.not.ma_verify_allocator_stuff()) stop ' ma ck 2b'
+          call ga_put(g_tr,1,n_row,j,j,dbl_mb(k_buf),n_row)
+           if (.not.ma_verify_allocator_stuff()) stop ' ma ck 2b'
+      enddo
+      if (.not. ma_pop_stack(l_buf)) call errquit
+     $     ('mp2transp pop_stack failed ', n_row, MA_ERR)
+       
+      endif
+      call ga_sync()
+      return
+      end