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