1! 2! Copyright (C) 2010 Quantm-Espresso group 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8! 9!--------------------------------------------------------------- 10subroutine run_lda_half 11 ! 12 ! This routine is a driver to correct pseudopotentials with LDA-1/2 13 ! Courtesy of Leonardo Matheus Marion jorge, University of Sao Paolo (Brazil) 14 ! L. G. Ferreira, M. Marques and L. K. Teles, Phys. Rev. B 78 125116 (2008) 15 !--------------------------------------------------------------- 16 ! 17 use kinds, only : dp 18 use io_global, only : ionode, ionode_id, stdout 19 use mp, only : mp_bcast 20 use radial_grids 21 use ld1_parameters, only : nwfx 22 use ld1inc, only : file_tests, prefix, nconf, rel, etot0, & 23 nbeta, grid, psi, pseudotype, els, zed, bmat, & 24 rcut, rcutus, rcutts, rcutusts, etot, etots0, etots, & 25 nwf, lls, ikk, betas, ll, file_potscf, oc, el, & 26 nwfts, nnts, llts, jjts, iswts, octs, elts, nstoaets, & 27 nwftsc, nntsc, lltsc, jjtsc, iswtsc, octsc, eltsc,nstoaec, & 28 file_wavefunctions, file_logder, file_pseudopw, & 29 file_wavefunctionsps, file_logderps, vpot, vpsloc, rcutv 30 implicit none 31 32 integer & 33 n, & ! counter on wavefunctions 34 n1,& ! counter on mesh points 35 ir,& ! counter on mesh points 36 im,& ! position of the maximum 37 nc,& ! counter on configurations 38 nb ! counter on betas 39 integer :: & 40 nn_old(nwfx), ll_old(nwfx), nwf_old, isw_old(nwfx), lsd_old 41 real(DP) :: & 42 jj_old(nwfx), oc_old(nwfx), enl_old(nwfx), psi_old(ndmx,2,nwfx), beta2, f 43 logical :: & 44 core_state_old(nwfx) 45 integer :: ios, ncut 46 character(len=1) :: nch 47 real(DP) :: dum, wrcutv 48 real(DP) :: dvpot(ndmx,2) 49! file_tests = trim(prefix)//'.test' 50! if (ionode) & 51! open(unit=13, file=file_tests, iostat=ios, err=1111, status='unknown') 52!1111 call mp_bcast(ios, ionode_id) 53! call errore('ld1_setup','opening file_tests',abs(ios)) 54 55 do nc=1,nconf 56 write (nch, '(i1)') nc 57 nwfts=nwftsc(nc) 58 call set_conf(nc) 59 call all_electron(.true.,nc) 60 ! 61 if (nc.eq.1) then 62 dvpot = vpot 63 elseif (nc .eq. 2) then 64 dvpot = dvpot - vpot 65 endif 66 enddo 67 ncut = 8 68 do ir=1, grid%mesh 69 if (grid%r(ir).le.rcutv) then 70 wrcutv = (1.0_dp - (grid%r(ir)/rcutv)**ncut)**3 71 dvpot(ir,1) = dvpot(ir,1)*wrcutv 72 vpsloc(ir) = vpsloc(ir) - dvpot(ir,1) 73 endif 74 enddo 75! 76! re-call set conf to write in the pseudo file the Valence 77! config without LDA-1/2 78! 79 call set_conf(1) 80 return 81end subroutine run_lda_half 82