! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine Element__readPAO_adpack( elem, name, fname, mode, mode2 )
  use ac_parameter

  implicit none
  type(Element_type), intent(out) :: elem
  character(len=*), intent(in) :: name
  character(len=*), intent(in) :: fname
  character(len=*), intent(in) :: mode
  character(len=*), intent(in) :: mode2

  integer        :: iunit
  logical        :: ex
  character(256) :: buf, tag

  real(8)  :: Rc
  integer        :: nr
  real(8), allocatable :: vr(:)
  integer, parameter :: npaoLmax=3 
  integer, parameter :: npao2Lmax=6 
  integer        :: npaoL (0:npaoLmax)
  integer        :: ipaoL (0:npaoLmax)
  integer        :: npao2L(0:npao2Lmax)
  integer        :: ipao2L(0:npao2Lmax)
  real(8)  :: logr
  real(8)  :: R(10)
  character(32) :: dummy
  character(1024) :: msg
  integer        :: i, l, n
  integer        :: maxLpao, numpao

  elem%name = name

  inquire( file=fname, exist=ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      ++++++ Error readPAO/ can not open file: ',a)
     close(16)
     stop
  end if

  iunit=2
  open(iunit,file=fname)

  Rc = 0.d0
  nr = 0

  do 
     read(iunit,'(a)',end=100) buf
     if( buf=='' ) cycle
     read(buf,*) tag

     select case(tag)
     case('#')
     case('grid.num.output')
        read(buf,*) tag, nr
     case('maxL.pao')
        read(buf,*) tag, maxLpao
     case('num.pao')
        read(buf,*) tag, numpao

     case('radial.cutoff.pao')
        read(buf,*) tag, Rc
     end select

     if( nr /= 0 .and. Rc /= 0.d0 ) exit
  end do
100 continue

  if( nr == 0 ) then
     msg = "grid.num.output is not given"
     goto 1111
  end if
  if( Rc == 0.d0 ) then
     msg = "radial.cutoff is not given"
     goto 1111
  end if

  allocate( vr(nr) )

  do l=0, npaoLmax
     npaoL(l) = 0
  end do

  if( mode == "" ) then
     do l = 0, maxLpao
        npaoL(l) = numpao
     end do
  else if( mode(1:1) /= 's' ) then
     if( len_trim(mode) == 1 ) then
        npaoL(0) = numpao 
     else
        read(mode(2:2),*) npao2L(0)
     end if

     select case( mode(1:1) )
     case('p')
        npaoL(1:1) = npaoL(0)
     case('d')
        npaoL(1:2) = npaoL(0)
     case('f')
        npaoL(1:3) = npaoL(0)
     end select
  else
     do i=1, len_trim(mode), 2
        select case( mode(i:i) )
        case('s')
           read( mode(i+1:i+1), * ) npaoL(0)
        case('p')
           read( mode(i+1:i+1), * ) npaoL(1)
        case('d')
           read( mode(i+1:i+1), * ) npaoL(2)
        case('f')
           read( mode(i+1:i+1), * ) npaoL(3)
        end select
     end do
  end if

  do l=0, npaoLmax
     if( npaoL(l) > numpao ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) '      ++++++ Warning: too many radial PAO bases requested for band calculations. Reduced to', numpao
        close(16)
        npaoL(l) = numpao
     end if
  end do

  do l=0, npao2Lmax
     npao2L(l)=0
  end do

  if( mode2 == "" ) then
     do l = 0, npao2Lmax
        npao2L(l) = numpao
     end do
  else if( mode2(1:1) /= 's' ) then
     if( len_trim(mode2) == 1 ) then
        npao2L(0) = numpao 
     else
        read(mode2(2:2),*) npao2L(0)
     end if

     select case( mode2(1:1) )
     case('p')
        npao2L(1:1) = npao2L(0)
     case('d')
        npao2L(1:2) = npao2L(0)
     case('f')
        npao2L(1:3) = npao2L(0)
     case('g')
        npao2L(1:4) = npao2L(0)
     case('h')
        npao2L(1:5) = npao2L(0)
     case('i')
        npao2L(1:6) = npao2L(0)
     end select
  else
     do i=1, len_trim(mode2), 2
        select case( mode2(i:i) )
        case('s')
           read( mode2(i+1:i+1), * ) npao2L(0)
        case('p')
           read( mode2(i+1:i+1), * ) npao2L(1)
        case('d')
           read( mode2(i+1:i+1), * ) npao2L(2)
        case('f')
           read( mode2(i+1:i+1), * ) npao2L(3)
        case('g')
           read( mode2(i+1:i+1), * ) npao2L(4)
        case('h')
           read( mode2(i+1:i+1), * ) npao2L(5)
        case('i')
           read( mode2(i+1:i+1), * ) npao2L(6)
        end select
     end do
  end if

  do l=0, npao2Lmax
     if( npao2L(l) > numpao ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) '      ++++++ Warning: too many radial PAO bases requested for projection. Reduced to', numpao
        close(16)
        npao2L(l) = numpao
     end if
  end do

  elem%npao=0
  do l=0, npaoLmax
     ipaoL(l) = elem%npao+1
     elem%npao = elem%npao + npaoL(l)
  end do
  elem%npao2=0
  do l=0, npao2Lmax
     ipao2L(l) = elem%npao2+1
     elem%npao2 = elem%npao2 + npao2L(l)
  end do

  allocate(elem%vpao(elem%npao))

  if( Param%Option%projection ) then
     allocate(elem%vpao2(elem%npao2))
     allocate(elem%vpao2bar(elem%npao2))
  end if

  do
     read(iunit,'(a)',end=200) buf

     if(buf=='') cycle
     if(buf=='#') cycle
     read(buf,*) tag

     select case(tag)
     case('<valence.charge.density')
        elem%rhoval%l  = 0
        elem%rhoval%Rc = Rc
        allocate( elem%rhoval%vR(nr) )

        do i=1, nr
           read(iunit,'(a)') buf
           read(buf,*) logr, dummy, elem%rhoval%vR(i)
           if( dummy == dummy ) then 
           endif

           vr(i) = exp(logr)
        end do
        read(iunit,'(a)') buf

        call RadialFunc__set(elem%rhoval, vr, nr)

     case('<pseudo.atomic.orbitals.L=0', '<pseudo.atomic.orbitals.L=1', &
          '<pseudo.atomic.orbitals.L=2', '<pseudo.atomic.orbitals.L=3')
        select case(tag)
        case('<pseudo.atomic.orbitals.L=0')
           l = 0
        case('<pseudo.atomic.orbitals.L=1')
           l = 1
        case('<pseudo.atomic.orbitals.L=2')
           l = 2
        case('<pseudo.atomic.orbitals.L=3')
           l = 3
        end select

        if( npaoL(l)>0 ) then
           do n=1, npaoL(l)
              elem%vpao(ipaoL(l)+n-1)%l  = l
              elem%vpao(ipaoL(l)+n-1)%Rc = Rc
              allocate( elem%vpao(ipaoL(l)+n-1)%vR(nr) )
           end do
        end if

        if( npao2L(l)>0 .and. Param%Option%projection ) then
           do n=1, npao2L(l)
              elem%vpao2(ipao2L(l)+n-1)%l  = l
              elem%vpao2(ipao2L(l)+n-1)%Rc = Rc
              allocate( elem%vpao2(ipao2L(l)+n-1)%vR(nr) )

              elem%vpao2bar(ipao2L(l)+n-1)%l  = l
              elem%vpao2bar(ipao2L(l)+n-1)%Rc = Rc
              allocate( elem%vpao2bar(ipao2L(l)+n-1)%vR(nr) )
           end do
        end if

        if( npaoL(l)>0 .or. npao2L(l)>0 ) then
           do i=1, nr
              read(iunit,'(a)') buf
              read(buf,*) dummy, dummy, R(1:max(npaoL(l),npao2L(l)))

              do n=1, npaoL(l)
                 elem%vpao(ipaoL(l)+n-1)%vR(i) = R(n)
              end do

              if( Param%Option%projection ) then
                 do n=1, npao2L(l)
                    elem%vpao2(ipao2L(l)+n-1)%vR(i) = R(n)
                 end do
              end if
           end do

           read(iunit,'(a)') buf
        end if

        if( npaoL(l)>0 ) then
           do n=1, npaoL(l)
              call RadialFunc__set(elem%vpao(ipaoL(l)+n-1), vr, nr)
           end do
        end if

        if( npao2L(l)>0 .and. Param%Option%projection ) then
           do n=1, npao2L(l)
              call RadialFunc__set(elem%vpao2(ipao2L(l)+n-1), vr, nr)
           end do
        end if

     end select
  end do

200 continue

  if( Param%Option%projection ) then
     do l = maxLpao+1, npao2Lmax
        if( npao2L(l) == 0 ) cycle

        do n=1, npao2L(l)
           elem%vpao2(ipao2L(l)+n-1)%l  = l
           elem%vpao2(ipao2L(l)+n-1)%Rc = Rc
           allocate( elem%vpao2(ipao2L(l)+n-1)%vR(nr) )

           elem%vpao2bar(ipao2L(l)+n-1)%l  = l
           elem%vpao2bar(ipao2L(l)+n-1)%Rc = Rc
           allocate( elem%vpao2bar(ipao2L(l)+n-1)%vR(nr) )
        end do

        do n=1, npao2L(l)
           do i=1, nr
              elem%vpao2(ipao2L(l)+n-1)%vR(i) = &
                   vr(i)**(l-maxLpao) * elem%vpao2(ipao2L(maxLpao)+n-1)%vR(i)
           end do
        end do

        do n=1, npao2L(l)
           call RadialFunc__set(elem%vpao2(ipao2L(l)+n-1), vr, nr)
        end do
     end do
  end if

  if(allocated(vr)) deallocate(vr)

  if( .not. associated(elem%rhoval%vR) ) then
     msg = "valence.charge.density is not given"
     goto 1111
  end if

  do n=1, elem%npao
     if( .not. associated(elem%vpao(n)%vR) ) then
        msg = "pseudo.atomic.orbitals is not given"
        goto 1111
     endif
  end do

  close(iunit)
  return

1111 continue 
  close(iunit)

  write(*,'(a,a,a)') '# Error : PAO data ', msg, fname
  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,998) msg,fname
998 format('      ++++++ Error PAO data: ',a,a)
  close(16)
  stop

end subroutine Element__readPAO_adpack

subroutine Element__readVPS_adpack( elem, name, fname )
  use ac_parameter

  implicit none
  type(Element_type), intent(out)   :: elem
  character(len=*), intent(in) :: name
  character(len=*), intent(in) :: fname

  integer         :: iunit
  logical         :: ex
  character(1024) :: buf
  character(32)   :: tag

  real(8)  :: Q
  real(8)  :: Rc
  integer        :: nr
  real(8), allocatable :: vr(:)
  real(8)  :: logr
  real(8)  :: vnon(2,12)
  character(8)   :: str
  character(32) :: dummy
  character(1024) :: msg
  integer        :: i, n

  elem%name = name

  inquire(file=fname,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      ++++++ Error readVPS/ can not open file: ',a)
     close(16)
     stop
  end if

  iunit = 3
  open(iunit,file=fname)

  Q  = 0.d0
  Rc = 0.d0
  nr = 0

  elem%pcc = .false.
  elem%nVnon = -1

  do 
     read(iunit,'(a)',end=100) buf
     if( buf=='') cycle
     if( buf=='#') cycle
     read(buf,*) tag

     select case(tag)
     case('eq.type')
        read(buf,*) tag, str
        select case(str)
        case('dirac2')
           elem%dirac = .true.
        case('sch')
           elem%dirac = .false.
        case default
           elem%dirac = .false.
        end select
     case('AtomSpecies')
        read(buf,*) tag, elem%atomic_number
     case('valence.electron')
        read(buf,*) tag, Q
     case('grid.num.output')
        read(buf,*) tag, nr
     case('local.cutoff')
        read(buf,*) tag, Rc
     case('charge.pcc.calc')
        read(buf,*) tag, str
        if( str == 'on' .or. str == 'On' .or. str == 'ON' ) then
           elem%pcc = .true.
        else
           elem%pcc = .false.
        end if

        if( .not. Rc == 0.d0 ) exit 
     case('radial.cutoff.pao')
        if( Rc == 0.d0 ) then 
           read(buf,*) tag, Rc
        end if
        exit 
     end select

  end do
100 continue

  if( nr == 0 ) then
     msg = 'Parameter grid.num.output is not given'
     go to 1111
  end if
  if( Rc == 0.d0 ) then
     msg = 'Parameter local.cutoff is not given'
     go to 1111
  end if
  if( Q  == 0.d0 ) then
     msg = 'Parameter valence.electron is not given'
     go to 1111
  end if

  allocate( vr(nr) )

  do 
     read(iunit,'(a)',end=200) buf

     if( buf=='') cycle
     if( buf=='#') cycle
     read(buf,*) tag

     select case(tag)
     case('num.projector')
        read(buf,*) tag, elem%nVnon

     case('<project.energies','<projection.energies')
        select case(tag)
        case('<project.energies')
           if( elem%nVnon == -1 ) then
              read(iunit,'(a)',end=200) buf
              read(buf,*) elem%nVnon
           end if
           if( elem%nVnon == -1 ) then
              msg = 'project.energies is broken or num.projector is not given'
              go to 1111
           end if

        case('<projection.energies')
           if( elem%nVnon == -1 ) then
              msg = 'Parameter num.projector is not given'
              go to 1111
           end if

        end select

        if( elem%nVnon>0 ) then
           if( elem%dirac ) then
              allocate(elem%vVnon(elem%nVnon,2))
           else
              allocate(elem%vVnon(elem%nVnon,1))
           end if

           elem%vVnon(:,:)%l = 0
           elem%vVnon(:,:)%Q = 0.0
        end if

        if( elem%nVnon>0 ) then
           do n=1, elem%nVnon
              read(iunit,'(a)') buf
              if( elem%dirac ) then
                 read(buf,*) elem%vVnon(n,1)%l, elem%vVnon(n,1:2)%Q
                 elem%vVnon(n,2)%l = elem%vVnon(n,1)%l
              else
                 read(buf,*) elem%vVnon(n,1)%l, elem%vVnon(n,1)%Q
              end if
           end do
        end if
        read(iunit,'(a)') buf

     case('<Pseudo.Potentials')
        elem%Vloc%l  = 0
        elem%Vloc%Q  = -Q
        elem%Vloc%Rc = Rc
        allocate( elem%Vloc%vR(nr) )

        do n=1, elem%nVnon
           if( elem%dirac ) then
              elem%vVnon(n,1)%Rc = Rc
              allocate(elem%vVnon(n,1)%vR(nr))
              elem%vVnon(n,2)%Rc = Rc
              allocate(elem%vVnon(n,2)%vR(nr))
           else
              elem%vVnon(n,1)%Rc = Rc
              allocate(elem%vVnon(n,1)%vR(nr))
           end if
        end do

        do i=1, nr
           read(iunit,'(a)') buf

           if( elem%dirac ) then
              read(buf,*) logr, dummy, elem%Vloc%vR(i), vnon(1:2,1:elem%nVnon)
              do n=1, elem%nVnon
                 elem%vVnon(n,1)%vR(i) = vnon(1,n)
                 elem%vVnon(n,2)%vR(i) = vnon(2,n)
              end do
           else
              read(buf,*) logr, dummy, elem%Vloc%vR(i), vnon(1,1:elem%nVnon)
              do n=1, elem%nVnon
                 elem%vVnon(n,1)%vR(i) = vnon(1,n)
              end do
           end if

           vr(i) = exp(logr)
           if( i<4 ) then
              write(*,*) i, vr(i), elem%Vloc%vR(i)
           end if

           if( dummy == dummy ) then 
           endif
        end do

        read(iunit,'(a)') buf

        call RadialFunc__set( elem%Vloc, vr, nr )
        do n=1, elem%nVnon
           if( elem%dirac ) then
              call RadialFunc__set( elem%vVnon(n,1), vr, nr )
              call RadialFunc__set( elem%vVnon(n,2), vr, nr )
           else
              call RadialFunc__set( elem%vVnon(n,1), vr, nr )
           end if
        end do

     case('<density.PCC')
        if( elem%pcc ) then
           elem%rhopcc%l  = 0
           elem%rhopcc%Rc = elem%vpao(1)%Rc 
           allocate( elem%rhopcc%vR(nr) )

           do i=1, nr
              read(iunit,'(a)') buf
              read(buf,*) dummy, dummy, elem%rhopcc%vR(i) 
           end do
           read(iunit,'(a)') buf

           call RadialFunc__set( elem%rhopcc, vr, nr )
        end if
     end select
  end do
200 continue

  if(allocated(vr)) deallocate(vr)

  if( .not. associated(elem%Vloc%vR) ) then
     msg = "Pseudo.Potentials is not given"
     goto 1111
  end if

  do n=1, elem%nVnon
     if( .not. associated(elem%vVnon(n,1)%vR) ) then
        msg = "Pseudo.Potentials is not given"
        goto 1111
     end if
  end do

  if( elem%pcc .and. (.not. associated(elem%rhopcc%vR)) ) then
     msg = "density.PCC not given"
     goto 1111
  end if

  close(iunit)
  return

1111 continue 
  close(iunit)

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,998) msg,fname 
998 format(' +++++++ Error VPS data: ',a,a)
  close(16)
  stop

end subroutine Element__readVPS_adpack

subroutine Element__VBHSR( Vr, elem, bhs_c1, bhs_c2, bhs_a1, bhs_a2, r )
  use ac_parameter

  implicit none
  real(8), intent(out) :: Vr
  type(Element_type), intent(in)   :: elem
  real(8), intent(in)  :: bhs_c1, bhs_c2, bhs_a1, bhs_a2
  real(8), intent(in)  :: r
  real(8) :: derf 

  if( r < 1.d-14 ) then
     Vr = elem%Vloc%Q * M_2_SQRTPI * ( bhs_c1*sqrt(bhs_a1) +  bhs_c2*sqrt(bhs_a2) )
  else
     Vr = elem%Vloc%Q/r *( bhs_c1*derf(sqrt(bhs_a1)*r) + bhs_c2*derf(sqrt(bhs_a2)*r) )
  end if

  return
end subroutine Element__VBHSR

subroutine Element__VBHSK( Vk, elem, bhs_c1, bhs_c2, bhs_a1, bhs_a2, k )
  use ac_parameter

  implicit none
  real(8), intent(out)   :: Vk
  type(Element_type), intent(in)   :: elem
  real(8), intent(in)  :: bhs_c1, bhs_c2, bhs_a1, bhs_a2
  real(8), intent(in)  :: k

  if( k < 1.d-14 ) then
     Vk = M_2_SQRTPI*M_SQRT1_2 &
          * elem%Vloc%Q *( -bhs_c1/(4.0d0*bhs_a1) -  bhs_c2/(4.0d0*bhs_a2) )
  else
     Vk = M_2_SQRTPI*M_SQRT1_2 &
          * elem%Vloc%Q/k**2 *( bhs_c1*(exp(-k**2/(4.0d0*bhs_a1))-1.0d0) +  bhs_c2*(exp(-k**2/(4.0d0*bhs_a2))-1.0d0) )
  end if

  return
end subroutine Element__VBHSK

subroutine Element__setup( elem )
  use ac_parameter

  implicit none
  type(Element_type), intent(out) :: elem
  integer n, i
  real(8) :: r, k, Vr, Vk

  do n=1, elem%npao
     call RadialFunc__transpose( elem%vpao(n) )
  end do
  if( Param%Option%projection ) then
     do n=1, elem%npao2
        call RadialFunc__transpose( elem%vpao2(n) )
     end do
  end if

  call Element__setupVval( elem )

  if( Param%Option%projection ) then
     call Element__setupVloc( elem )
  end if

  call RadialFunc__transpose( elem%Vval )
  call RadialFunc__transposetail( elem%Vval )
  call RadialFunc__transpose( elem%rhoval )

  if( .false. ) then
     do i=1, elem%Vloc%fR%N
        r = elem%Vloc%fR%vx(i)

        call Element__VBHSR( Vr, elem, 1.0d0, 0.0d0, 1.0d0, 1.0d0, r )

        elem%Vloc%vR(i) = elem%Vloc%vR(i) - Vr
     end do

     call RadialFunc__reset(elem%Vloc)

     call RadialFunc__transpose( elem%Vloc )

     do i=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(i)
        call Element__VBHSK( Vk, elem, 1.0d0, 0.0d0, 1.0d0, 1.0d0, k )
        elem%Vloc%vK(i) = elem%Vloc%vK(i) + Vk
     end do

     do i=1, elem%Vloc%fR%N
        r = elem%Vloc%fR%vx(i)

        call Element__VBHSR( Vr, elem, 1.0d0, 0.0d0, 1.0d0, 1.0d0, r )

        elem%Vloc%vR(i) = elem%Vloc%vR(i) + Vr
     end do

     call RadialFunc__reset(elem%Vloc)
  else
     call RadialFunc__transpose( elem%Vloc )
     call RadialFunc__transposetail( elem%Vloc )
  end if

  do n=1, elem%nVnon
     if( elem%dirac ) then
        call RadialFunc__transpose( elem%vVnon(n,1) )
        call RadialFunc__transpose( elem%vVnon(n,2) )
     else
        call RadialFunc__transpose( elem%vVnon(n,1) )
     end if
  end do

  if( elem%pcc ) then
     call RadialFunc__transpose( elem%rhopcc )
  end if

  return
end subroutine Element__setup

subroutine Element__setupVval( elem )
  use ac_parameter

  implicit none
  type(Element_type), intent(out) :: elem

  integer, parameter :: Nr = 96
  real(8) :: vx_t(Nr), vw_t(Nr)
  integer :: N
  integer :: i, j
  real(8) :: Inside, Outside
  real(8) :: xmin, xmax
  real(8) :: Sx, Dx
  real(8) :: r, x, w, f

  real(8), allocatable :: vr(:)
  real(8) :: loc, val

  call GaussLegendre__getPoints( Nr, -1.d0, 1.d0, vx_t, vw_t )

  N = elem%rhoval%fR%N

  elem%Vval%l  =  0
  elem%Vval%Q  = -elem%Vloc%Q
  elem%Vval%Rc =  elem%rhoval%Rc
  allocate( elem%Vval%vR(N) )

  allocate( vr(N) )
  do i=1, N
     vr(i) = elem%rhoval%fR%vx(i)
  end do

  do i=1, N
     if( vr(i) > elem%rhoval%Rc ) then
        elem%Vval%vR(i) = elem%Vval%Q/vr(i)
        cycle
     end if

     Inside = 0.d0
     xmin = log(elem%rhoval%fR%vx(1))
     xmax = log(vr(i))
     Sx = xmax + xmin
     Dx = xmax - xmin
     do j=1, Nr
        x = 0.50*(Dx*vx_t(j) + Sx)
        r = exp(x)
        w = vw_t(j)
        call Spline__evaluate( elem%rhoval%fR,r,f )
        Inside = Inside + w*r*r*r* f
     end do
     Inside = 0.5D0*Dx*4.D0*M_PI/vr(i) * Inside

     Outside = 0.d0
     xmin = log(vr(i))
     xmax = log(elem%rhoval%fR%vx(elem%rhoval%fR%N))
     Sx = xmax + xmin
     Dx = xmax - xmin
     do j=1, Nr
        x = 0.50*(Dx*vx_t(j) + Sx)
        r = exp(x)
        w = vw_t(j)
        call Spline__evaluate( elem%rhoval%fR, r, f )
        Outside = Outside + w*r*r* f
     end do
     Outside = 0.5D0*Dx*4.D0*M_PI * Outside

     elem%Vval%vR(i) = Inside + Outside
  end do

  call RadialFunc__set( elem%Vval, vr, N )

  if(allocated(vr)) deallocate( vr )

  return
end subroutine Element__setupVval

subroutine Element__setupVloc( elem )
  use ac_parameter

  implicit none
  type(Element_type), intent(out) :: elem

  integer :: nr
  integer :: n, m, i
  real(8), allocatable :: vr(:)
  type(RadialFunc_type) :: Vtemp
  real(8) :: S
  real(8) :: f1, f2

  if( .not. Param%Option%projection ) return

  nr = elem%vpao(1)%fR%N

  allocate( vr(nr) )
  do i=1, nr
     vr(i) = elem%vpao(1)%fR%vx(i)
  end do

  allocate( Vtemp%vR(nr) )
  do i=1, nr
     call Spline__evaluate( elem%Vloc%fR, vr(i), f1 )
     call Spline__evaluate( elem%Vval%fR, vr(i), f2 )
     Vtemp%vR(i) = f1 + f2
  end do

  elem%nVloc = elem%npao2
  allocate(elem%vVloc(elem%nVloc))

  do n=1, elem%nVloc
     call RadialFunc__bracketS( S, elem%vpao2(n), elem%vpao2(n) )
     S = 1.0/sqrt(S)

     do i=1, nr
        elem%vpao2(n)%vR(i) = elem%vpao2(n)%vR(i) * S
     end do
     call RadialFunc__reset(elem%vpao2(n))
     call RadialFunc__transpose( elem%vpao2(n) )

     do i=1, nr
        elem%vpao2bar(n)%vR(i) = elem%vpao2(n)%vR(i)
     end do

     do m=1, n-1
        if( elem%vpao2(m)%l /= elem%vpao2(n)%l ) cycle

        call RadialFunc__bracketS( S, elem%vpao2(n), elem%vVloc(m) )
        S = elem%vVloc(m)%Q * S

        do i=1, nr
           elem%vpao2bar(n)%vR(i) = elem%vpao2bar(n)%vR(i) &
                - elem%vpao2bar(m)%vR(i) * S
        end do
     end do

     elem%vpao2bar(n)%l  = elem%vpao2(n)%l
     elem%vpao2bar(n)%Rc = elem%vpao2(n)%Rc

     call RadialFunc__set( elem%vpao2bar(n), vr, nr )
     call RadialFunc__transpose( elem%vpao2bar(n) )

     allocate( elem%vVloc(n)%vR(nr) )
     do i=1, nr
        elem%vVloc(n)%vR(i) = Vtemp%vR(i) * elem%vpao2bar(n)%vR(i)
     end do

     elem%vVloc(n)%l  = elem%vpao2(n)%l
     elem%vVloc(n)%Rc = elem%vpao(1)%Rc

     call RadialFunc__set( elem%vVloc(n), vr, nr )
     call RadialFunc__transpose( elem%vVloc(n) )

     call RadialFunc__bracketS( S, elem%vpao2bar(n), elem%vVloc(n) )
     elem%vVloc(n)%Q  = 1.0d0/S

  end do

  deallocate( Vtemp%vR )
  deallocate( vr )

  return
end subroutine Element__setupVloc


subroutine Element__deallocate( elem )
  use ac_parameter

  implicit none
  type(Element_type), intent(out) :: elem
  integer :: n

  call RadialFunc__deallocate( elem%rhoval )
  call RadialFunc__deallocate( elem%Vval )

  do n=1, elem%npao
     call RadialFunc__deallocate( elem%vpao(n) )
  end do
  if( associated(elem%vpao) ) deallocate(elem%vpao)

  call RadialFunc__deallocate( elem%Vloc )

  do n=1, elem%nVnon
     if( elem%dirac ) then
        call RadialFunc__deallocate( elem%vVnon(n,1) )
        call RadialFunc__deallocate( elem%vVnon(n,2) )
     else
        call RadialFunc__deallocate( elem%vVnon(n,1) )
     end if
  end do
  if( associated(elem%vVnon) ) deallocate(elem%vVnon)

  if( Param%Option%projection ) then
     do n=1, elem%nVloc
        call RadialFunc__deallocate( elem%vVloc(n) )
     end do
     if( associated(elem%vVloc) ) deallocate(elem%vVloc)

     do n=1, elem%npao2
        call RadialFunc__deallocate( elem%vpao2(n) )
        call RadialFunc__deallocate( elem%vpao2bar(n) )
     end do
     if( associated(elem%vpao2) ) deallocate(elem%vpao2)
     if( associated(elem%vpao2bar) ) deallocate(elem%vpao2bar)
  end if

  if( elem%pcc ) then
     call RadialFunc__deallocate( elem%rhopcc )
  end if

  return
end subroutine Element__deallocate

subroutine Element__readPAO_ciao( elem, name, fname, mode, mode2 )
  use ac_parameter

  implicit none
  type(Element_type), intent(out)   :: elem
  character(len=*), intent(in) :: name
  character(len=*), intent(in) :: fname
  character(len=*), intent(in) :: mode
  character(len=*), intent(in) :: mode2

  integer        :: iunit
  logical        :: ex
  character(256) :: buf, tag

  real(8)  :: Rc
  integer        :: nr
  real(8), allocatable :: vr(:)
  integer, parameter :: npaoLmax=3
  integer, parameter :: npao2Lmax=6
  integer        :: npaoL(0:npaoLmax)
  integer        :: ipaoL(0:npaoLmax)
  integer        :: npao2L(0:npao2Lmax)
  integer        :: ipao2L(0:npao2Lmax)
  real(8)  :: R(10)
  character(1024):: msg
  integer        :: i, l, n, m
  real(8)  :: dummy_r

  integer        :: npaoL_t(0:npao2Lmax), num_l_pao, n_temp

  inquire( file=fname, exist=ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      ++++++ Error readPAO/ can not open file: ',a)
     close(16)
     stop
  end if

  iunit=2
  open(iunit,file=fname)

  elem%name = name

  do i = 0,npao2Lmax
     npaoL_t(i)=0
  end do

  Rc = -10.d0
  nr = 0

  read(iunit,*) num_l_pao
  do i = 1,num_l_pao
     read(iunit,*) l, n
     npaoL_t(l)=n
  end do
  read(iunit,*) elem%namexc_pao 
  read(iunit,*) nr,Rc
  read(iunit,*)

  if( nr == 0 ) then
     msg = "grid num output is not given"
     goto 1111
  end if
  if( Rc < 0.d0 ) then
     msg = "radial cutoff is not given"
     goto 1111
  end if

  do l=0, npaoLmax
     npaoL(l)=0
  end do

  if( mode == "" ) then
     do l = 0, num_l_pao-1
        npaoL(l) = npaoL_t(l)
     end do
  else if( mode(1:1) /= 's' ) then
     if( len_trim(mode) == 1 ) then
        npaoL(0) = npaoL_t(0)
     else
        read(mode(2:2),*) npao2L(0)
     end if

     select case( mode(1:1) )
     case('p')
        npaoL(1:1) = npaoL(0)
     case('d')
        npaoL(1:2) = npaoL(0)
     case('f')
        npaoL(1:3) = npaoL(0)
     end select
  else
     do i=1, len_trim(mode), 2
        select case( mode(i:i) )
        case('s')
           read( mode(i+1:i+1), * ) npaoL(0)
        case('p')
           read( mode(i+1:i+1), * ) npaoL(1)
        case('d')
           read( mode(i+1:i+1), * ) npaoL(2)
        case('f')
           read( mode(i+1:i+1), * ) npaoL(3)
        end select
     end do
  end if

  do l=0, npaoLmax
     if( npaoL(l) > npaoL_t(l) ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) &
             '      ++++++ Warning: too many radial PAO bases requested for band calculations. Reduced to' &
             , npaoL_t(l)
        close(16)
        npaoL(l) = npaoL_t(l)
     end if
  end do

  do l=0, npao2Lmax
     npao2L(l)=0
  end do

  if( mode2 == "" .or. (.not. Param%Option%projection) ) then
     do l = 0, num_l_pao-1
        npao2L(l) = 0
     end do
  else if( mode2(1:1) /= 's' ) then
     if( len_trim(mode2) == 1 ) then
        npao2L(0) = npaoL_t(0)
     else
        read(mode2(2:2),*) npao2L(0)
     end if

     select case( mode2(1:1) )
     case('p')
        npao2L(1:1) = npao2L(0)
     case('d')
        npao2L(1:2) = npao2L(0)
     case('f')
        npao2L(1:3) = npao2L(0)
     case('g')
        npao2L(1:4) = npao2L(0)
     case('h')
        npao2L(1:5) = npao2L(0)
     case('i')
        npao2L(1:6) = npao2L(0)
     end select
  else
     do i=1, len_trim(mode2), 2
        select case( mode2(i:i) )
        case('s')
           read( mode2(i+1:i+1), * ) npao2L(0)
        case('p')
           read( mode2(i+1:i+1), * ) npao2L(1)
        case('d')
           read( mode2(i+1:i+1), * ) npao2L(2)
        case('f')
           read( mode2(i+1:i+1), * ) npao2L(3)
        case('g')
           read( mode2(i+1:i+1), * ) npao2L(4)
        case('h')
           read( mode2(i+1:i+1), * ) npao2L(5)
        case('i')
           read( mode2(i+1:i+1), * ) npao2L(6)
        end select
     end do
  end if

  do l=0, num_l_pao-1 
     if( npao2L(l) > npaoL_t(l) ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) &
             '      ++++++ Warning: too many radial PAO bases requested for projection. Reduced to' &
             , npaoL_t(l),l
        close(16)
        npao2L(l) = npaoL_t(l)
     end if
  end do

  elem%npao=0
  do l=0, npaoLmax
     ipaoL(l) = elem%npao+1
     elem%npao = elem%npao + npaoL(l)
  end do

  allocate(elem%vpao(elem%npao))

  elem%npao2=0
  do l=0, npao2Lmax
     ipao2L(l) = elem%npao2+1
     elem%npao2 = elem%npao2 + npao2L(l)
  end do

  if( Param%Option%projection ) then
     allocate(elem%vpao2(elem%npao2))
     allocate(elem%vpao2bar(elem%npao2))
  end if

  allocate( vr(nr) )

  elem%rhoval%l  = 0
  elem%rhoval%Rc = Rc
  allocate( elem%rhoval%vR(nr) )

  read(iunit,*)
  read(iunit,*)
  do i=1, nr
     read(iunit,*) vr(i), dummy_r, elem%rhoval%vR(i)
  end do

  call RadialFunc__set(elem%rhoval, vr, nr)

  do m = 0, num_l_pao - 1
     read(iunit,*)
     read(iunit,*) buf,tag,l

     do n=1, npaoL(l)
        elem%vpao(ipaoL(l)+n-1)%l  = l
        elem%vpao(ipaoL(l)+n-1)%Rc = Rc
        allocate( elem%vpao(ipaoL(l)+n-1)%vR(nr) )
     end do

     if( Param%Option%projection ) then
        do n=1, npao2L(l)
           elem%vpao2(ipao2L(l)+n-1)%l  = l
           elem%vpao2(ipao2L(l)+n-1)%Rc = Rc
           allocate( elem%vpao2(ipao2L(l)+n-1)%vR(nr) )

           elem%vpao2bar(ipao2L(l)+n-1)%l  = l
           elem%vpao2bar(ipao2L(l)+n-1)%Rc = Rc
           allocate( elem%vpao2bar(ipao2L(l)+n-1)%vR(nr) )
        end do
     end if

     n_temp=max(npaoL(l),npao2L(l))
     do i=1, nr
        read(iunit,*) dummy_r, R(1:n_temp)
        do n=1, npaoL(l)
           elem%vpao(ipaoL(l)+n-1)%vR(i) = R(n)/dummy_r
        end do
        if( Param%Option%projection ) then
           do n=1, npao2L(l)
              elem%vpao2(ipao2L(l)+n-1)%vR(i) = R(n)/dummy_r
           end do
        end if
     end do

     do n=1, npaoL(l)
        call RadialFunc__set(elem%vpao(ipaoL(l)+n-1), vr, nr)
     end do
     if( Param%Option%projection ) then
        do n=1, npao2L(l)
           call RadialFunc__set(elem%vpao2(ipao2L(l)+n-1), vr, nr)
        end do
     end if
  end do

  if( Param%Option%projection ) then
     do l = num_l_pao, npao2Lmax
        if( npao2L(l) == 0 ) cycle

        do n=1, npao2L(l)
           elem%vpao2(ipao2L(l)+n-1)%l  = l
           elem%vpao2(ipao2L(l)+n-1)%Rc = Rc
           allocate( elem%vpao2(ipao2L(l)+n-1)%vR(nr) )

           elem%vpao2bar(ipao2L(l)+n-1)%l  = l
           elem%vpao2bar(ipao2L(l)+n-1)%Rc = Rc
           allocate( elem%vpao2bar(ipao2L(l)+n-1)%vR(nr) )
        end do

        do n=1, npao2L(l)
           do i=1, nr
              elem%vpao2(ipao2L(l)+n-1)%vR(i) = &
                   vr(i)**(l-(num_l_pao-1)) * elem%vpao2(ipao2L(num_l_pao-1)+n-1)%vR(i)
           end do
        end do

        do n=1, npao2L(l)
           call RadialFunc__set(elem%vpao2(ipao2L(l)+n-1), vr, nr)
        end do
     end do
  end if

  if(allocated(vr)) deallocate(vr)

  buf=tag
  tag=buf

  close(iunit)
  return

1111 continue 
  close(iunit)

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,998) msg,fname 
998 format(' +++++++ Error PAO data: ',a,a)
  close(16)
  stop

end subroutine Element__readPAO_ciao

subroutine Element__readVPS_ciao( elem, name, fname )
  use ac_parameter

  implicit none
  type(Element_type)    :: elem
  character(len=*) :: name
  character(len=*) :: fname

  logical        :: ex
  character(256) :: buf
  character(8)   :: str
  integer        :: iunit
  integer        :: ll, i, n

  real(8)  :: Q
  real(8)  :: Rc
  integer        :: nr

  integer        :: l_loc, i_pcc, i_pp, lpsmax, i_start, mord
  real(8)  :: xh
  real(8)  :: dummy_r
  real(8), allocatable :: chir(:,:), phir(:,:)
  real(8), allocatable :: vr(:), anorm_chir(:), c_pol_pc(:)
  real(8), allocatable :: t_rc(:)

  elem%name = name
  elem%dirac = .false.

  inquire(file=fname,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format(' +++++++ Error readVPS/ can not open file: ',a)
     close(16)
     stop
  end if

  iunit = 3
  open(iunit,file=fname)

  elem%pcc = .false.
  elem%nVnon = 0

  read(iunit,*) elem%atomic_number, Q, l_loc, i_pcc, i_pp
  if( iabs(i_pp) /= 2 ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) 'not supported:: gncpp',i_pp
     close(16)
     stop
  end if
  if( i_pcc == 0 ) then
     elem%pcc = .false.
  else if( i_pcc == 1 ) then
     elem%pcc = .true.
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) 'not supported:: pcc',i_pcc
     close(16)
  end if
  read(iunit,*) elem%namexc_vps 
  read(iunit,*)
  read(iunit,*) nr, xh, Rc

  allocate( vr(nr) )
  do i=1, nr
     vr(i) = Rc*dexp(dfloat(i-nr)/xh)
  enddo

  elem%Vloc%l  = l_loc-1
  elem%Vloc%Q  = -Q
  elem%Vloc%Rc = Rc

  allocate( elem%Vloc%vR(nr) )

  read(iunit,*)
  read(iunit,*) (dummy_r,i=1,nr)
  read(iunit,*) (dummy_r,i=1,nr)
  read(iunit,*) (elem%Vloc%vR(i),i=1,nr)
  read(iunit,*) (dummy_r,i=1,nr)

  read(iunit,'(a)') buf
  read(buf,*) str
  if(l_loc == 4) then
     lpsmax = l_loc
  else
     lpsmax = 3
  endif
  if( str == 'F-STATE' ) then
     lpsmax = 4
  endif

  allocate( phir(nr,lpsmax) )
  allocate( chir(nr,lpsmax) )
  allocate( anorm_chir(lpsmax) )
  allocate( t_rc(lpsmax) )

  elem%nVnon=0
  do ll=1,lpsmax
     if( ll == 1 .and. str /= 'F-STATE' ) then
        read(buf,*)
     else
        read(iunit,*)
     endif
     read(iunit,*)
     if( i_pp == -2 ) then
        read(iunit,*) (dummy_r,i=1,nr)
     end if
     read(iunit,*) (phir(i,ll),i=1,nr)
     read(iunit,*) (chir(i,ll),i=1,nr)
     anorm_chir(ll)=0.d0
     do i=1,nr
        if( dabs(chir(i,ll)-elem%Vloc%vR(i)) > 1.d-14 ) then
           t_rc(ll)=vr(i)
        end if
        chir(i,ll)=(chir(i,ll)-elem%Vloc%vR(i))*phir(i,ll)
        anorm_chir(ll)=anorm_chir(ll)+chir(i,ll)*chir(i,ll)
     end do
     if( anorm_chir(ll) > 1.d-14 ) then
        elem%nVnon=elem%nVnon+1
     end if
  end do

  if( elem%nVnon > 0 ) then
     allocate(elem%vVnon(elem%nVnon,1))
     do n=1, elem%nVnon
        allocate(elem%vVnon(n,1)%vR(nr))
     end do
  end if

  n=0
  do ll=1,lpsmax
     if( anorm_chir(ll) < 1.d-14 ) then
        cycle
     end if
     n=n+1
     elem%vVnon(n,1)%l=ll-1
     elem%vVnon(n,1)%Rc = t_rc(ll)
     do i=1, nr
        elem%vVnon(n,1)%vR(i) = chir(i,ll)/vr(i)
     end do
     elem%vVnon(n,1)%Q = 0.d0
     do i=1, nr 
        elem%vVnon(n,1)%Q = elem%vVnon(n,1)%Q + vr(i)*phir(i,ll)*chir(i,ll)/xh
     end do
     elem%vVnon(n,1)%Q = 1.d0/elem%vVnon(n,1)%Q
  end do

  if( (n-elem%nVnon) /= 0 ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) 'error:: elem%nVnon',n,elem%nVnon
     close(16)
     stop
  end if

  call RadialFunc__set( elem%Vloc, vr, nr )
  do n=1, elem%nVnon
     call RadialFunc__set( elem%vVnon(n,1), vr, nr )
  end do

  if( elem%pcc ) then
     elem%rhopcc%l  = 0
     elem%rhopcc%Rc = Rc
     allocate( elem%rhopcc%vR(nr) )
     read(iunit,*) dummy_r,i_start,mord
     if( i_start == 0 ) then
        read(iunit,*) (elem%rhopcc%vR(i),i=1,nr)
     else
        allocate(c_pol_pc(0:mord))
        read(iunit,*) (c_pol_pc(i),i=0,mord)

        do i=1,i_start
           elem%rhopcc%vR(i) = c_pol_pc(mord)
        end do
        do n=mord-1,0,-1
           do i=1,i_start
              elem%rhopcc%vR(i) = elem%rhopcc%vR(i)*vr(i)*vr(i) &
                   + c_pol_pc(n)
           end do
        end do
        do i=1,i_start
           elem%rhopcc%vR(i) = elem%rhopcc%vR(i)*vr(i)*vr(i)
        end do

        read(iunit,*) (elem%rhopcc%vR(i),i=i_start+1,nr)
        if(allocated(c_pol_pc)) deallocate(c_pol_pc)
     end if
     do i=1,nr
        elem%rhopcc%vR(i)=elem%rhopcc%vR(i)/(4.d0*M_PI*vr(i)*vr(i))
     end do
     call RadialFunc__set( elem%rhopcc, vr, nr )
  end if

  if(allocated(vr)) deallocate(vr)
  if(allocated(chir)) deallocate(chir)
  if(allocated(phir)) deallocate(phir)
  if(allocated(anorm_chir)) deallocate(anorm_chir)
  if(allocated(t_rc)) deallocate( t_rc )

  close(iunit)

  Rc=dummy_r

  return
end subroutine Element__readVPS_ciao

subroutine Element__averageVPS( elem )
  use ac_parameter

  implicit none
  type(Element_type), intent(out)   :: elem

  real(8)  :: Q(2)
  real(8)  :: vnon(2)
  integer  :: l, nr
  integer  :: i, n

  if( .not. elem%dirac ) return

  do n=1, elem%nVnon
     l    = elem%vVnon(n,1)%l
     Q(1) = elem%vVnon(n,1)%Q
     Q(2) = elem%vVnon(n,2)%Q
     nr   = elem%vVnon(n,1)%fR%N

     if( Param%Data%element_type == 'ciao_test' ) then
        if( elem%Vloc%l /= l ) then
           elem%vVnon(n,1)%Q = 1.d0 / (( (l+1)/Q(1) + (l)/Q(2) )/(2*l+1)) 
        else
           elem%vVnon(n,1)%Q = 0.d0
        end if
     else
        elem%vVnon(n,1)%Q = 1.d0 / (( (l+1)/Q(1) + (l)/Q(2) )/(2*l+1)) 
     end if
     elem%vVnon(n,2)%Q = elem%vVnon(n,1)%Q

     do i=1, nr
        vnon(1) = elem%vVnon(n,1)%vR(i)
        vnon(2) = elem%vVnon(n,2)%vR(i)

        elem%vVnon(n,1)%vR(i) = &
             ( (l+1)*vnon(1) + (l)*vnon(2) )/(2*l+1)
        elem%vVnon(n,2)%vR(i) = elem%vVnon(n,1)%vR(i)
     end do

     call RadialFunc__reset( elem%vVnon(n,1) )
     call RadialFunc__reset( elem%vVnon(n,2) )
     call RadialFunc__transpose( elem%vVnon(n,1) )
     call RadialFunc__transpose( elem%vVnon(n,2) )
  end do

  return
end subroutine Element__averageVPS

subroutine Element__readVPS_ciao_test( elem, name, fname )
  use ac_parameter

  implicit none
  type(Element_type), intent(out)   :: elem
  character(len=*), intent(in) :: name
  character(len=*), intent(in) :: fname

  integer :: nr
  integer :: l_loc,lpsmax
  real(8) :: Q

  logical :: ex
  integer :: iunit
  integer :: ll,n,i,iso_sw
  real(8) :: dummy1,dummy2,dummy3,dummy4,dummy5,dummy6
  character(1024) :: msg

  real(8), allocatable :: chir(:,:,:), phir(:,:,:)
  real(8), allocatable :: vr(:), anorm_chir(:,:)
  real(8), allocatable :: t_rc(:)

  elem%name = name

  inquire(file=fname,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      ++++++ Error readVPS/ can not open file: ',a)
     close(16)
     stop
  end if

  iunit = 3
  open(iunit,file=fname)

  elem%dirac = .true.
  elem%pcc = .false.
  lpsmax=3

  read(iunit,*)  elem%atomic_number, Q, elem%namexc_vps
  read(iunit,*)  l_loc, nr

  allocate( vr(nr) )
  allocate( phir(nr,2,lpsmax) )
  allocate( chir(nr,2,lpsmax) )
  allocate( anorm_chir(2,lpsmax) )
  allocate( t_rc(lpsmax) )

  do ll=1,lpsmax
     read(iunit,*)
     read(iunit,*)

     do n=1,nr
        read(iunit,*) vr(n),dummy1                       &
             ,phir(n,1,ll),phir(n,2,ll)          &
             ,dummy2,dummy3,dummy4,dummy5,dummy6 &
             ,chir(n,1,ll),chir(n,2,ll)
        phir(n,2,ll)=phir(n,1,ll)
     end do
  end do
  close(iunit)


  elem%Vloc%l  = l_loc-1
  elem%Vloc%Q  = -Q
  elem%Vloc%Rc = vr(nr)
  allocate( elem%Vloc%vR(nr) )

  do ll=1,lpsmax
     anorm_chir(1,ll)=0.d0
     anorm_chir(2,ll)=0.d0
  end do
  do n=1, nr
     elem%Vloc%vR(n)=chir(n,1,l_loc)
     do ll=1,lpsmax
        dummy1=chir(n,1,ll)+chir(n,2,ll)*dfloat(ll)*.5d0
        dummy2=chir(n,1,ll)-chir(n,2,ll)*dfloat(ll+1)*.5d0
        chir(n,1,ll)=(dummy1-elem%Vloc%vR(n))*phir(n,1,ll)
        chir(n,2,ll)=(dummy2-elem%Vloc%vR(n))*phir(n,2,ll)
        if( dabs(dummy1-elem%Vloc%vR(n)) > 1.d-14 ) then
           t_rc(ll)=vr(n)
        end if
        if( dabs(dummy2-elem%Vloc%vR(n)) > 1.d-14 ) then
           t_rc(ll)=vr(n)
        end if
        anorm_chir(1,ll)=anorm_chir(1,ll)+chir(n,1,ll)*chir(n,1,ll)
        anorm_chir(2,ll)=anorm_chir(2,ll)+chir(n,2,ll)*chir(n,2,ll)
     end do
  end do
  elem%nVnon=0
  do ll=1,lpsmax
     if( anorm_chir(1,ll)+anorm_chir(2,ll) > 1.d-14 ) then
        elem%nVnon = elem%nVnon + 1
     end if
  end do

  if( elem%nVnon>0 ) then
     allocate(elem%vVnon(elem%nVnon,2))
     do n=1, elem%nVnon
        allocate(elem%vVnon(n,1)%vR(nr))
        allocate(elem%vVnon(n,2)%vR(nr))
     end do
  end if

  n=0
  do ll=1,lpsmax
     if( anorm_chir(1,ll)+anorm_chir(2,ll) < 1.d-14 ) then
        cycle
     end if
     n=n+1
     elem%vVnon(n,1)%l = ll-1
     elem%vVnon(n,2)%l = ll-1
     elem%vVnon(n,1)%Rc = t_rc(ll)
     elem%vVnon(n,2)%Rc = t_rc(ll)
     do i=1, nr
        elem%vVnon(n,1)%vR(i) = chir(i,1,ll)/vr(i)
        elem%vVnon(n,2)%vR(i) = chir(i,2,ll)/vr(i)
     end do
     elem%vVnon(n,1)%Q = 0.d0
     elem%vVnon(n,2)%Q = 0.d0
     do i=1, nr
        if( i > 1 ) then
           dummy1=vr(i-1)
        else
           dummy1=0.d0
        end if
        elem%vVnon(n,1)%Q = elem%vVnon(n,1)%Q + phir(i,1,ll)*chir(i,1,ll)*(vr(i)-dummy1)
        elem%vVnon(n,2)%Q = elem%vVnon(n,2)%Q + phir(i,2,ll)*chir(i,2,ll)*(vr(i)-dummy1)
     end do
     elem%vVnon(n,1)%Q = 1.d0/elem%vVnon(n,1)%Q
     elem%vVnon(n,2)%Q = 1.d0/elem%vVnon(n,2)%Q
  end do

  if( (n-elem%nVnon) /= 0 ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) 'error:: elem%nVnon',n,elem%nVnon
     close(16)
     stop
  end if

  call RadialFunc__set( elem%Vloc, vr, nr )
  do n=1, elem%nVnon
     call RadialFunc__set( elem%vVnon(n,1), vr, nr )
     call RadialFunc__set( elem%vVnon(n,2), vr, nr )
  end do

  iunit = 3
  open(iunit,file=fname)
  read(iunit,*)
  read(iunit,*)

  do ll=1,lpsmax
     read(iunit,*)
     read(iunit,*)

     anorm_chir(2,ll)=0.d0
     do n=1,nr
        read(iunit,*) dummy1,dummy2,dummy3,dummy4,dummy5,chir(n,1,ll)
        if( ll == 1 ) then
           anorm_chir(2,ll)=anorm_chir(2,ll)+chir(n,1,ll)*chir(n,1,ll)
        else
           anorm_chir(2,ll)=anorm_chir(2,ll)+(chir(n,1,ll)-chir(n,1,1))*(chir(n,1,ll)-chir(n,1,1))
        end if
     end do
     if( ll == 1 ) then
        if( anorm_chir(2,ll) > 1.d-14 ) then
           elem%pcc = .true.
        else
           elem%pcc = .false.
           exit
        end if
     else
        if( elem%pcc .and. anorm_chir(2,ll) > 1.d-14 ) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,*) 'ciao_test: pcc -> stop'
           close(16)
           stop
        end if
     end if
  end do
  close(iunit)
  if( elem%pcc ) then
     elem%rhopcc%l  = 0
     elem%rhopcc%Rc = elem%Vloc%Rc
     allocate( elem%rhopcc%vR(nr) )
     do n=1, nr
        elem%rhopcc%vR(n) = chir(n,1,1)
     end do
     call RadialFunc__set( elem%rhopcc, vr, nr )
  end if

  if(allocated(vr)) deallocate(vr)
  if(allocated(chir)) deallocate(chir)
  if(allocated(phir)) deallocate(phir)
  if(allocated(anorm_chir)) deallocate(anorm_chir)
  if(allocated(t_rc)) deallocate( t_rc )

  if( .not. associated(elem%Vloc%vR) ) then
     msg = "Pseudo.Potentials is not given"
     goto 1111
  end if

  do n=1, elem%nVnon
     if( .not. associated(elem%vVnon(n,1)%vR) ) then
        msg = "Pseudo.Potentials is not given"
        goto 1111
     end if
  end do

  if( elem%pcc .and. (.not. associated(elem%rhopcc%vR)) ) then
     msg = "density.PCC not given"
     goto 1111
  end if

  return

1111 continue 
  close(iunit)

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,998) msg,fname 
998 format(' +++++++ Error VPS data: ',a,a)
  close(16)
  stop

end subroutine Element__readVPS_ciao_test

function Element__getNumberOfPAO( elem ) result(npao)
  use ac_parameter

  implicit none
  type(Element_type), intent(in) :: elem
  integer :: npao
  integer :: i

  npao = 0
  do i=1, elem%npao
     npao = npao + 2*(elem%vpao(i)%l) + 1
  end do

  return
end function Element__getNumberOfPAO

function Element__getNumberOfPAO2( elem ) result(npao)
  use ac_parameter

  implicit none
  type(Element_type), intent(in) :: elem
  integer :: npao
  integer :: i

  npao = 0
  do i=1, elem%npao2
     npao = npao + 2*(elem%vpao2(i)%l) + 1
  end do

  return
end function Element__getNumberOfPAO2

function Element__getNumberOfVPS( elem ) result(nvps)
  use ac_parameter

  implicit none
  type(Element_type), intent(in) :: elem
  integer :: nvps
  integer :: i

  nvps = 0
  do i=1, elem%nVnon
     if((Param%Data%element_type=='ciao_test') &
          .and.(.not. Param%Option%spin_orbit) &
          .and.(elem%dirac) &
          .and.(elem%vVnon(i,1)%l==elem%Vloc%l)) then
        cycle
     end if
     nvps = nvps + 2*(elem%vVnon(i,1)%l) + 1
  end do

  return
end function Element__getNumberOfVPS
