1subroutine make_v_state(numb_v,v)
2  USE gvect,                 ONLY : gstart
3  USE lsda_mod,              ONLY : nspin
4  use wavefunctions,  ONLY : evc
5  use io_files,  ONLY : prefix, iunwfc
6  USE wvfct,    ONLY : nbnd, npwx,npw
7  implicit none
8
9  type(v_state) :: v
10  integer :: numb_v
11
12  integer :: is,ivmax
13
14  v%nspin=nspin
15  v%numb_v(:)=numb_v(:)
16  v%npw=npw
17  v%gstart=gstart
18
19  allocate( evc( npwx, nbnd ) )
20
21  if (nspin==1) then
22     ivmax= v%numb_v(1)
23  else
24     ivmax=max(v%numb_v(1),v%numb_v(2))
25  endif
26
27  allocate( v%wfn(v%npw,ivmax,v%nspin)
28  allocate( v%esp(ivmax,v%nspin)
29
30  do is=1,nspin
31     call davcio(evc,2*nwordwfc,iunwfc,is,-1)
32     do iv=1,v%numb_v(is)
33        v%wfn(1:v%npw,1:v%numb_v(is),is)=evc(1:v%npw,1:v%numb_v(is))
34     enddo
35        v%esp(1:v%numb_v(is),is)=et(1:v%numb_v(is),is)
36  enddo
37
38  deallocate(evc)
39
40
41
42
43  return
44end subroutine
45
46