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