LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00
Code Issues Releases Wiki Activity

Error messages

Browse Source
This commit is contained in:
Anthony Scemama 2017-11-24 01:02:53 +01:00
parent e09e270a01
commit 9a0654c17d
6 changed files with 54 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ocaml/TaskServer.ml
View File

@ -41,7 +41,7 @@ let debug_env =
let debug str = let debug str =
if debug_env then if debug_env then
Printf.printf "TASK : %s%!" str Printf.eprintf "TASK : %s%!" str

32
plugins/Full_CI_ZMQ/run_pt2_slave.irp.f
View File

@ -30,7 +30,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
zmq_socket_push = new_zmq_push_socket(thread) zmq_socket_push = new_zmq_push_socket(thread)
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
if(worker_id == -1) then if(worker_id == -1) then
print *, "WORKER -1" print *, 'WORKER -1'
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread) call end_zmq_push_socket(zmq_socket_push,thread)
return return
@ -62,7 +62,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
endif endif
if(done .or. (ctask == size(task_id)) ) then if(done .or. (ctask == size(task_id)) ) then
if(buf%N == 0 .and. ctask > 0) stop "uninitialized selection_buffer" if(buf%N == 0 .and. ctask > 0) stop 'uninitialized selection_buffer'
do i=1, ctask do i=1, ctask
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
end do end do
@ -97,26 +97,30 @@ subroutine push_pt2_results(zmq_socket_push, N, index, pt2_detail, task_id, ntas
rc = f77_zmq_send( zmq_socket_push, N, 4, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, N, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "push" if(rc /= 4) stop 'push'
rc = f77_zmq_send( zmq_socket_push, index, 4, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, index, 4, ZMQ_SNDMORE)
if(rc /= 4*N) stop "push" if(rc /= 4*N) stop 'push'
rc = f77_zmq_send( zmq_socket_push, pt2_detail, 8*N_states*N, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, pt2_detail, 8*N_states*N, ZMQ_SNDMORE)
if(rc /= 8*N_states*N) stop "push" if(rc /= 8*N_states*N) stop 'push'
rc = f77_zmq_send( zmq_socket_push, ntask, 4, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, ntask, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "push" if(rc /= 4) stop 'push'
rc = f77_zmq_send( zmq_socket_push, task_id, ntask*4, 0) rc = f77_zmq_send( zmq_socket_push, task_id, ntask*4, 0)
if(rc /= 4*ntask) stop "push" if(rc /= 4*ntask) stop 'push'
! Activate is zmq_socket_push is a REQ ! Activate is zmq_socket_push is a REQ
IRP_IF ZMQ_PUSH IRP_IF ZMQ_PUSH
IRP_ELSE IRP_ELSE
character*(2) :: ok character*(2) :: ok
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
if ((rc /= 2).and.(ok(1:2) /= 'ok')) then
print *, irp_here//': error in receiving ok'
stop -1
endif
IRP_ENDIF IRP_ENDIF
end subroutine end subroutine
@ -133,24 +137,28 @@ subroutine pull_pt2_results(zmq_socket_pull, N, index, pt2_detail, task_id, ntas
integer :: rc, rn, i integer :: rc, rn, i
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
if(rc /= 4) stop "pull" if(rc /= 4) stop 'pull'
rc = f77_zmq_recv( zmq_socket_pull, index, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, index, 4, 0)
if(rc /= 4*N) stop "pull" if(rc /= 4*N) stop 'pull'
rc = f77_zmq_recv( zmq_socket_pull, pt2_detail, N_states*8*N, 0) rc = f77_zmq_recv( zmq_socket_pull, pt2_detail, N_states*8*N, 0)
if(rc /= 8*N_states*N) stop "pull" if(rc /= 8*N_states*N) stop 'pull'
rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0)
if(rc /= 4) stop "pull" if(rc /= 4) stop 'pull'
rc = f77_zmq_recv( zmq_socket_pull, task_id, ntask*4, 0) rc = f77_zmq_recv( zmq_socket_pull, task_id, ntask*4, 0)
if(rc /= 4*ntask) stop "pull" if(rc /= 4*ntask) stop 'pull'
! Activate is zmq_socket_pull is a REP ! Activate is zmq_socket_pull is a REP
IRP_IF ZMQ_PUSH IRP_IF ZMQ_PUSH
IRP_ELSE IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
if (rc /= 2) then
print *, irp_here//': error in sending ok'
stop -1
endif
IRP_ENDIF IRP_ENDIF
end subroutine end subroutine

14
plugins/Full_CI_ZMQ/run_selection_slave.irp.f
View File

@ -132,7 +132,12 @@ subroutine push_selection_results(zmq_socket_push, pt2, b, task_id, ntask)
! Activate is zmq_socket_push is a REQ ! Activate is zmq_socket_push is a REQ
IRP_IF ZMQ_PUSH IRP_IF ZMQ_PUSH
IRP_ELSE IRP_ELSE
rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0) character*(2) :: ok
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
if ((rc /= 2).and.(ok(1:2) /= 'ok')) then
print *, irp_here//': error in receiving ok'
stop -1
endif
IRP_ENDIF IRP_ENDIF
end subroutine end subroutine
@ -186,9 +191,12 @@ subroutine pull_selection_results(zmq_socket_pull, pt2, val, det, N, task_id, nt
! Activate is zmq_socket_pull is a REP ! Activate is zmq_socket_pull is a REP
IRP_IF ZMQ_PUSH IRP_IF ZMQ_PUSH
IRP_ELSE IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0) rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
if (rc /= 2) then
print *, irp_here//': error in sending ok'
stop -1
endif
IRP_ENDIF IRP_ENDIF
end subroutine end subroutine

12
plugins/MPI/broadcast.irp.f
View File

@ -10,9 +10,8 @@ subroutine broadcast_chunks_$double(A, LDA)
! Broadcast with chunks of ~2GB ! Broadcast with chunks of ~2GB
END_DOC END_DOC
integer :: i, sze, ierr integer :: i, sze, ierr
do i=1,LDA,2000000000/$8 do i=1,LDA,200000000/$8
sze = min(LDA-i+1, 2000000000/$8) sze = min(LDA-i+1, 200000000/$8)
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (A(i), sze, MPI_$DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (A(i), sze, MPI_$DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast chuks $double ', i print *, irp_here//': Unable to broadcast chuks $double ', i
@ -44,21 +43,18 @@ subroutine mpi_bcast_psi(energy, size_energy)
include 'mpif.h' include 'mpif.h'
integer :: ierr integer :: ierr
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_states' print *, irp_here//': Unable to broadcast N_states'
stop -1 stop -1
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det' print *, irp_here//': Unable to broadcast N_det'
stop -1 stop -1
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast psi_det_size' print *, irp_here//': Unable to broadcast psi_det_size'
@ -78,7 +74,6 @@ subroutine mpi_bcast_psi(energy, size_energy)
TOUCH psi_det psi_coef TOUCH psi_det psi_coef
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_det_generators, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_det_generators, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det_generators' print *, irp_here//': Unable to broadcast N_det_generators'
@ -89,7 +84,6 @@ subroutine mpi_bcast_psi(energy, size_energy)
TOUCH N_det_generators TOUCH N_det_generators
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_det_selectors, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_det_selectors, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det_selectors' print *, irp_here//': Unable to broadcast N_det_selectors'
@ -100,13 +94,11 @@ subroutine mpi_bcast_psi(energy, size_energy)
TOUCH N_det_selectors TOUCH N_det_selectors
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (energy, size(energy), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (energy, size(energy), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast energy' print *, irp_here//': Unable to broadcast energy'
stop -1 stop -1
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
IRP_ENDIF IRP_ENDIF
end end

2
src/Davidson/NEEDED_CHILDREN_MODULES
View File

@ -1 +1 @@
Determinants MPI Determinants

38
src/Davidson/davidson_parallel.irp.f
View File

@ -38,7 +38,7 @@ subroutine davidson_run_slave(thread,iproc)
zmq_socket_push = new_zmq_push_socket(thread) zmq_socket_push = new_zmq_push_socket(thread)
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
if(worker_id == -1) then if(worker_id == -1) then
print *, "WORKER -1" print *, 'WORKER -1'
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread) call end_zmq_push_socket(zmq_socket_push,thread)
return return
@ -160,28 +160,28 @@ subroutine davidson_push_results(zmq_socket_push, v_t, s_t, imin, imax, task_id)
sz = (imax-imin+1)*N_states_diag sz = (imax-imin+1)*N_states_diag
rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "davidson_push_results failed to push task_id" if(rc /= 4) stop 'davidson_push_results failed to push task_id'
rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "davidson_push_results failed to push imin" if(rc /= 4) stop 'davidson_push_results failed to push imin'
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "davidson_push_results failed to push imax" if(rc /= 4) stop 'davidson_push_results failed to push imax'
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE) rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE)
if(rc8 /= 8_8*sz) stop "davidson_push_results failed to push vt" if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt'
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0) rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0)
if(rc8 /= 8_8*sz) stop "davidson_push_results failed to push st" if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st'
! Activate is zmq_socket_push is a REQ ! Activate is zmq_socket_push is a REQ
IRP_IF ZMQ_PUSH IRP_IF ZMQ_PUSH
IRP_ELSE IRP_ELSE
integer :: idummy character*(2) :: ok
rc = f77_zmq_recv( zmq_socket_push, idummy, 4, 0) rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
if (rc /= 4) then if ((rc /= 2).and.(ok(1:2)/='ok')) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, idummy, 4, 0)' print *, irp_here, ': f77_zmq_recv( zmq_socket_push, ok, 2, 0)'
stop 'error' stop -1
endif endif
IRP_ENDIF IRP_ENDIF
@ -202,29 +202,29 @@ subroutine davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
integer*8 :: rc8 integer*8 :: rc8
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
if(rc /= 4) stop "davidson_pull_results failed to pull task_id" if(rc /= 4) stop 'davidson_pull_results failed to pull task_id'
rc = f77_zmq_recv( zmq_socket_pull, imin, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, imin, 4, 0)
if(rc /= 4) stop "davidson_pull_results failed to pull imin" if(rc /= 4) stop 'davidson_pull_results failed to pull imin'
rc = f77_zmq_recv( zmq_socket_pull, imax, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, imax, 4, 0)
if(rc /= 4) stop "davidson_pull_results failed to pull imax" if(rc /= 4) stop 'davidson_pull_results failed to pull imax'
sz = (imax-imin+1)*N_states_diag sz = (imax-imin+1)*N_states_diag
rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz, 0) rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz, 0)
if(rc8 /= 8*sz) stop "davidson_pull_results failed to pull v_t" if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull v_t'
rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz, 0) rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz, 0)
if(rc8 /= 8*sz) stop "davidson_pull_results failed to pull s_t" if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull s_t'
! Activate if zmq_socket_pull is a REP ! Activate if zmq_socket_pull is a REP
IRP_IF ZMQ_PUSH IRP_IF ZMQ_PUSH
IRP_ELSE IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0) rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
if (rc /= 4) then if (rc /= 2) then
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...' print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
stop 'error' stop -1
endif endif
IRP_ENDIF IRP_ENDIF