!
! Copyright (C) 2005 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!-----------------------------------------------------------------------
!  Translates from usual dft acronyms to appropriate indexes for CPMD
!-----------------------------------------------------------------------
subroutine which_cpmd_dft &
     (dft,mfxcx, mfxcc, mgcx, mgcc)
  !-----------------------------------------------------------------------
  !
  use funct, only : get_iexch, get_icorr, get_igcx, get_igcc, set_dft_from_name
  implicit none
  character(len=*), intent(IN) :: dft
  integer , intent(OUT) :: mfxcx, mfxcc, mgcx, mgcc

  call set_dft_from_name(dft)
  mfxcx = get_iexch()
  mfxcc = get_icorr()
  mgcx = get_igcx()
  mgcc = get_igcc()

! in CPMD PW91 and LYP are swapped.
  if (mgcc.eq.3) then
     mgcc=2
  else if (mgcc.eq.2) then
     mgcc=3
  end if

  return
end subroutine which_cpmd_dft
!
!-----------------------------------------------------------------------
subroutine write_cpmd &
     (iunps,zed,xmin,dx,mesh,ndm,r,r2, &
     dft,lmax,lloc,zval,nlc,nnl,cc,alpc,alc,alps,nlcc, &
     rhoc,vnl,phis,vpsloc,els,lls,ocs,rcuts,etots,nwfs)
  !-----------------------------------------------------------------------
  !
  use kinds, only : DP
  implicit none
  integer :: iunps, ndm, mesh, nwfps, lmin,lmax,lloc,nlc,nnl,nwfs,lls(nwfs)
  real(DP) :: zed, zval, xmin,dx, cc(2),alpc(2),alc(6,0:3), &
       alps(3,0:3), phis(ndm,nwfs), ocs(nwfs), rcuts(nwfs), &
       r(ndm), r2(ndm), vnl(ndm,0:3), rhoc(ndm), erf, etots
  character(len=*) :: dft
  !
  real(DP), parameter :: fourpi=4.0_dp*3.141592653589793_dp, e2=2.0_dp
  real(DP) :: alfa_core=0.0_dp, vpsloc(ndm)
  logical nlcc, bhstype, numeric
  character(len=70) title_pseudo
  character(len=2), external :: atom_name
  character(len=2) :: els(nwfs)
  integer :: ios, i, l, k, n, ir, nb, mfxcx, mfxcc, mgcx, mgcc, lls_table(nwfs)
  !
  !
  nlc=0
  nnl=0
  bhstype=.false.

  call which_cpmd_dft(dft, mfxcx, mfxcc, mgcx, mgcc)

  do l=0,lmax
     do nb = 1, nwfs
        if (lls(nb).eq.l) then
           lls_table(l+1)=nb
        endif
     enddo
  enddo

  if (nlcc) then
     write(title_pseudo,"(2a3,'cc',f4.2,4(1x,a2,f4.2,' Rc=',f4.2))")  &
          'MT', atom_name(nint(zed)), alfa_core,                      &
          (els(lls_table(n)),ocs(lls_table(n)),rcuts(lls_table(n)),n=1,lmax+1)
  else
     write(title_pseudo,"(2a3,4(1x,a2,f4.2,' Rc=',f4.2))")  &
          'MT', atom_name(nint(zed)),                       &
          (els(lls_table(n)),ocs(lls_table(n)),rcuts(lls_table(n)),n=1,lmax+1)
  endif

  write(iunps, "('&ATOM')", err=300, iostat=ios)
  write(iunps, "(' Z =',i2)", err=300, iostat=ios) nint(zed)
  write(iunps, "(' ZV=',i2)", err=300, iostat=ios) nint(zval)
               
  write(iunps, "(' XC=',4i1,8x,'.666667')", err=300, iostat=ios) mfxcx,mfxcc,mgcx,mgcc
  write(iunps, "(' TYPE=NORMCONSERVING NUMERIC')", err=300, iostat=ios)
  write(iunps, "('&END')", err=300, iostat=ios)
  write(iunps, "('&INFO')", err=300, iostat=ios)
  write(iunps, '(1x,a)', err=300, iostat=ios) title_pseudo
  write(iunps, "('&END')", err=300, iostat=ios)

  write(iunps, "('&POTENTIAL')", err=300, iostat=ios)
  write(iunps, '(i6,f15.8)', err=300, iostat=ios) mesh,exp(dx)
  do i=1,mesh
     write(iunps, '(5e18.8)', err=300, iostat=ios) r(i),((vnl(i,l)+vpsloc(i))/e2,l=0,lmax)
  end do
  write(iunps,"('&END')", err=300, iostat=ios)

  write(iunps,"('&WAVEFUNCTION')", err=300, iostat=ios)
  write(iunps,'(i6,f15.8)', err=300, iostat=ios) mesh,exp(dx)
  do i=1,mesh
     write(iunps,'(5e18.8)', err=300, iostat=ios) r(i),(phis(i,lls_table(n)),n=1,lmax+1)
  end do
  write(iunps,"('&END')", err=300, iostat=ios)
  if(nlcc) then
     write(iunps,"('&NLCC')", err=300, iostat=ios)
     write(iunps,"('     NUMERIC')", err=300, iostat=ios)
     write(iunps,'(i4)', err=300, iostat=ios) mesh
     write(iunps,'(2e16.8)', err=300, iostat=ios) (r(i), rhoc(i), i=1,mesh)         
!         write(iunps,'(2e16.8)') (r(i), rho_core(i)/fourpi, i=1,mesh)       
  
     write(iunps,"('&END')", err=300, iostat=ios)
  end if
  return

300 call errore('write_cpmd','writing pseudo file',abs(ios))

end subroutine write_cpmd