fix for issue nwchemgit#990

edoapra · Aug 23, 2024 · 09a5f58 · 09a5f58
1 parent 6b231ab
commit 09a5f58
Showing 1 changed file with 30 additions and 14 deletions.
diff --git a/src/solvation/hnd_coschg.F b/src/solvation/hnd_coschg.F
@@ -588,6 +588,7 @@ subroutine hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc,
       integer iter_cosmo_vem
       integer l_efczfx, k_efczfx  ! memory handles for fixed cosmo-vem charges
       integer g_vem(3) ! ga handles for cosmo-vem GS potential, GS charges, and ES noneq charges
+      integer nefc_rtdb
       double precision, external :: ddot
 c
       oprint_energies = util_print("cosmo_energies",print_never)
@@ -873,6 +874,28 @@ subroutine hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc,
 c
 c        ----- calculate qraw = q* = A^{-1}BQ -----
 c
+         if (.not.rtdb_get(rtdb,'cosmo:n_raw',mt_int,1,nefc_rtdb))
+     c        nefc_rtdb=0
+
+         iep=-99
+         ieq=-99
+         if (all) then
+           iep=i10
+           ieq=i20
+         else if (nucl) then
+           iep=i11
+           ieq=i21
+         else if (elec) then
+           iep=i12
+           ieq=i22
+         endif
+
+         if((nefc_rtdb.eq.0).or.(nefc_rtdb.ne.nefc)) then
+            call dfill(nefc,zero,dbl_mb(ieq),1)
+            status = rtdb_delete(rtdb,'cosmo:qraw')
+            status = rtdb_delete(rtdb,'cosmo:qrawn')
+            status = rtdb_delete(rtdb,'cosmo:qrawe')
+         else
          if (all) then
            if (.not.rtdb_get(rtdb,'cosmo:qraw',mt_dbl,nefc,
      d           dbl_mb(i20))) then
@@ -885,36 +908,29 @@ subroutine hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc,
 c             If no raw nuclear COSMO charges were found initialize x=0
               call dfill(nefc,zero,dbl_mb(i21),1)
            endif
-         else if (elec) then
+        else if (elec) then
            if (.not.rtdb_get(rtdb,'cosmo:qrawe',mt_dbl,nefc,
      d           dbl_mb(i22)))then
 c             If no raw electron COSMO charges were found initialize x=0
               call dfill(nefc,zero,dbl_mb(i22),1)
            endif
-         endif
+           endif
+        endif
 c
          direct=.true.
 c
 c        ----- solve ... -----
 c
-         iep=-99
-         ieq=-99
-         if (all) then
-           iep=i10
-           ieq=i20
-         else if (nucl) then
-           iep=i11
-           ieq=i21
-         else if (elec) then
-           iep=i12
-           ieq=i22
-         endif
 
          call hnd_cg(nat,dbl_mb(iep),dbl_mb(ieq),nefc,
      1        dbl_mb(i40),dbl_mb(i50),dbl_mb(i60),
      d        dbl_mb(i70),
      2                   efcc,efcs,efczz,efciat,ratm)
 c
+         if (.not.rtdb_put(rtdb,'cosmo:n_raw',mt_int,1,nefc))
+     c        call errquit('hnd_coschg: could not store n_raw COSMO ',
+     1                  nefc,RTDB_ERR)
+
          if (all) then
             if (.not.rtdb_put(rtdb,'cosmo:qraw',mt_dbl,nefc,
      d           dbl_mb(i20))) then