diff --git a/ocaml/GaussianPrimitive.ml b/ocaml/GaussianPrimitive.ml index cdaabd87..9bcf7370 100644 --- a/ocaml/GaussianPrimitive.ml +++ b/ocaml/GaussianPrimitive.ml @@ -8,7 +8,7 @@ type t = let to_string p = let { sym = s ; expo = e } = p in - Printf.sprintf "(%s, %f)" + Printf.sprintf "(%s, %22e)" (Symmetry.to_string s) (AO_expo.to_float e) diff --git a/ocaml/Pseudo.ml b/ocaml/Pseudo.ml index 8a59213c..81df8927 100644 --- a/ocaml/Pseudo.ml +++ b/ocaml/Pseudo.ml @@ -23,7 +23,7 @@ end = struct { expo = dz ; r_power = n } let to_string p = - Printf.sprintf "(%d, %f)" + Printf.sprintf "(%d, %22e)" (R_power.to_int p.r_power) (AO_expo.to_float p.expo) end @@ -52,7 +52,7 @@ end = struct { expo = dz ; r_power = n ; proj = p } let to_string p = - Printf.sprintf "(%d, %f, %d)" + Printf.sprintf "(%d, %22e, %d)" (R_power.to_int p.r_power) (AO_expo.to_float p.expo) (Positive_int.to_int p.proj) diff --git a/plugins/CAS_SD_ZMQ/selection.irp.f b/plugins/CAS_SD_ZMQ/selection.irp.f index f5cdfa86..19121c89 100644 --- a/plugins/CAS_SD_ZMQ/selection.irp.f +++ b/plugins/CAS_SD_ZMQ/selection.irp.f @@ -1251,7 +1251,10 @@ subroutine ZMQ_selection(N_in, pt2) stop 'Unable to add task to task server' endif endif - call zmq_set_running(zmq_to_qp_run_socket) + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 1269e45d..906b14d2 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -118,7 +118,11 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error) endif endif - call zmq_set_running(zmq_to_qp_run_socket) + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & !$OMP PRIVATE(i) @@ -294,7 +298,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ if (firstTBDcomb > Ncomb) then if (zmq_abort(zmq_to_qp_run_socket) == -1) then - stop 'Error in sending abort signal' + call sleep(1) + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Error in sending abort signal (1)' + endif endif exit pullLoop endif @@ -322,7 +329,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ error(pt2_stoch_istate) = eqt print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' if (zmq_abort(zmq_to_qp_run_socket) == -1) then - stop 'Error in sending abort signal' + call sleep(1) + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Error in sending abort signal (2)' + endif endif else if (Nabove(tooth) > Nabove_old) then diff --git a/plugins/Full_CI_ZMQ/zmq_selection.irp.f b/plugins/Full_CI_ZMQ/zmq_selection.irp.f index 2099c7d6..fec28ba7 100644 --- a/plugins/Full_CI_ZMQ/zmq_selection.irp.f +++ b/plugins/Full_CI_ZMQ/zmq_selection.irp.f @@ -70,7 +70,11 @@ subroutine ZMQ_selection(N_in, pt2) ASSERT (associated(b%det)) ASSERT (associated(b%val)) - call zmq_set_running(zmq_to_qp_run_socket) + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() if (i==0) then diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 7dfa33d5..b897ff0f 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -208,7 +208,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) deallocate(delta) - if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) + if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then continue endif call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) diff --git a/src/Davidson/davidson_parallel.irp.f b/src/Davidson/davidson_parallel.irp.f index fed80063..cae13fbc 100644 --- a/src/Davidson/davidson_parallel.irp.f +++ b/src/Davidson/davidson_parallel.irp.f @@ -369,8 +369,12 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze) v_0 = 0.d0 s_0 = 0.d0 + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + call omp_set_nested(.True.) - call zmq_set_running(zmq_to_qp_run_socket) !$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() if (ithread == 0 ) then diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index 3ede50df..d7db5feb 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -380,7 +380,10 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] enddo deallocate(task) - call zmq_set_running(zmq_to_qp_run_socket) + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif PROVIDE nproc !$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1) diff --git a/src/Integrals_Bielec/mo_bi_integrals.irp.f b/src/Integrals_Bielec/mo_bi_integrals.irp.f index 5f2faa2d..2b05965f 100644 --- a/src/Integrals_Bielec/mo_bi_integrals.irp.f +++ b/src/Integrals_Bielec/mo_bi_integrals.irp.f @@ -122,7 +122,7 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ] call four_index_transform_block(ao_integrals_map,mo_integrals_map, & mo_coef, size(mo_coef,1), & 1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, & - 1, 1, 1, 1, mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num) + 1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num) ! ! call four_index_transform(ao_integrals_map,mo_integrals_map, & ! mo_coef, size(mo_coef,1), & diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index 2a1eaf67..af669871 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -105,6 +105,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num,ao_num)] pseudo_n_k_transp (1,k), & pseudo_dz_k_transp(1,k), & A_center,power_A,alpha,B_center,power_B,beta,C_center) + +!if ((k==nucl_num).and.(num_A == nucl_num).and.(num_B == nucl_num)) then +!print *, pseudo_klocmax,pseudo_v_k_transp (1,k),pseudo_n_k_transp (1,k),pseudo_dz_k_transp(1,k) +!print *, A_center(1:3), power_A +!print *, B_center(1:3), power_B +!print *, C_center(1:3) +!print *, c +!endif enddo ao_pseudo_integral_local(i,j) = ao_pseudo_integral_local(i,j) +& ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i)*c diff --git a/src/MO_Basis/mos.irp.f b/src/MO_Basis/mos.irp.f index 5eb10b20..3c920d67 100644 --- a/src/MO_Basis/mos.irp.f +++ b/src/MO_Basis/mos.irp.f @@ -35,6 +35,24 @@ BEGIN_PROVIDER [ integer, mo_tot_num ] END_PROVIDER +BEGIN_PROVIDER [ integer, mo_num ] + implicit none + BEGIN_DOC + ! mo_tot_num without the highest deleted MOs + END_DOC + mo_num = mo_tot_num + integer :: i + mo_num = mo_tot_num + do i=mo_tot_num,1,-1 + if (mo_class(i) == 'Deleted') then + mo_num -= 1 + else + exit + endif + enddo +END_PROVIDER + + BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_tot_num) ] implicit none diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index bf3abd8b..5309fa4e 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -148,12 +148,12 @@ function new_zmq_to_qp_run_socket() stop 'Unable to create zmq req socket' endif - rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 10000, 4) + rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 30000, 4) if (rc /= 0) then stop 'Unable to set send timeout in new_zmq_to_qp_run_socket' endif - rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 10000, 4) + rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 30000, 4) if (rc /= 0) then stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket' endif @@ -347,12 +347,12 @@ IRP_ENDIF ! stop 'Unable to set ZMQ_SNDBUF on push socket' ! endif - rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,0,4) + rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,1,4) if (rc /= 0) then stop 'Unable to set ZMQ_IMMEDIATE on push socket' endif - rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 10000, 4) + rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 30000, 4) if (rc /= 0) then stop 'Unable to set send timout in new_zmq_push_socket' endif @@ -565,7 +565,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in) end -subroutine zmq_set_running(zmq_to_qp_run_socket) +integer function zmq_set_running(zmq_to_qp_run_socket) use f77_zmq implicit none BEGIN_DOC @@ -576,22 +576,21 @@ subroutine zmq_set_running(zmq_to_qp_run_socket) character*(512) :: message integer :: rc, sze + zmq_set_running = 0 message = 'set_running' sze = len(trim(message)) rc = f77_zmq_send(zmq_to_qp_run_socket,message,sze,0) if (rc /= sze) then - print *, irp_here, ':f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)' - stop 'error' + zmq_set_running = -1 + return endif rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0) message = trim(message(1:rc)) if (message(1:2) /= 'ok') then - print *, trim(message(1:rc)) - print *, 'Unable to set qp_run to Running' - stop 1 + zmq_set_running = -1 + return endif - - + end @@ -616,11 +615,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in) stop 'Wrong end of job' endif - do i=6,1,-1 + do i=10,1,-1 rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0) rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0) if (trim(message(1:13)) == 'error waiting') then - print *, trim(message(1:rc)) call sleep(1) cycle else if (message(1:2) == 'ok') then