Merge pull request #1050 from edoapra/compilers-august-2024

fix for bsse and so-dft
nwchemgit · Nov 23, 2024 · 0723d20 · 0723d20
2 parents 8217a9b + ad55d48
commit 0723d20
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 3 deletions.
diff --git a/QA/doqmtests.mpi b/QA/doqmtests.mpi
@@ -728,6 +728,8 @@ let "myexit+=$?"
 let "myexit+=$?"
 ./runtests.mpi.unix procs $np p2ta-vem
 let "myexit+=$?"
+./runtests.mpi.unix procs $np bsse_sodft
+let "myexit+=$?"
 if [[ "$what" != "flaky" ]]; then
     echo
     echo  "the number of failed tests is" $myexit

diff --git a/src/nwdft/util/dft_genutils.F b/src/nwdft/util/dft_genutils.F
@@ -42,7 +42,7 @@ logical function dmat_to_file(g_a, fname)
      $     pname//" only valid for double precision matricies", 0, 0)
 
       if (n1 .ne. n2)
-     $     call errquit (pname//"n1 must equal n2")
+     $     call errquit (pname//"n1 must equal n2",0,0)
 C
 C     Do all work on processor 0.
 C     
@@ -131,7 +131,7 @@ logical function dmat_from_file(g_a, fname)
      $     pname//" only valid for double precision  matricies", 0, 0)
 C      
       if (n1 .ne. n2)
-     $     call errquit (pname//"n1 must equal n2")
+     $     call errquit (pname//"n1 must equal n2",0,0)
 C
 C     Do all work on processor 0.
 C     
@@ -238,3 +238,15 @@ subroutine createuniquefilename(filename,idx)
       return
       end
 c $Id$
+      subroutine dft_forceatomic(rtdb)
+      implicit none
+      integer rtdb
+#include "cdft.fh"
+#include "rtdb.fh"
+#include "errquit.fh"
+      movecs_in='atomic'
+      if (.not. rtdb_cput(rtdb, 'dft:input vectors', 1, movecs_in))
+     $    call errquit(' dft_forceatomic: rtdb_cput',0,RTDB_ERR)
+      write(6,*) ' force mos in ',movecs_in
+      return
+      end
diff --git a/src/task/task_bsse.F b/src/task/task_bsse.F
@@ -434,13 +434,15 @@ subroutine bsse_param(rtdb, mult, charge, j_mon_name,
 c:    multiplicity
 c:      density methods
       if ( theory(1:lentheo).eq.'dft' .or.
+     $     theory(1:lentheo).eq.'sodft'.or.
      $     theory(1:lentheo).eq.'tddft') then
         if (.not. rtdb_put(rtdb, 'dft:mult', mt_int, 1, mult))
      $    call errquit('bsse_param: rtdb_put of mult failed',
      $                 0,RTDB_ERR )
 c:      wavefuntion methods
 
       elseif( theory(1:lentheo).ne.'dft' .and.
+     $        theory(1:lentheo).ne.'sodft'.and.
      $        theory(1:lentheo).ne.'tddft') then
         if (.not. rtdb_put(rtdb,'scf:nopen', MT_INT, 1, mult-1))
      $    call errquit('bsse_param: rtdb_put of nopen failed',
@@ -905,13 +907,15 @@ logical function bsse_energy(rtdb,theory,final_spr_energy)
 c: multiplicity
 c:    density methods
         if ( theory(1:lentheo).eq.'dft' .or.
+     $       theory(1:lentheo).eq.'sodft'.or.
      $       theory(1:lentheo).eq.'tddft') then
           if (.not. rtdb_get(rtdb, 'dft:mult', mt_int, 1, m_spr))
      $      call errquit('bsse_energy: rtdb_get of mult failed',
      $                   0,RTDB_ERR )
 c:   wavefuntion methods
 
         elseif( theory(1:lentheo).ne.'dft' .and.
+     $          theory(1:lentheo).ne.'sodft'.and.
      $          theory(1:lentheo).ne.'tddft') then
           if (.not. rtdb_get(rtdb,'scf:nopen', MT_INT, 1, m_spr))
      $      call errquit('bsse_energy: rtdb_get of nopen failed',
@@ -921,7 +925,11 @@ logical function bsse_energy(rtdb,theory,final_spr_energy)
 
 c
 c: name of the original movecs
-        if(theory(1:lentheo).eq.'dft' .or.
+        if(theory(1:lentheo).eq.'sodft') then
+          vec_dbo= 'dft:output vectors'
+          vec_dbi= 'atomic'
+          call dft_forceatomic(rtdb)
+        elseif(theory(1:lentheo).eq.'dft' .or.
      $     theory(1:lentheo).eq.'tddft') then
           vec_dbo= 'dft:output vectors'
           vec_dbi= 'dft:input vectors'
@@ -966,6 +974,7 @@ logical function bsse_energy(rtdb,theory,final_spr_energy)
         call bsse_param(rtdb, mmon(j), qmon(j), j_mon_name, input(i),
      $                  theory)
 c
+        if(theory(1:lentheo).eq.'sodft') call dft_forceatomic(rtdb)
 c:evaluate energy
         if (.not. task_energy_doit(rtdb,theory, mon_energy(i)))
      $    call 
@@ -1028,6 +1037,7 @@ logical function bsse_energy(rtdb,theory,final_spr_energy)
 c:    density methods
 
         if ( theory(1:lentheo).eq.'dft' .or.
+     $        theory(1:lentheo).eq.'sodft'.or.
      $       theory(1:lentheo).eq.'tddft') then
 
           if (.not. rtdb_put(rtdb, 'dft:mult', mt_int, 1, m_spr))
@@ -1037,6 +1047,7 @@ logical function bsse_energy(rtdb,theory,final_spr_energy)
 c:   wavefuntion methods
 
         elseif( theory(1:lentheo).ne.'dft' .and.
+     $         theory(1:lentheo).ne.'sodft'.and.
      $          theory(1:lentheo).ne.'tddft') then
 
           if (.not. rtdb_put(rtdb,'scf:nopen', MT_INT, 1, m_spr))