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

Changed pseudopotential library logic. Now regenerates the psp after the library is defined. Allows one to switch between psps during the middle of a nwchem workflow. Useful, for generating starting guesses for calculations using paw potentials...EJB

Browse source
This commit is contained in:
Eric Bylaska 2023-06-23 12:30:54 -07:00
parent cc462b5ad8
commit fc851ed857
6 changed files with 193 additions and 44 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

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

@ -4215,7 +4215,7 @@ c end if
* *****************************
* * *
* * control_pspparameters *
* * *
* * *
* *****************************
subroutine control_pspparameters(atom,lmax,locp,rlocal)
implicit none
@ -4258,6 +4258,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 *

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