1!
2! Copyright (C) 2004 PWSCF 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! Copyright (C) 2001 PWSCF group
10! This file is distributed under the terms of the
11! GNU General Public License. See the file `License'
12! in the root directory of the present distribution,
13! or http://www.gnu.org/copyleft/gpl.txt .
14!
15! packs the potential and d coefficients into one array
16! TEMPORARY: should be merged with vpack
17!
18subroutine vdpack (ndim, ndimx, nwf, nwfx, nspin, v, d, vd, sflag)
19  use kinds, ONLY: DP
20  implicit none
21  integer :: ndim, ndimx, nwf, nwfx, nspin, is, n, i, ns, ns1
22  character(len=4) :: sflag
23  real(DP) :: v(ndimx,2), d(nwfx,nwfx,2), vd(ndimx*2+nwfx*nwfx*2)
24  select case (sflag)
25  case ("PACK")
26     i=1
27     do is=1, nspin
28        do n=1, ndim
29           vd(i)=v(n,is)
30           i=i+1
31        end do
32        do ns=1, nwf
33           do ns1=1, nwf
34              vd(i)=d(ns,ns1,is)
35              i=i+1
36           end do
37        end do
38     end do
39  case ("UNDO")
40     i=1
41     do is=1, nspin
42        do n=1, ndim
43           v(n,is)=vd(i)
44           i=i+1
45        end do
46        do ns=1, nwf
47           do ns1=1, nwf
48              d(ns,ns1,is)=vd(i)
49              i=i+1
50           end do
51        end do
52     end do
53  case default
54     call errore ('vdpack', ' wrong flag ', 1)
55  end select
56  return
57end subroutine vdpack
58