diff --git a/src/nwpw/band/lib/electron/c_electron.F b/src/nwpw/band/lib/electron/c_electron.F index 0cf8623659..cb2a0a0d4d 100644 --- a/src/nwpw/band/lib/electron/c_electron.F +++ b/src/nwpw/band/lib/electron/c_electron.F @@ -160,7 +160,7 @@ c complex*16 psi_k(*) counter = counter+1 call c_electron_gen_psi_r(psi_k_tag) - call c_electron_gen_densities(dn,dng,dnall) +c call c_electron_gen_densities(dn,dng,dnall) call c_electron_gen_Hpsi_k_vall(psi_k_tag) return end @@ -996,7 +996,8 @@ c end do kj = 1 shiftB = cpsi_data_get_chnk(psi_r_tag,nbj) - done = .false. +c done = .false. + done = (nbrillq.eq.0) do while (.not.done) if (nbi.le.nbrillq) then diff --git a/src/nwpw/band/lib/psi/cpsi_KS.F b/src/nwpw/band/lib/psi/cpsi_KS.F index 27617d9daa..002bad66cd 100644 --- a/src/nwpw/band/lib/psi/cpsi_KS.F +++ b/src/nwpw/band/lib/psi/cpsi_KS.F @@ -284,7 +284,7 @@ c > dbl_mb(psi1_shift)) * **** local variables **** logical stalled integer nb,i,j,neall,maxit_orb,maxit_orbs - integer psi1_shift,eig_shift,taskid + integer psi1_shift,eig_shift real*8 error_out,psi_error_out,e0,sum * **** external functions **** @@ -293,7 +293,6 @@ c > dbl_mb(psi1_shift)) external control_ks_maxit_orb,control_ks_maxit_orbs external cpsi_data_get_ptr - call Parallel_taskid(taskid) if (spin_orbit) then call cpsi_KS_minimize2com(psi_number,precondition, @@ -339,16 +338,11 @@ c > dbl_mb(psi1_shift)) !**** minimize orbital **** - write(*,*) "gerb,taskid,nb,i=",taskid,nb,i - call flush(6) - j = 0 2 call cpsi_KS_minimize_orb(psi_number,precondition,maxit_orb, > maxerror,maxpsi_error,0.001d0, > nb,i,error_out,psi_error_out,e0) j = j+1 - write(*,*) "gerc,taskid,nb,i,j=",taskid,nb,i,j,error_out - call flush(6) if (((error_out.gt.maxerror).or. > (psi_error_out.gt.maxpsi_error)) @@ -360,16 +354,8 @@ c > dbl_mb(psi1_shift)) end do end do - write(*,*) "gere,taskid=",taskid - call flush(6) - call ga_sync() - call cpsi_sort_minimize() - write(*,*) "gerf,taskid=",taskid - call flush(6) - call ga_sync() - return end @@ -583,9 +569,6 @@ c psi_ptr=psi1(1)+(nb-1)*(ne(1)+ne(2))*npack1 #include "cpsi_common.fh" * **** local variables **** - integer MASTER,taskid - parameter (MASTER=0) - logical value,done,oneloop integer it real*8 e0,eold,error0,de0,lmbda_r0,lmbda_r1 @@ -612,7 +595,6 @@ c psi_ptr=psi1(1)+(nb-1)*(ne(1)+ne(2))*npack1 psi_ptr=cpsi_data_get_ptr(psi2_tag,nb,i) end if - call Parallel_taskid(taskid) value = MA_push_get(mt_dcpl,npack1,'t0',t0(2),t0(1)) value = value.and. @@ -887,9 +869,6 @@ c > tau_t) #include "cpsi_common.fh" * **** local variables **** - integer MASTER,taskid - parameter (MASTER=0) - logical value,done,oneloop integer it real*8 eold,error0,de0,lmbda_r0,lmbda_r1 @@ -900,6 +879,7 @@ c > tau_t) * **** external functions **** integer cpsi_data_get_ptr external cpsi_data_get_ptr + if (spin_orbit) then call cpsi_KS_minimize_orb_2com(psi_number, @@ -983,7 +963,6 @@ c end if 3 call Cram_c_Copy(nb,dcpl_mb(t(1)),dcpl_mb(t0(1))) - * *** normalize search direction, t **** call cpsi_project_out_orb(psi_number,nb,i,dcpl_mb(t(1))) call Cram_cc_dot(nb,dcpl_mb(t(1)), @@ -1579,9 +1558,6 @@ c write(*,*)"THIS IS I IN KS_MINIM",i," ",e0 #include "cpsi_common.fh" * **** local variables **** - integer MASTER,taskid - parameter (MASTER=0) - logical value,done,oneloop integer it,shifts real*8 e0,eold,error0,de0,lmbda_r0,lmbda_r1 @@ -1602,7 +1578,6 @@ c write(*,*)"THIS IS I IN KS_MINIM",i," ",e0 psi_ptr=cpsi_data_get_ptr(psi2_tag,nb,i) end if - call Parallel_taskid(taskid) value = MA_push_get(mt_dcpl,2*npack1,'t0',t0(2),t0(1)) value = value.and. @@ -1920,9 +1895,6 @@ c > tau_t(npack1+1)) #include "cpsi_common.fh" * **** local variables **** - integer MASTER,taskid - parameter (MASTER=0) - logical value,done,oneloop integer it,shifts,ne1 real*8 eold,error0,de0,lmbda_r0,lmbda_r1 @@ -1943,7 +1915,6 @@ c > tau_t(npack1+1)) psi_ptr=cpsi_data_get_ptr(psi2_tag,nb,i) end if - call Parallel_taskid(taskid) value = MA_push_get(mt_dcpl,2*npack1,'t0',t0(2),t0(1)) value = value.and. diff --git a/src/nwpw/band/minimizer/c_sdminimize.F b/src/nwpw/band/minimizer/c_sdminimize.F index b06b40cab7..a8cdbeb3fa 100644 --- a/src/nwpw/band/minimizer/c_sdminimize.F +++ b/src/nwpw/band/minimizer/c_sdminimize.F @@ -74,7 +74,6 @@ c $Id: c_sdminimize.F,v 1.6 2007-02-23 01:18:11 bylaska Exp $ external control_it_in external control_time_step,control_fake_mass - dt = control_time_step() dte = dt/dsqrt(control_fake_mass()) it_in = control_it_in() diff --git a/src/nwpw/band/structure/band_structure.F b/src/nwpw/band/structure/band_structure.F index f2735e35df..06283454cf 100644 --- a/src/nwpw/band/structure/band_structure.F +++ b/src/nwpw/band/structure/band_structure.F @@ -655,6 +655,7 @@ c if (flag.eq.2) call cpsi_dospsi_read(k) > call errquit('band_structure:out of stack memory',0, MA_ERR) end if + * **** electron and geodesic data structures **** call c_electron_init() call c_geodesic_init() @@ -672,16 +673,8 @@ c if (flag.eq.2) call cpsi_dospsi_read(k) call cpsi_1rotate2() call cpsi_2to1() - write(*,*) "herj,taskid=",taskid - call flush(6) - call ga_sync() - call cpsi_KS_minimize(1,.false.,control_tole(),control_tolc()) - write(*,*) "herk,taskid=",taskid - call flush(6) - call ga_sync() - if (control_print(print_high)) call cpsi_check_indx(k) if (band_dplot_iteration_check(k)) then diff --git a/src/nwpw/nwpwlib/D3dB/D3dB-new.F b/src/nwpw/nwpwlib/D3dB/D3dB-new.F index 427d5e6e46..b7c1043249 100644 --- a/src/nwpw/nwpwlib/D3dB/D3dB-new.F +++ b/src/nwpw/nwpwlib/D3dB/D3dB-new.F @@ -1297,7 +1297,6 @@ c end integer tmp2(2),tmp3(2) logical value - call nwpw_timing_start(1) * ***** allocate temporary space **** @@ -1583,8 +1582,9 @@ c end do * **** deallocate temporary space **** value = MA_pop_stack(tmp3(2)) - value = MA_pop_stack(tmp2(2)) + value = value.and.MA_pop_stack(tmp2(2)) !value = MA_pop_stack(tmp1(2)) + if (.not. value) call errquit('popping stack memory',0,MA_ERR) call nwpw_timing_end(1) return diff --git a/src/nwpw/nwpwlib/K1dB/K1dB.F b/src/nwpw/nwpwlib/K1dB/K1dB.F index bb010c8197..7ef08b8c1b 100644 --- a/src/nwpw/nwpwlib/K1dB/K1dB.F +++ b/src/nwpw/nwpwlib/K1dB/K1dB.F @@ -242,12 +242,13 @@ !**** Make sure ngrid is consistent with mapping *** if (np_k.gt.nz_in) then if (taskid.eq.MASTER) then - write(6,*) 'Error: for 1d decomposition the', + write(6,*) 'Possible Error?: for 1d decomposition the', > ' number of columns (np_k processors) must ', > ' be in the range ( 1 ...nz=', > nz_in,')' + call util_flush(6) end if - call errquit('K1dB_init: mapping error',0,0) +c call errquit('K1dB_init: mapping error',0,0) end if * ***** initialize K1dB common block ***** diff --git a/src/nwpw/pspw/lib/coulomb/coulomb2.F b/src/nwpw/pspw/lib/coulomb/coulomb2.F index 86b60252ee..3a05541fd9 100644 --- a/src/nwpw/pspw/lib/coulomb/coulomb2.F +++ b/src/nwpw/pspw/lib/coulomb/coulomb2.F @@ -12,9 +12,9 @@ subroutine coulomb2_init() implicit none -#include "errquit.fh" #include "mafdecls.fh" +#include "errquit.fh" * *** cutoff constant *** real*8 EPSILON @@ -63,7 +63,7 @@ c **** external functions **** call Parallel2d_taskid_i(taskid) - call D3dB_nq(2,nq) +c call D3dB_nq(2,nq) call D3dB_nz(2,nz) call D3dB_ny(2,ny) call D3dB_nx(2,nx) @@ -216,7 +216,8 @@ c temp = yerf/temp > + dbl_mb(glr(1)+2*(k-1)) end do - value = MA_pop_stack(glr(2)) + if (.not.MA_pop_stack(glr(2))) + > call errquit('coulomb2_init:error popping stack memory',0,MA_ERR) return end @@ -224,15 +225,17 @@ c temp = yerf/temp subroutine coulomb2_end() implicit none + #include "mafdecls.fh" +#include "errquit.fh" * **** common block used for coulomb.f **** integer gk(2) common / vc_block2 / gk - logical value + if (.not.MA_free_heap(gk(2))) + > call errquit('coulomb2_end:error freeing heap memory',0,MA_ERR) - value = MA_free_heap(gk(2)) return end diff --git a/src/nwpw/pspw/lib/psp/semicore.F b/src/nwpw/pspw/lib/psp/semicore.F index 96410b779e..b3c57ad7dd 100644 --- a/src/nwpw/pspw/lib/psp/semicore.F +++ b/src/nwpw/pspw/lib/psp/semicore.F @@ -237,7 +237,7 @@ c call Pack_c_pack(0,dcpl_mb(exi(1))) * **** put sqrt(core-density) at atom position **** - call Pack_tc_MUL(0,dbl_mb(ncore(1)+(ia-1)*npack0*5), + call Pack_tc_Mul(0,dbl_mb(ncore(1)+(ia-1)*npack0*5), > dcpl_mb(exi(1)), > dcpl_mb(tmp(1))) c call Pack_c_SMul(0,scal2,dcpl_mb(tmp(1)),dcpl_mb(tmp(1))) @@ -332,7 +332,7 @@ c logical semicore(0:nkatmx) end do c call Pack_c_SMul(0,scal2,dcpl_mb(tmp(1)),dcpl_mb(tmp(1))) call Pack_c_SMul1(0,scal2,dcpl_mb(tmp(1))) - + * **** Put put tmp into real space **** call Pack_c_unpack(0,dcpl_mb(tmp(1))) call D3dB_cr_fft3b(1,dcpl_mb(tmp(1))) @@ -344,6 +344,7 @@ c call D3dB_rr_Sqr(1,dcpl_mb(tmp(1)),dcpl_mb(tmp(1))) * **** integrate it **** call D3dB_r_dsum(1,dcpl_mb(tmp(1)),sum) dbl_mb(ncore_sum(1)+ia-1) = sum*dV + end if end do