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

Merge pull request #808 from ebylaska/master

Browse source 
Check in from ebylaska/nwchem-bylaska fork
This commit is contained in:
Edoardo Aprà 2023-06-23 22:34:44 -07:00 • committed by GitHub
commit 83629ee6d8
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
9 changed files with 232 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

14
src/nwpw/band/kbpp/cpsp_formatter_auto.F
View file

@ -1,8 +1,8 @@
* ***************************************
* * *
* * cpsp_formatter_auto *
* * *
* * *
* * cpsp_formatter_auto *
* * *
* ***************************************
subroutine cpsp_formatter_auto(atom)
implicit none
@ -29,12 +29,12 @@
integer control_ngrid, brillioun_nbrillioun
real*8 control_unita, brillioun_all_k
logical kbpp_band,nwpw_filefind,hghpp_band,rkbpp_band
logical kbpp_e_band
logical kbpp_e_band,control_psp_reset
external control_version
external control_ngrid, brillioun_nbrillioun
external control_unita, brillioun_all_k
external kbpp_band,nwpw_filefind,hghpp_band
external rkbpp_band,kbpp_e_band
external rkbpp_band,kbpp_e_band,control_psp_reset
value = .true.
* **** get lmax,locp,and rlocal from psp library ****
@ -50,9 +50,11 @@
formatted_filename = element(1:l)//'.cpp'
* **** generate one-dimensional pseudopotential file ****
if (.not.nwpw_filefind(psp_filename)) then
if ((.not.nwpw_filefind(psp_filename)).or.
> (control_psp_reset(atom))) then
call psp_generator_auto(1,atom,lmax,locp,rlocal)
call control_psp_reset_delete(atom)
* **** get lmax,locp,and rlocal from rtdb ****
else

18
src/nwpw/band/lib/cpsp/cpsp.F
View file

@ -2166,9 +2166,9 @@ cccccccccccccccccccc
* ***********************************
* * *
* * cpsp_readall *
* * *
* * *
* * cpsp_readall *
* * *
* ***********************************
subroutine cpsp_readall()
@ -2197,11 +2197,13 @@ cccccccccccccccccccc
* **** external functions ****
logical nwpw_filefind,control_spin_orbit,control_print
logical control_psp_reset
integer control_ngrid
real*8 control_unita
character*12 control_boundry
character*4 ion_atom
external nwpw_filefind,control_spin_orbit,control_print
external control_psp_reset
external control_ngrid
external control_unita
external control_boundry
@ -2299,7 +2301,8 @@ cccccccccccccccccccc
correct_box = .true.
boundry = control_boundry()
l =index(boundry,' ') - 1
if ( (ngp(1).ne.control_ngrid(1)) .or.
if (control_psp_reset(ion_atom(ia)).or.
> (ngp(1).ne.control_ngrid(1)) .or.
> (ngp(2).ne.control_ngrid(2)) .or.
> (ngp(3).ne.control_ngrid(3)) .or.
> (unita(1,1).ne.control_unita(1,1)) .or.
@ -2327,7 +2330,12 @@ cccccccccccccccccccc
end if
end if
end if
if (correct_box) found = .true.
if (correct_box) then
found = .true.
* **** set pawexist here ****
end if
if (ierr.eq.1) then
found = .false.
if (mprint) then

46
src/nwpw/libraryps/nwpw_set_library.F
View file

@ -12,7 +12,7 @@ c
#include "btdb.fh"
#include "errquit.fh"
integer ind ! Index of matched directive
integer ind,inda ! Index of matched directive
integer num_dirs ! No. of known directives
parameter (num_dirs = 5)
character*30 dirs(num_dirs)
@ -59,37 +59,47 @@ c
c
c pspw_library
c
20 ind = index(atom,' ') - 1
rtdb_name = atom(1:ind)//':pspw_library'
20 inda = index(atom,' ') - 1
rtdb_name = atom(1:inda)//':pspw_library'
ind = index(library_name,' ') - 1
if (.not. btdb_cput(rtdb,rtdb_name,
> 1,library_name(1:ind)))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
rtdb_name = atom(1:ind)//':pspw_library_type'
rtdb_name = atom(1:inda)//':pspw_library_type'
if (.not. btdb_put(rtdb,rtdb_name,mt_int,1,0))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
rtdb_name = atom(1:inda)//':psp_reset'
if (.not. btdb_put(rtdb,rtdb_name,mt_log,1,.true.))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
goto 10
c
c paw_library
c
30 ind = index(atom,' ') - 1
rtdb_name = atom(1:ind)//':paw_library'
30 inda = index(atom,' ') - 1
rtdb_name = atom(1:inda)//':paw_library'
ind = index(library_name,' ') - 1
if (.not. btdb_cput(rtdb,rtdb_name,
> 1,library_name(1:ind)))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
rtdb_name = atom(1:inda)//':psp_reset'
if (.not. btdb_put(rtdb,rtdb_name,mt_log,1,.true.))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
goto 10
c
c CPI filename
c
40 ind = index(atom,' ') - 1
rtdb_name = atom(1:ind)//':pspw_library'
40 inda = index(atom,' ') - 1
rtdb_name = atom(1:inda)//':pspw_library'
ind = index(library_name,' ') - 1
if (.not. btdb_cput(rtdb,rtdb_name,
> 1,library_name(1:ind)))
@ -97,18 +107,22 @@ c
> 0,INPUT_ERR)
idum = 2
ind = index(atom,' ') - 1
rtdb_name = atom(1:ind)//':pspw_library_type'
rtdb_name = atom(1:inda)//':pspw_library_type'
if (.not. btdb_put(rtdb,rtdb_name,mt_int,1,idum))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
rtdb_name = atom(1:inda)//':psp_reset'
if (.not. btdb_put(rtdb,rtdb_name,mt_log,1,.true.))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
goto 10
c
c TETER filename
c
50 ind = index(atom,' ') - 1
rtdb_name = atom(1:ind)//':pspw_library'
50 inda = index(atom,' ') - 1
rtdb_name = atom(1:inda)//':pspw_library'
ind = index(library_name,' ') - 1
if (.not. btdb_cput(rtdb,rtdb_name,
> 1,library_name(1:ind)))
@ -116,10 +130,14 @@ c
> 0,INPUT_ERR)
idum = 3
ind = index(atom,' ') - 1
rtdb_name = atom(1:ind)//':pspw_library_type'
rtdb_name = atom(1:inda)//':pspw_library_type'
if (.not. btdb_put(rtdb,rtdb_name,mt_int,1,idum))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
rtdb_name = atom(1:inda)//':psp_reset'
if (.not. btdb_put(rtdb,rtdb_name,mt_log,1,.true.))
> call errquit('nwpw_set_library: rtdb write error',
> 0,INPUT_ERR)
goto 10

137
src/nwpw/nwpwlib/control/control.F
View file

@ -1280,6 +1280,12 @@ c return
> 'nwpw:gram-schmidt',mt_log,1,gram_schmidt))
> gram_schmidt = .false.
* **** set gram_schmidt2 ***
gram_schmidt2 = .false.
if (.not.btdb_get(rtdb,
> 'nwpw:gram-schmidt2',mt_log,1,gram_schmidt2))
> gram_schmidt2 = .false.
* **** set translation ***
translation = control_allow_translation()
dof_translation = translation
@ -4215,7 +4221,7 @@ c end if
* *****************************
* * *
* * control_pspparameters *
* * *
* * *
* *****************************
subroutine control_pspparameters(atom,lmax,locp,rlocal)
implicit none
@ -4258,6 +4264,120 @@ c end if
return
end
* **********************************
* * *
* * control_psp_reset *
* * *
* **********************************
logical function control_psp_reset(atom)
implicit none
character*4 atom
#include "bafdecls.fh"
#include "btdb.fh"
#include "errquit.fh"
* **** control_rtdb common block ****
integer rtdb
common / control_rtdb1 / rtdb
logical reset
integer k,l
character*5 element
character*50 rtdb_name
element = ' '
element = atom
l = index(element,' ') - 1
rtdb_name = ' '
rtdb_name = element(1:l)//':psp_reset'
reset = .false.
k = index(rtdb_name,' ') - 1
if (.not.btdb_get(rtdb,rtdb_name(1:k),mt_log,1,reset))
> reset = .false.
control_psp_reset = reset
return
end
* **********************************
* * *
* * control_psp_reset_new *
* * *
* **********************************
subroutine control_psp_reset_new(atom)
implicit none
character*4 atom
#include "bafdecls.fh"
#include "btdb.fh"
#include "errquit.fh"
* **** control_rtdb common block ****
integer rtdb
common / control_rtdb1 / rtdb
logical reset
integer k,l
character*5 element
character*50 rtdb_name
element = ' '
element = atom
l = index(element,' ') - 1
rtdb_name = ' '
rtdb_name = element(1:l)//':psp_reset'
reset = .true.
k = index(rtdb_name,' ') - 1
if (.not.btdb_put(rtdb,rtdb_name(1:k),mt_log,1,reset))
> call errquit('control_psp_reset_new: failed',0,RTDB_ERR)
return
end
* **********************************
* * *
* * control_psp_reset_delete *
* * *
* **********************************
subroutine control_psp_reset_delete(atom)
implicit none
character*4 atom
#include "bafdecls.fh"
#include "btdb.fh"
#include "errquit.fh"
* **** control_rtdb common block ****
integer rtdb
common / control_rtdb1 / rtdb
logical reset,tmp
integer k,l
character*5 element
character*50 rtdb_name
element = ' '
element = atom
l = index(element,' ') - 1
rtdb_name = ' '
rtdb_name = element(1:l)//':psp_reset'
reset = .true.
k = index(rtdb_name,' ') - 1
if (btdb_get(rtdb,rtdb_name(1:k),mt_log,1,tmp)) then
if (tmp) then
if (.not.rtdb_delete(rtdb,rtdb_name(1:k)))
> call errquit('control_psp_reset_delete: failed',0,RTDB_ERR)
end if
end if
return
end
* **********************************
* * *
* * control_mullikenparameters *
@ -4418,6 +4538,21 @@ c end if
return
end
* ***************************
* * *
* * control_gram_schmidt2 *
* * *
* ***************************
logical function control_gram_schmidt2()
implicit none
#include "control.fh"
control_gram_schmidt2=gram_schmidt2
return
end
* ***************************
* * *

6
src/nwpw/nwpwlib/control/control.fh
View file

@ -26,7 +26,8 @@
integer code,gga,fmm_lmax,fmm_lr
integer ispin,multiplicity
integer est_finish_time,est_step_time
logical move,frac_coord,SA,fei,fei_quench,gram_schmidt
logical move,frac_coord,SA,fei,fei_quench
logical gram_schmidt,gram_schmidt2
logical rotation,translation,dof_rotation,dof_translation
logical balance,spin_orbit,dipole_motion
logical two_comp_ppot,frozen,pio,fast_erf,fmm,smooth_cutoff
@ -52,7 +53,8 @@
> ks_algorithm,minimizer,
> symm_number,
> move,frac_coord,SA,fei,fei_quench,
> gram_schmidt,rotation,translation,
> gram_schmidt,gram_schmidt2,
> rotation,translation,
> dof_rotation,dof_translation,
> balance,spin_orbit,dipole_motion,
> two_comp_ppot,frozen,pio,fast_erf,

10
src/nwpw/pspw/cpsd/inner_loop.F
View file

@ -94,8 +94,8 @@ c real*8 fion(3,natmx)
integer nion1
* ***** external functions ****
logical control_gram_schmidt
external control_gram_schmidt
logical control_gram_schmidt,control_gram_schmidt2
external control_gram_schmidt,control_gram_schmidt2
logical control_move,psp_semicore,psp_pawexist,control_Fei
logical pspw_SIC,pspw_SIC_relaxed
logical pspw_HFX,pspw_HFX_relaxed
@ -664,7 +664,11 @@ c call Pack_cc_Sum(1,psi2(1,n),psi1(1,n),psi2(1,n))
call psp_overlap_S(ispin,ne,psi1,psi_r)
if (move) call phafac2()
if (control_gram_schmidt()) then
call Dneall_f_Sortho(ms,psi2,psi_r,npack1)
if (control_gram_schmidt2()) then
call Dneall_f_GramSchmidt(ms,psi2,npack1)
else
call Dneall_f_Sortho(ms,psi2,psi_r,npack1)
end if
else
call psi_lmbda_paw(ispin,ne,nemax,npack1,psi_r,psi2,
> dte,

9
src/nwpw/pspw/cpsd/psi_lmbda_paw.f
View file

@ -30,6 +30,8 @@ c $Id: psi_lmbda_paw.f 21177 2011-10-10 17:09:43Z bylaska $
integer st1,st2
integer A,B,C,U,D,Ba,Bs,fnm
integer i,j
logical control_gram_schmidt2
external control_gram_schmidt2
call nwpw_timing_start(3)
@ -100,8 +102,11 @@ c end if
write(*,*) ' +Try using a smaller time step'
write(*,*) ' +Gram-Schmidt being performed, spin:',ms
end if
call Dneall_f_GramSchmidt(ms,psi2,npack1)
c call Dneall_f_Sortho(ms,psi2,psi1,npack1)
if (control_gram_schmidt2()) then
call Dneall_f_GramSchmidt(ms,psi2,npack1)
else
call Dneall_f_Sortho(ms,psi2,psi1,npack1)
end if
ierr = 1
else

6
src/nwpw/pspw/kbpp/psp_formatter.F
View file

@ -156,10 +156,12 @@ c
integer control_ngrid
real*8 control_unita
logical kbppv3d,kbppv3e,hghppv1,pawppv1,nwpw_filefind
logical control_psp_reset
external control_version
external control_ngrid
external control_unita
external kbppv3d,kbppv3e,hghppv1,pawppv1,nwpw_filefind
external control_psp_reset
* **** get lmax,locp,and rlocal from psp library ****
@ -175,8 +177,10 @@ c
formatted_filename = element(1:l)//'.vpp'
* **** generate one-dimensional pseudopotential file ****
if (.not.nwpw_filefind(psp_filename)) then
if ((.not.nwpw_filefind(psp_filename)).or.
> (control_psp_reset(atom))) then
call psp_generator_auto(1,atom,lmax,locp,rlocal)
call control_psp_reset_delete(atom)
* **** get lmax,locp,and rlocal from rtdb ****
else

37
src/nwpw/pspw/lib/psp/psp.F
View file

@ -3,11 +3,10 @@
*
* ***********************************
* * *
* * psp_init *
* * *
* * *
* * psp_init *
* * *
* ***********************************
subroutine psp_init()
implicit none
@ -4665,11 +4664,10 @@ c close(11)
end
* ***********************************
* * *
* * psp_readall *
* * *
* * *
* * psp_readall *
* * *
* ***********************************
subroutine psp_readall()
implicit none
@ -4707,12 +4705,12 @@ c logocal semicore(0:nkatmx)
parameter(MASTER=0)
* **** external functions ****
logical nwpw_filefind,control_print
logical nwpw_filefind,control_print,control_psp_reset
integer control_ngrid,ion_nion
real*8 control_unita
character*12 control_boundry
character*4 ion_atom
external nwpw_filefind,control_print
external nwpw_filefind,control_print,control_psp_reset
external control_ngrid,ion_nion
external control_unita
external control_boundry
@ -4742,7 +4740,7 @@ c logocal semicore(0:nkatmx)
element = ion_atom(ia)
l = index(element,' ') - 1
fname = element(1:l)//'.vpp'
found = .false.
do while (.not.found)
@ -4817,7 +4815,7 @@ c logocal semicore(0:nkatmx)
if (ierr.gt.0) go to 9000
* **** set pawexist ****
if (int_mb(psp_type(1)+ia-1).eq.4) pawexist = .true.
!if (int_mb(psp_type(1)+ia-1).eq.4) pawexist = .true.
* **************************************************************
* ***** logic for finding out if psp is correctly formatted ****
@ -4825,7 +4823,8 @@ c logocal semicore(0:nkatmx)
correct_box = .true.
boundry = control_boundry()
l =index(boundry,' ') - 1
if ( (ngp(1).ne.control_ngrid(1)) .or.
if (control_psp_reset(ion_atom(ia)) .or.
> (ngp(1).ne.control_ngrid(1)) .or.
> (ngp(2).ne.control_ngrid(2)) .or.
> (ngp(3).ne.control_ngrid(3)) .or.
> (unita(1,1).ne.control_unita(1,1)) .or.
@ -4841,9 +4840,9 @@ c logocal semicore(0:nkatmx)
> ((boundry(1:l).eq.'aperiodic').and.(version.ne.4))) then
correct_box = .false.
if ((taskid.eq.MASTER).and.
> control_print(print_medium)) then
write(luout,*)
> "pseudopotential is not correctly formatted:",fname
> control_print(print_medium)) then
write(luout,*)
> "pseudopotential is not correctly formatted:",fname
end if
@ -4873,8 +4872,12 @@ c logocal semicore(0:nkatmx)
end if
if (correct_box) found = .true.
if (correct_box) then
found = .true.
* **** set pawexist ****
if (int_mb(psp_type(1)+ia-1).eq.4) pawexist=.true.
end if
end if
* **** generate formatted pseudopotential atom.vpp *****