comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-28 14:15:30 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

k-point parallelization updates...EJB

Browse source
This commit is contained in:
Eric Bylaska 2009-12-08 01:32:07 +00:00
parent 7a4f967332
commit cc02aaff8c
8 changed files with 22 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/nwpw/band/lib/electron/c_electron.F
View file

@ -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

33
src/nwpw/band/lib/psi/cpsi_KS.F
View file

@ -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.

1
src/nwpw/band/minimizer/c_sdminimize.F
View file

@ -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()

9
src/nwpw/band/structure/band_structure.F
View file

@ -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

4
src/nwpw/nwpwlib/D3dB/D3dB-new.F
View file

@ -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

5
src/nwpw/nwpwlib/K1dB/K1dB.F
View file

@ -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 *****

13
src/nwpw/pspw/lib/coulomb/coulomb2.F
View file

@ -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

5
src/nwpw/pspw/lib/psp/semicore.F
View file

@ -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