diff --git a/src/nwpw/band/kbpp/cpsp_formatter_auto.F b/src/nwpw/band/kbpp/cpsp_formatter_auto.F index 6c3477333e..10d9e7baab 100644 --- a/src/nwpw/band/kbpp/cpsp_formatter_auto.F +++ b/src/nwpw/band/kbpp/cpsp_formatter_auto.F @@ -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 diff --git a/src/nwpw/band/lib/cpsp/cpsp.F b/src/nwpw/band/lib/cpsp/cpsp.F index 7e71f0cdf7..cc47b0a91d 100644 --- a/src/nwpw/band/lib/cpsp/cpsp.F +++ b/src/nwpw/band/lib/cpsp/cpsp.F @@ -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 diff --git a/src/nwpw/libraryps/nwpw_set_library.F b/src/nwpw/libraryps/nwpw_set_library.F index d8f0640c9a..8406f02c09 100644 --- a/src/nwpw/libraryps/nwpw_set_library.F +++ b/src/nwpw/libraryps/nwpw_set_library.F @@ -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 diff --git a/src/nwpw/nwpwlib/control/control.F b/src/nwpw/nwpwlib/control/control.F index b458137116..ca16830bfe 100644 --- a/src/nwpw/nwpwlib/control/control.F +++ b/src/nwpw/nwpwlib/control/control.F @@ -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 * diff --git a/src/nwpw/pspw/kbpp/psp_formatter.F b/src/nwpw/pspw/kbpp/psp_formatter.F index 943ab0e3e1..bb7a1d8523 100644 --- a/src/nwpw/pspw/kbpp/psp_formatter.F +++ b/src/nwpw/pspw/kbpp/psp_formatter.F @@ -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 diff --git a/src/nwpw/pspw/lib/psp/psp.F b/src/nwpw/pspw/lib/psp/psp.F index a3f340531b..498f5458a4 100644 --- a/src/nwpw/pspw/lib/psp/psp.F +++ b/src/nwpw/pspw/lib/psp/psp.F @@ -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 *****