hobo_server - unstable

src/Davidson/davidson_parallel.irp.f

@@ -2,6 +2,7 @@
 !brought to you by garniroy inc.
 
 use bitmasks
+use f77_zmq
 
 subroutine davidson_process(block, N, idx, vt, st)
   
@@ -58,10 +59,10 @@ subroutine davidson_process(block, N, idx, vt, st)
           call i_h_j (psi_det(1,1,org_j),psi_det(1,1,org_i),n_int,hij)
           call get_s2(psi_det(1,1,org_j),psi_det(1,1,org_i),n_int,s2) 
           do istate=1,N_states
-            vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j)
+            vt (istate,org_i) = vt (istate,org_i) + hij*dav_ut(istate,org_j)
-            vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i)
+            vt (istate,org_j) = vt (istate,org_j) + hij*dav_ut(istate,org_i)
-            st (istate,org_i) = st (istate,org_i) + s2*ut(istate,org_j)
+            st (istate,org_i) = st (istate,org_i) + s2*dav_ut(istate,org_j)
-            st (istate,org_j) = st (istate,org_j) + s2*ut(istate,org_i)
+            st (istate,org_j) = st (istate,org_j) + s2*dav_ut(istate,org_i)
           enddo
         endif
       enddo
@@ -70,15 +71,6 @@ subroutine davidson_process(block, N, idx, vt, st)
 end subroutine
 
 
- BEGIN_PROVIDER [ integer, shortcut_, (0:N_det+1, 2) ]
-&BEGIN_PROVIDER [ integer(bit_kind), version_, (N_int, N_det, 2) ]
-&BEGIN_PROVIDER [ integer(bit_kind), sorted_, (N_int, N_det, 2) ]
-&BEGIN_PROVIDER [ integer, sort_idx_, (N_det, 2) ]
-  implicit none
-  call sort_dets_ab_v(psi_det, sorted_(1,1,1), sort_idx_(1,1), shortcut_(0,1), version_(1,1,1), n_det, N_int)
-  call sort_dets_ba_v(psi_det, sorted_(1,1,2), sort_idx_(1,2), shortcut_(0,2), version_(1,1,2), n_det, N_int)
-END_PROVIDER
-
 
 
 subroutine davidson_collect(block, N, idx, vt, st , v0, s0)
@@ -203,6 +195,8 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, worker_id)
   allocate(vt(N_states, N_det)) 
   allocate(st(N_states, N_det)) 
   
+  call hobo_get()
+  
   do
     call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
     if(task_id == 0) exit
@@ -353,6 +347,9 @@ subroutine davidson_run(zmq_to_qp_run_socket , v0, s0)
       call davidson_collector(zmq_collector, zmq_socket_pull , v0, s0)
       call end_zmq_to_qp_run_socket(zmq_collector)
       call end_zmq_pull_socket(zmq_socket_pull)
+      call hobo_server_end()
+    else if(i==1) then
+      call hobo_server()
     else
       call davidson_slave_inproc(i)
     endif
@@ -362,5 +359,112 @@ end subroutine
 
 
 
+subroutine hobo_server()
+  use f77_zmq
+  implicit none
+  integer(ZMQ_PTR)        context
+  integer(ZMQ_PTR)        responder
+  character*(64)          address
+  character(len=:), allocatable :: buffer
+  integer                 rc
+  
+  allocate (character(len=20) :: buffer)
+  address = 'tcp://*:11223'
+  
+  context   = f77_zmq_ctx_new()
+  responder = f77_zmq_socket(context, ZMQ_REP)
+  rc        = f77_zmq_bind(responder,address)
+  
+  do
+    rc = f77_zmq_recv(responder, buffer, 5, 0)
+    if (buffer(1:rc) /= 'end') then
+      rc = f77_zmq_send (responder, N_det, 4, ZMQ_SNDMORE)
+      rc = f77_zmq_send (responder, psi_det, 16*N_int*N_det, ZMQ_SNDMORE)
+      rc = f77_zmq_send (responder, ut, 8*N_det*N_states, 0)
+    else
+      rc = f77_zmq_send (responder, "end", 3, 0)
+      exit
+    endif
+  enddo
+
+  rc = f77_zmq_close(responder)
+  rc = f77_zmq_ctx_destroy(context)
+end subroutine
 
 
+subroutine hobo_server_end()
+  implicit none
+  use f77_zmq
+  
+  integer(ZMQ_PTR)        context
+  integer(ZMQ_PTR)        requester
+  character*(64)          address
+  integer                 rc
+  character*(64)          buf
+  
+  address = trim(qp_run_address)//':11223'
+  context   = f77_zmq_ctx_new()
+  requester = f77_zmq_socket(context, ZMQ_REQ)
+  rc        = f77_zmq_connect(requester,address)
+
+  rc = f77_zmq_send(requester, "end", 3, 0)
+  rc = f77_zmq_recv(requester, buf, 3, 0)
+  rc = f77_zmq_close(requester)
+  rc = f77_zmq_ctx_destroy(context)
+end subroutine
+
+  
+subroutine hobo_get()
+  implicit none
+  use f77_zmq
+  
+  integer(ZMQ_PTR)        context
+  integer(ZMQ_PTR)        requester
+  character*(64)          address
+  character*(20)          buffer
+!   integer(8),  intent(inout) :: det(N_int,2,*)
+!   double precision, intent(inout) :: u_0(*)
+!   integer,intent(out) :: nd
+  integer                 rc
+  
+  address = trim(qp_run_address)//':11223'
+  
+  context   = f77_zmq_ctx_new()
+  requester = f77_zmq_socket(context, ZMQ_REQ)
+  rc        = f77_zmq_connect(requester,address)
+
+  rc = f77_zmq_send(requester, "Hello", 5, 0)
+  rc = f77_zmq_recv(requester, dav_size, 4, 0)
+  TOUCH dav_size
+  rc = f77_zmq_recv(requester, dav_det, 16*N_int*dav_size, 0)
+  rc = f77_zmq_recv(requester, dav_ut, 8*dav_size*N_states, 0)
+  rc = f77_zmq_close(requester)
+  rc = f77_zmq_ctx_destroy(context)
+end subroutine
+
+
+
+BEGIN_PROVIDER [ integer(bit_kind), dav_det, (N_int, 2, dav_size) ]
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, dav_ut, (N_states, dav_size) ]
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ double precision, ut, (N_states, N_det) ]
+END_PROVIDER
+
+
+BEGIN_PROVIDER [ integer, dav_size ]
+END_PROVIDER
+
+
+ BEGIN_PROVIDER [ integer, shortcut_, (0:dav_size+1, 2) ]
+&BEGIN_PROVIDER [ integer(bit_kind), version_, (N_int, dav_size, 2) ]
+&BEGIN_PROVIDER [ integer(bit_kind), sorted_, (N_int, dav_size, 2) ]
+&BEGIN_PROVIDER [ integer, sort_idx_, (dav_size, 2) ]
+  implicit none
+  call sort_dets_ab_v(dav_det, sorted_(1,1,1), sort_idx_(1,1), shortcut_(0,1), version_(1,1,1), dav_size, N_int)
+  call sort_dets_ba_v(dav_det, sorted_(1,1,2), sort_idx_(1,2), shortcut_(0,2), version_(1,1,2), dav_size, N_int)
+END_PROVIDER

src/Davidson/u0Hu0.irp.f

@@ -177,11 +177,6 @@ BEGIN_PROVIDER [ double precision, psi_energy, (N_states) ]
 END_PROVIDER
 
 
-BEGIN_PROVIDER [ double precision, ut, (N_states, N_det) ]
-  ut = 0d0
-END_PROVIDER
-
-
 subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
   use bitmasks
   use f77_zmq
@@ -231,7 +226,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
 
   v_0 = 0.d0
   s_0 = 0.d0
-  provide ut
+  
   do i=1,n
     do istate=1,N_st
       ut(istate,i) =  u_0(i,istate)