1!
2! Copyright (C) 2007 Quantum 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 ascheqps_drv(veff, ncom, thresh, flag_all, nerr)
11  !--------------------------------------------------------------------------
12  !
13  !     This routine is a driver that calculates for the test
14  !     configuration the solutions of the Kohn and Sham equation
15  !     with a fixed pseudo-potential. The potentials are assumed
16  !     to be screened. The effective potential veff is given in input.
17  !     The output wavefunctions are written in phits and are normalized.
18  !     If flag is .true. compute all wavefunctions, otherwise only
19  !     the wavefunctions with positive occupation.
20  !
21  use kinds, only: dp
22  use ld1_parameters, only: nwfsx
23  use radial_grids, only: ndmx
24  use ld1inc, only: grid, pseudotype, rel, &
25                    lls, jjs, qq, ikk, ddd, betas, nbeta, vnl, &
26                    nwfts, iswts, octs, llts, jjts, nnts, enlts, phits
27  implicit none
28
29  integer ::    &
30          nerr, &     ! control the errors of the routine ascheqps
31          ncom        ! number of components of the pseudopotential
32
33  real(DP) :: &
34       veff(ndmx,ncom)    ! work space for writing the potential
35
36  logical :: flag_all    ! if true calculates all the wavefunctions
37
38  integer ::  &
39       ns,    &  ! counter on pseudo functions
40       is,    &  ! counter on spin
41       nbf,   &  ! auxiliary nbeta
42       n,     &  ! index on r point
43       nstop, &  ! errors in each wavefunction
44       ind
45
46  real(DP) :: &
47       vaux(ndmx,2)     ! work space for writing the potential
48
49  real(DP) :: thresh         ! threshold for selfconsistency
50  !
51  !    compute the pseudowavefunctions in the test configuration
52  !
53  if (pseudotype.eq.1) then
54     nbf=0
55  else
56     nbf=nbeta
57  endif
58
59  nerr=0
60  do ns=1,nwfts
61     if ( octs(ns) > 0.0_dp .or. ( octs(ns) > -1.0_dp .and. flag_all ) ) then
62        is=iswts(ns)
63        if (ncom==1.and.is==2) call errore('ascheqps_drv','incompatible spin',1)
64        if (pseudotype == 1) then
65           if ( rel < 2 .or. llts(ns) == 0 .or. &
66                abs(jjts(ns)-llts(ns)+0.5_dp) < 0.001_dp) then
67              ind=1
68           else if ( rel == 2 .and. llts(ns) > 0 .and. &
69                abs(jjts(ns)-llts(ns)-0.5_dp) < 0.001_dp) then
70              ind=2
71           else
72              call errore('ascheqps_drv','unexpected case',1)
73           endif
74           do n=1,grid%mesh
75              vaux(n,is)=veff(n,is)+vnl(n,llts(ns),ind)
76           enddo
77        else
78           do n=1,grid%mesh
79              vaux(n,is)=veff(n,is)
80           enddo
81        endif
82        call ascheqps(nnts(ns),llts(ns),jjts(ns),enlts(ns),grid%mesh,ndmx,&
83             grid,vaux(1,is),thresh,phits(1,ns),betas,ddd(1,1,is),qq,nbf, &
84             nwfsx,lls,jjs,ikk,nstop)
85        !           write(6,*) ns, nnts(ns),llts(ns), jjts(ns), enlts(ns)
86        !
87        !   normalize the wavefunctions
88        !
89        call normalize(phits(1,ns),llts(ns),jjts(ns), ns)
90        !
91        !   not sure whether the "best" error code should be like this:
92        ! IF ( octs(ns) > 0.0_dp ) nerr = nerr + nstop
93        !   i.e. only for occupied states, or like this:
94        nerr = nerr + nstop
95     endif
96  enddo
97
98  return
99end subroutine ascheqps_drv
100