Merge pull request #844 from edoapra/dm3doff

restoring 2-D GA based 2-nd derivatives code

src/ddscf/fock_2e.F

@@ -38,7 +38,7 @@ subroutine fock_2e( geom1, ao_basis, mfock, jfac, kfac,
       integer vg_fockc
       integer dims(3), chunk(3),alo(3),ahi(3),blo(3),bhi(3)
       external ga_create_atom_blocked
-      logical xc_active, jfit,oprint,odft,cphf_uhf
+      logical xc_active, jfit,oprint,odft,cphf_uhf,dm3d
       oprint= util_print('fock_2e',print_debug)
       cphf_uhf = .false.
       if (.not. rtdb_get(bgj_get_rtdb_handle(), 
@@ -183,8 +183,16 @@ subroutine fock_2e( geom1, ao_basis, mfock, jfac, kfac,
       Exc(1) = 0.0d0
       Exc(2) = 0.0d0
       nExc = 1
-      call fock_xc(geom1, nbf,ao_basis,
-     &             nfock, vg_dens, g_xc,Exc,nExc,.false.)
+      if (.not. rtdb_get(bgj_get_rtdb_handle(), 
+     &     'dft:dm3d', mt_log, 1, dm3d)) 
+     D     dm3d = .false.
+      if(dm3d) then
+         call fock_xc_dm3d(geom1, nbf,ao_basis,
+     &        nfock, vg_dens, g_xc,Exc,nExc,.false.)
+      else
+         call fock_xc(geom1, nbf,ao_basis,
+     &        nfock, vg_dens, g_xc,Exc,nExc,.false.)
+      endif
       ffac=1d0
       if (xc_active) then
          odft=nfock.eq.4

src/ddscf/fock_xc.F

@@ -64,7 +64,7 @@ subroutine fock_xc(geom, nbf_ao, ao_bas_han,
       integer dims(3),chunk(3)
       integer igxcd,lgxcd
       integer xc_getipol
-      logical oprint, debug
+      logical oprint, debug, oprint_trace
       integer alo(3), ahi(3), blo(3), bhi(3)
       integer nfock_xc,i
       integer ityp, ndim
@@ -77,6 +77,7 @@ subroutine fock_xc(geom, nbf_ao, ao_bas_han,
 c
       if(.not.xc_gotxc()) return
       oprint= util_print('fock_xc',print_debug)
+      oprint_trace= util_print('fock_xc_trace',print_debug)
 
 c ... jochen: 
       debug = .false.
@@ -110,6 +111,7 @@ subroutine fock_xc(geom, nbf_ao, ao_bas_han,
      &      write(luout,*)' fockxc: calc_type not set: setting to 1'
          calc_type = 1
       endif
+      if(ga_nodeid().eq.0) write(6,*) ' fock_xc: ctype ',calc_type
 c
 c     == need a better solution for this == NXG
 c Daniel (2-16-13): This line of code is VERY dangerous.  It caused 

src/ddscf/fock_xc_dm3d.F

@@ -64,7 +64,7 @@ subroutine fock_xc_dm3d(geom, nbf_ao, ao_bas_han,
       integer dims(3),chunk(3)
       integer igxcd,lgxcd
       integer xc_getipol
-      logical oprint, debug
+      logical oprint, debug, oprint_trace
       integer alo(3), ahi(3), blo(3), bhi(3)
       integer nfock_xc,i
       integer ityp, ndim
@@ -79,6 +79,7 @@ subroutine fock_xc_dm3d(geom, nbf_ao, ao_bas_han,
 c
       if(.not.xc_gotxc()) return
       oprint= util_print('fock_xc',print_debug)
+      oprint_trace= util_print('fock_xc_trace',print_debug)
 
 c ... jochen: 
       debug = .false.
@@ -112,6 +113,7 @@ subroutine fock_xc_dm3d(geom, nbf_ao, ao_bas_han,
      &      write(luout,*)' fockxc: calc_type not set: setting to 1'
          calc_type = 1
       endif
+      if(ga_nodeid().eq.0) write(6,*) ' fock_xcd3d: ctype ',calc_type
 c
 c     == need a better solution for this == NXG
 c Daniel (2-16-13): This line of code is VERY dangerous.  It caused 

src/tools/mpipr-too-many_patch.sh

@@ -3,47 +3,60 @@ rm -f mpipr-too-many.patch
 cat > mpipr-too-many.patch <<EOF
 --- $1/comex/src-mpi-pr/comex.c.org	2023-07-12 19:10:15.711084258 -0700
 +++ $1/comex/src-mpi-pr/comex.c	2023-07-12 19:10:21.851117110 -0700
-@@ -358,6 +358,7 @@
+@@ -51,7 +51,7 @@
+ 
+ #define XSTR(x) #x
+ #define STR(x) XSTR(x)
+-
++#define MIN(a, b) (((b) < (a)) ? (b) : (a))
+ /* data structures */
+ 
+ typedef enum {
+@@ -358,6 +358,8 @@
  static int devshm_initialized = 0;
  static long devshm_fs_left = 0;
  static long devshm_fs_initial = 0;
++static long counter_open_fds = 0;
 +STATIC void count_open_fds(void);
  
  int comex_init()
  {
-@@ -7215,6 +7216,7 @@
- 	    g_state.rank, g_state.node_size, devshm_fs_initial/CONVERT_TO_M, (long) ufs_statfs.f_bsize, (long)  g_state.node_size);
- #endif
-   }
-+  count_open_fds();
-   //  if (size > 0) {
-     newspace = (long) ( size*(g_state.node_size -1));
-     //  }else{
-@@ -7248,3 +7250,24 @@
+@@ -4746,6 +4748,7 @@
+ 
+     /* set the size of my shared memory object */
+     check_devshm(fd, size);
++    count_open_fds();
+     retval = ftruncate(fd, size);
+     if (-1 == retval) {
+         perror("_shm_create: ftruncate");
+@@ -7248,3 +7251,27 @@
  #endif
  #endif
  }
 +
 +STATIC void count_open_fds(void) {
-+  FILE *f = fopen("/proc/sys/fs/file-nr", "r");
++  /* check only every 100 ops && rank == 1 */
++  counter_open_fds += 1;
++  if (counter_open_fds % 100 == 0 && g_state.rank == MIN(1,g_state.node_size)) {
++    FILE *f = fopen("/proc/sys/fs/file-nr", "r");
 +
-+  long nfiles, unused, maxfiles;
-+  fscanf(f, "%ld %ld %ld", &nfiles, &unused, &maxfiles);
++    long nfiles, unused, maxfiles;
++    fscanf(f, "%ld %ld %ld", &nfiles, &unused, &maxfiles);
 +#ifdef DEBUGSHM
-+  if(nfiles % 1000 == 0) fprintf(stderr," %d: no. open files = %ld maxfiles = %ld\n", g_state.rank, nfiles, maxfiles);
++    if(nfiles % 1000 == 0) fprintf(stderr," %d: no. open files = %ld maxfiles = %ld\n", g_state.rank, nfiles, maxfiles);
 +#endif
-+  long mylimit = (maxfiles/100)*90;
-+    if(nfiles > (maxfiles/100)*90) {
-+      printf(" %d: running out of files; files = %ld  maxfiles = %ld\n", g_state.rank, nfiles, maxfiles);
++    if(nfiles > (maxfiles/100)*80) {
++      printf(" %d: running out of files; files = %ld  maxfiles = %ld \n", g_state.rank, nfiles, maxfiles);
 +#if PAUSE_ON_ERROR
-+    fprintf(stderr,"%d(%d): too many open files\n",
-+            g_state.rank,  getpid());
-+    pause();
++      fprintf(stderr,"%d(%d): too many open files\n",
++	      g_state.rank,  getpid());
++      pause();
 +#endif
-+    comex_error("count_open_fds: too many open files", -1);
++      comex_error("count_open_fds: too many open files", -1);
++  }
++    fclose(f);
 +  }
-+  fclose(f);
 +}
 EOF
-patch -p0 -s -N < mpipr-too-many.patch
+patch -p0 -s -N < ./mpipr-too-many.patch
 echo mpipr-too-many.patch applied