module pw_types

  !> This module contains the definition of a few derived types which are
  !> used throughout the code.

  use constants, only : dp, zero, tpiba2, tpiba
  use utilities, only: error, hpsort
  implicit none

  integer, parameter :: IS_IDLE        = 0, & ! Status flag for derived
                        IS_CONSTRUCTED = 1    ! data types

  type, public:: k_point

   !> The derived data type {\tt k\_point} holds all the information 
   !> associated with a given {\bf k} point in the Brillouin zone, relevant
   !> for plane-wave pseudopotential calculations

   real(DP)          :: k(3)    ! coordinates of k-point in the BZ
   real(DP)          :: wk=ZERO ! weight of k-point for BZ integrations
   integer           :: npw     ! number of PW's at this k-point
   real(DP), pointer :: gk(:)   ! array containing |k+G|^2, i.e. the 
                                ! kinetic energy associated to each PW. 
                                ! Units are Bohr radii^(-1)
   integer, pointer  :: igk(:)  ! k+G(igk(i)) is the i-th wave-vector in the 
                                ! list sorted in order of increasing |k+G|
   integer           :: status=&! initialization tag
                        IS_IDLE ! variable never used before

  end type k_point

  ! first two days up to here

  integer, parameter, public   :: IS_ASSOCIATED    = 1, &
                                  IS_ALLOCATED     = 2

  type, public :: wave_function
   complex(DP),   pointer :: val(:) => null()
   type(k_point), pointer :: k      => null()
   integer                :: status = IS_IDLE
  end type wave_function

  integer, parameter :: DIRECT_SPACE               = -1, &
                        RECIPROCAL_SPACE           =  1, &
                        DIRECT_TO_RECIPROCAL_SPACE = -1, &
                        RECIPROCAL_TO_DIRECT_SPACE =  1
  type, public :: field
   integer              :: nr1,nr2,nr3, &! FFT dimensions
                           ngm,         &! # of G vectors
                           state,       &! DIRECT_SPACE / RECIPROCAL_SPACE 
                           status=IS_IDLE
   integer,     pointer :: ig1(:), & ! [ig1(i),ig2(i),ig3(i)] are the
                           ig2(:), & ! FFT indeces of G(i)
                           ig3(:)    !
   real(DP),    pointer :: g(:,:)    ! G vectors
   real(DP),    pointer :: gg(:)     ! |G|^2
   complex(DP), pointer :: val(:,:,:)! value of the the field on the grid
  end type field

  !> The operator `=' is used to assign values to wavefunctions and fields.

!-------------------------+
  interface assignment(=) !
!-------------------------+
   module procedure copy_wvfct_to_wvfct,   & 
                    copy_wvfct_to_field,   &
                    copy_field_to_wvfct,   &
                    copy_field_to_field,   &
                    copy_real_to_wvfct,    &
                    copy_complex_to_wvfct, &
                    copy_real_to_field,    &
                    copy_complex_to_field
  end interface
  private :: copy_wvfct_to_wvfct,   copy_wvfct_to_field, &
             copy_field_to_wvfct,   copy_field_to_field, &
             copy_real_to_wvfct,    copy_real_to_field,  &
             copy_complex_to_wvfct, copy_complex_to_field
  
!---------------------------------------------------------------------------

!---------------------------+
  interface operator(.dot.) !
!---------------------------+
   module procedure wvfct_dot_wvfct, field_dot_field
  end interface
  private :: wvfct_dot_wvfct, field_dot_field
!---------------------------------------------------------------------------

!-----------------+
  interface axpy !
!-----------------+
   module procedure waxpy_r, waxpy_c, faxpy_r, faxpy_c
  end interface
  private waxpy_r, waxpy_c, faxpy_r, faxpy_c
!---------------------------------------------------------------------------

!----------------+
  interface scal !
!----------------+
   module procedure wscal_r, wscal_c, fscal_r, fscal_c
  end interface
  private wscal_r, wscal_c, fscal_r, fscal_c
!---------------------------------------------------------------------------

!---------------------+
  interface construct !
!---------------------+
   module procedure construct_k,     construct_ks,     &
                    construct_wvfct, construct_wvfcts, &
                    construct_field, construct_fields
  end interface
  private :: construct_k,     construct_ks,     &
             construct_wvfct, construct_wvfcts, &
             construct_field, construct_fields
!---------------------------------------------------------------------------

!-------------------+
  interface clonate !
!-------------------+
   module procedure clonate_wvfct, clonate_wvfcts, &
                    clonate_field, clonate_fields
  end interface

  private :: clonate_wvfct, clonate_wvfcts, clonate_field, clonate_fields
!---------------------------------------------------------------------------

!-------------------+
  interface destroy !
!-------------------+
   module procedure destroy_k,     destroy_ks, &
                    destroy_wvfct, destroy_wvfcts, &
                    destroy_field, destroy_fields
  end interface
  private :: destroy_k, destroy_ks, destroy_wvfct, destroy_wvfcts, &
                                    destroy_field, destroy_fields
!---------------------------------------------------------------------------

!---------------------+
  interface available !
!---------------------+
   module procedure available_k, available_wvfct, available_field
  end interface
  private :: available_k, available_wvfct, available_field
!---------------------------------------------------------------------------

  interface psi_link
   module procedure link_one_psi
   module procedure link_many_psis
  end interface
  private :: link_one_psi, link_many_psis

contains

  subroutine construct_ks( ks, xks, ecut, wks )

    type(k_point), intent(inout), dimension(:) :: &
         ks     ! k vectors
    real(kind=DP), intent(in), dimension(:,:) :: &
         xks    ! k vector coordinates
    real(kind=DP), intent(in) :: &
         ecut  ! kinetic-energy cutoff
    real(kind=DP), intent(in), optional, dimension(:) :: &
         wks   ! the weight of the k point

    integer  :: i
    if (size(ks) /= size(xks(1,:))) &
         call error("construct_ks", &
         "dimensions of input arguments do not match",1)

    if (present(wks)) then
       if (size(ks) /= size(wks) ) &
         call error("construct_ks","dimensions of ks and wks do not match",1)
    endif

    do i=1, size(ks)
       if (present(wks)) then
          call construct_k( ks(i), xks(:,i), ecut, wks(i) )
       else
          call construct_k( ks(i), xks(:,i), ecut )
       end if
    end do

    return
  end subroutine construct_ks

  subroutine construct_k( k, xk, ecut, wk )

    !> This routine constructs a variable of the {\tt k\_point} derived 
    !> data type. {\tt k(3)} are the coordinates of the k-point; {\tt ecut}
    !> is the kinetic-energy cutoff, and {\tt wk} (optional) is the weight
    !> for Brillouin-zone integrations

    use reciprocal_lattice, only: ngm, g, gcutm

    type(k_point), intent(inout) :: &
         k     ! k vector
    real(kind=DP), intent(in), dimension(:) :: &
         xk    ! k vector coordinates
    real(kind=DP), intent(in) :: &
         ecut  ! kinetic-energy cutoff
    real(kind=DP), intent(in), optional  :: &
         wk    ! the weight of the k point

    real(kind=DP), allocatable, dimension(:) :: gk
    integer, allocatable, dimension(:)       :: igk

    integer                                  :: ng, &! counter on   G vectors 
                                                npw  ! # of pw's

    real(kind=DP)                            :: kpg2, &! |k+G|^2
                                                g2mx   ! upper bound for |G|^2

    if (available_k(k)) call &
         error("construct_k","cannot construct a non idle k point",1)

    k%k(:)   = xk(:)
    if(present(wk)) k%wk = wk
    k%status = IS_CONSTRUCTED

    if(.not.allocated(g) .or. ngm /= size(g,2)) call &
         error("construct_k","g vectors not properly allocated",1)

    g2mx = (sqrt(k%k(1)**2+k%k(2)**2+k%k(3)**2)+sqrt(ecut)/tpiba)**2
    if (g2mx > gcutm) call error("construct_k", &
         "gcutm is too small for this k-point and kinetic-energy cutoff",2)

    allocate(igk(ngm),gk(ngm))

    npw = 0
    do ng=1,ngm
       if ( g(1,ng)**2+g(2,ng)**2+g(3,ng)**2 > g2mx ) exit

       kpg2 = ( ( k%k(1) + g(1,ng) )**2 + &
                ( k%k(2) + g(2,ng) )**2 + &
                ( k%k(3) + g(3,ng) )**2 ) * tpiba2

       if ( kpg2 <= ecut ) then
          npw=npw+1
          if ( npw > ngm ) call error ("construct_k", &
               "Too few g vectors for this kinetic-energy cutoff",npw)
          gk (npw) = kpg2
          igk(npw) = ng    ! set the initial value of index array

       endif
    end do

    ! order the gk array keeping the initial position of each one of 
    ! its elements in the igk(:) index array 

    call hpsort( gk(1:npw), igk )

    allocate(k%gk(npw),k%igk(npw))
    k%gk(:)  =  gk(1:npw)
    k%igk(:) = igk(1:npw)
    k%npw    = npw
    deallocate(igk,gk)

    k%status = IS_CONSTRUCTED

    return
  end subroutine construct_k

  subroutine destroy_k( k )

    !> This routine frees a variable of the {\tt k\_point} derived data
    !> data type.

    type(k_point), intent(in out) :: k ! k vector

    if (.not.available_k(k)) &
         call error ("destroy_k","cannot destroy an idle k point",1)

    deallocate (k%gk, k%igk)
    k%status = IS_IDLE

    return
  end subroutine destroy_k

  subroutine destroy_ks( ks )
    type(k_point), intent(inout) :: ks(:)
    integer                      :: i

    do i=1, size(ks)
       call destroy_k(ks(i))
    end do

    return
  end subroutine destroy_ks

  function available_k (k) result(is_available)

    !> This routine tests the status of a variable of the {\tt k\_point} 
    !> derived data type.

    logical                   :: is_available
    type(k_point), intent(in) :: k

    is_available = ( k%status == IS_CONSTRUCTED )

    return

  end function available_k

  function weight(ks)
    type(k_point), intent(in) :: ks
    real(DP)                  :: weight
    if(.not.available(ks)) call error("weight","input k point is idle",1)
    weight = ks%wk
    return
  end function weight

  !----------------------------+
  ! first two days  up to here !
  !----------------------------+

  subroutine construct_wvfct(the_wvfct,the_kpoint,pointee_array)

    type (wave_function), intent(in out)      :: the_wvfct
    type (k_point), intent(in), target        :: the_kpoint 
    complex(DP), intent(in), optional, target :: pointee_array(:)
  
    if (available_wvfct(the_wvfct))  &
       call error("construct_wvfct","cannot construct a non-idle wvfct",1)
    if (.not.available_k(the_kpoint)) &
       call error("construct_wvfct","the kpoint is not defined",1) 

    the_wvfct%k => the_kpoint

    if ( present(pointee_array) ) then
       the_wvfct%val => pointee_array(1:the_wvfct%k%npw)
       the_wvfct%status = IS_ASSOCIATED
    else 
       allocate(the_wvfct%val(1:the_wvfct%k%npw))
       the_wvfct%val(:) = cmplx(zero,zero)
       the_wvfct%status = IS_ALLOCATED
    end if

    return
  end subroutine construct_wvfct

  subroutine construct_wvfcts(the_wvfcts,the_kpoint,pointees)
    type(wave_function), intent(in out)       :: the_wvfcts(:)
    type(k_point), intent(in)                 :: the_kpoint
    complex(DP), intent(in), optional, target :: pointees(:,:)

    integer                                   :: i

    do i=1, size(the_wvfcts)
       if(present(pointees)) then
          call construct_wvfct(the_wvfcts(i),the_kpoint,pointees(:,i))
       else
          call construct_wvfct(the_wvfcts(i),the_kpoint)
       end if
    end do

    return
  end subroutine construct_wvfcts

  subroutine clonate_wvfct(the_wvfct,clone)
    type(wave_function), intent(in)     :: the_wvfct
    type(wave_function), intent(in out) :: clone

    call construct_wvfct(clone,the_wvfct%k)

    return
  end subroutine clonate_wvfct

  subroutine clonate_wvfcts(the_wvfct,clones)
    type(wave_function), intent(in)     :: the_wvfct
    type(wave_function), intent(in out) :: clones(:)

    call construct_wvfcts(clones,the_wvfct%k)

    return
  end subroutine clonate_wvfcts

  subroutine destroy_wvfct(the_wvfct)

    type(wave_function), intent(in out) :: the_wvfct

    select case(the_wvfct%status)
    case( IS_IDLE )
       call error("destroy_wvfct","cannot destroy an idle wave-function",1)
    case( IS_ALLOCATED )
       deallocate(the_wvfct%val)
    case( IS_ASSOCIATED )
       the_wvfct%val => null()
    case default
       call error("destroy_wvfct","unrecognized status: dunno what to do",2) 
    end select

    the_wvfct%status = IS_IDLE

    return
  end subroutine destroy_wvfct

  subroutine destroy_wvfcts(the_wvfcts)
    type(wave_function), intent(in out) :: the_wvfcts(:)
    integer                             :: i
    
    do i=1, size(the_wvfcts)
       call destroy_wvfct(the_wvfcts(i))
    end do
    
    return
  end subroutine destroy_wvfcts

  subroutine link_one_psi(hook,target)
    type(wave_function), intent(inout) :: target, hook

    if(.not.available(hook)) then
       call construct(hook,target%k,target%val)
    else
       if( hook%status == IS_ALLOCATED ) call error &
            ("link_one_psi","cannot link an allocated psi",1)
       !       if( hook%n /= target%n ) call error &
       !            ("link_one_psi","input dimensions do not match",2)
       hook%val => target%val
    end if
    
    return
  end subroutine link_one_psi
  
  subroutine link_many_psis(hooks,targets)
    type(wave_function), dimension(:), intent(inout) :: targets, hooks
    integer :: i
    
    if(size(hooks) /= size(targets)) &
         call error("link_many","input dimensions do not match",1)
    do i=1, size(hooks)
       call link_one_psi(hooks(i),targets(i))
    end do
    
    return
  end subroutine link_many_psis

  function available_wvfct(the_wvfct) result(is_available)
    logical                         :: is_available
    type(wave_function), intent(in) :: the_wvfct

    is_available = ( the_wvfct%status /= IS_IDLE )

    return
  end function available_wvfct

  subroutine copy_complex_to_wvfct(wvfct_out,complex_in)
    type(wave_function), intent (in out) :: wvfct_out
    complex(DP)        , intent (in)     :: complex_in

    if(.not.available(wvfct_out)) call error("copy_complex_to_wvfct", &
         "cannot copy to an idle wavefunction",1)

    wvfct_out%val(:) = complex_in

    return
  end subroutine copy_complex_to_wvfct

  subroutine copy_real_to_wvfct(wvfct_out,real_in)
    type(wave_function), intent (in out) :: wvfct_out
    real(DP   )        , intent (in)     :: real_in

    if(.not.available(wvfct_out)) call error("copy_real_to_wvfct", &
         "cannot copy to an idle wavefunction",1)

    wvfct_out%val(:) = cmplx(real_in,ZERO)

    return
  end subroutine copy_real_to_wvfct

  subroutine copy_wvfct_to_wvfct(wvfct_out,wvfct_in)
    type (wave_function), intent(in)     :: wvfct_in
    type (wave_function), intent(in out) :: wvfct_out

    if (.not. available_wvfct(wvfct_in) ) &
         call error ("copy_wvfct_to_wvfct","cannot copy an idle wvfct",1)

    if( .not. available_wvfct(wvfct_out) ) then
       call construct_wvfct(wvfct_out,wvfct_in%k)
    else 
       if ( any(wvfct_out%k%k /= wvfct_in%k%k) ) call error &
            ("copy_wvfct_to_wvfct","in and out kpoints do not match",1)
    end if

    wvfct_out%val(:) =  wvfct_in%val(:)

    return
  end subroutine copy_wvfct_to_wvfct

  subroutine wscal_c(a,x)
    complex(DP), intent(in)             :: a
    type(wave_function), intent(in out) :: x

    if(.not.available(x)) call error("wscal_c","input psi is idle",1)

    x%val = a * x%val

    return
  end subroutine wscal_c

  subroutine wscal_r(a,x)
    real(DP), intent(in)                :: a
    type(wave_function), intent(in out) :: x

    if(.not.available(x)) call error("wscal_r","input psi is idle",1)

    x%val = a * x%val

    return
  end subroutine wscal_r

  subroutine waxpy_c(a,x,y)
    complex(DP),         intent(in)     :: a
    type(wave_function), intent(in)     :: x
    type(wave_function), intent(in out) :: y
    
    if(.not.available(x) .or. .not.available(y)) &
         call error("waxpy_c","input psi's are idle",1)
    !    if(.not.agree(x,y)) call error("waxpy_c","input psi's do not agree",1)

    y%val = a*x%val + y%val

    return
  end subroutine waxpy_c

  subroutine waxpy_r(a,x,y)
    real(DP)                            :: a
    type(wave_function), intent(in)     :: x
    type(wave_function), intent(in out) :: y
    
    if(.not.available(x) .or. .not.available(y)) &
         call error("waxpy_r","input psi's are idle",1)
    !    if(.not.agree(x,y)) call error("waxpy_r","input psi's do not agree",1)

    y%val = a*x%val + y%val

    return
  end subroutine waxpy_r

  subroutine construct_field(the_field,state,pointee_array)

    use reciprocal_lattice, only: ngm, nr1,nr2,nr3, ig1,ig2,ig3, g, gg

    integer,          intent(in)                   :: state
    complex(kind=DP), intent(in), optional, target :: pointee_array(:,:,:)
    type(field),      intent(in out)               :: the_field

    if (available_field(the_field) ) call error &
         ("construct_field","cannot construct a non-idle field",1)

    if( .not.allocated(gg) ) call error("construct_field", &
         "g-vectors not allocated: cannot construct field",1)

    if( .not.allocated(ig1).or.  .not.allocated(ig2).or.   &
         .not.allocated(ig3)) call error("construct_field", &
         "ig-vectors not allocated: cannot construct field",1)
    
    if (nr1==0 .or. nr2==0 .or. nr3==0) call error ("construct_field", &
         "cannot construct a field with zero dimensions",1)
    
    the_field%state =  state
    
    the_field%nr1   =  nr1
    the_field%nr2   =  nr2
    the_field%nr3   =  nr3
    
    the_field%ig1   => ig1
    the_field%ig2   => ig2
    the_field%ig3   => ig3

    the_field%ngm   =  ngm

    the_field%g     => g
    the_field%gg    => gg
    
    if( present(pointee_array) ) then
       if( nr1 /= size(pointee_array,1) .or. &
           nr2 /= size(pointee_array,2) .or. &
           nr3 /= size(pointee_array,3) )    &
           call error("construct_field","incompatible pointee size",2)
       the_field%val    => pointee_array
       the_field%status =  IS_ASSOCIATED
    else 
       allocate ( the_field%val(the_field%nr1,the_field%nr2,the_field%nr3) )
       the_field%status = IS_ALLOCATED
       the_field%val(:,:,:) = cmplx(ZERO,ZERO)
    end if

    return
  end subroutine construct_field

  subroutine construct_fields(the_fields,state,pointees)
    type(field),      intent(in out)               :: the_fields(:)
    complex(kind=DP), intent(in), optional, target :: pointees(:,:,:,:)
    integer,          intent(in)                   :: state
    integer                                        :: i

    do i=1, size(the_fields)
       if(present(pointees)) then
          call construct_field(the_fields(i),state,pointees(:,:,:,i))
       else
          call construct_field(the_fields(i),state)
       end if
    end do

    return
  end subroutine construct_fields

  subroutine clonate_field(the_field,clone)
    type(field), intent(in)     :: the_field
    type(field), intent(in out) :: clone

    call construct_field(clone,the_field%state)

    return
  end subroutine clonate_field

  subroutine clonate_fields(the_field,clones)
    type(field), intent(in)     :: the_field
    type(field), intent(in out) :: clones(:)

    call construct_fields(clones,the_field%state)
    
    return
  end subroutine clonate_fields

  subroutine destroy_field(the_field)

    type(field), intent(in out)   :: the_field

    select case(the_field%status)
    case( IS_IDLE )
       call error("destroy_field","cannot destroy an idle field",1)
    case( IS_ALLOCATED )
       deallocate(the_field%val)
    case( IS_ASSOCIATED )
       the_field%val => null()
    case default
       call error("destroy_field","unrecognized status: dunno what to do",2) 
    end select

    the_field%ig1    => null()
    the_field%ig2    => null()
    the_field%ig3    => null()
    the_field%g      => null()
    the_field%gg     => null()

    the_field%status =  IS_IDLE

    return
  end subroutine destroy_field
  
  subroutine destroy_fields(the_fields)

    type(field), intent(in out) :: the_fields(:)
    integer                     :: i

    do i=1, size(the_fields)
       call destroy_field(the_fields(i))
    end do

    return
  end subroutine destroy_fields

  function available_field(the_field) result(is_available)
    logical                 :: is_available
    type(field), intent(in) :: the_field

    is_available = ( the_field%status /= IS_IDLE )

    return
  end function available_field

  subroutine copy_complex_to_field(field_out,complex_in)
    type(field), intent (in out) :: field_out
    complex(DP), intent (in)     :: complex_in

    if(.not.available(field_out)) call error &
         ("copy_complex_to_field","cannot copy to an idle field",1)

    field_out%val(:,:,:) = complex_in
    
    return
  end subroutine copy_complex_to_field

  subroutine set_field_state(the_field,state)
    type(field), intent(in out) :: the_field
    integer,     intent(in)     :: state

    if(.not.available(the_field)) call error &
         ("set_field_state","cannot set the state of an idle field",1)
    the_field%state = state

    return
  end subroutine set_field_state

  subroutine copy_real_to_field(field_out,real_in)
    type(field), intent (in out) :: field_out
    real(DP)   , intent (in)     :: real_in
    
    if(.not.available(field_out)) call error &
         ("copy_real_to_field","cannot copy to an idle field",1)
    
    field_out%val(:,:,:) = cmplx(real_in,ZERO)

    return
  end subroutine copy_real_to_field

  subroutine fscal_c(a,x)
    complex(DP), intent(in)     :: a
    type(field), intent(in out) :: x

    if(.not.available(x)) call error("fscal_c","input psi is idle",1)

    x%val = a * x%val

    return
  end subroutine fscal_c

  subroutine fscal_r(a,x)
    real(DP),    intent(in)     :: a
    type(field), intent(in out) :: x


    if(.not.available(x)) call error("fscal_r","input psi is idle",1)

    x%val = a * x%val

    return
  end subroutine fscal_r

  subroutine faxpy_c(a,x,y)
    complex(DP), intent(in)     :: a
    type(field), intent(in)     :: x
    type(field), intent(in out) :: y
    
    if(.not.available(x) .or. .not.available(y)) &
         call error("faxpy_c","input psi's are idle",1)
    ! if(.not.agree(x,y)) call error("faxpy_c","input fields do not agree",1)

    y%val = a*x%val + y%val

    return
  end subroutine faxpy_c

  subroutine faxpy_r(a,x,y)
    real(DP), intent(in)        :: a
    type(field), intent(in)     :: x
    type(field), intent(in out) :: y
    
    if(.not.available(x) .or. .not.available(y)) &
         call error("faxpy_c","input psi's are idle",1)
    ! if(.not.agree(x,y)) call error("faxpy_c","input fields do not agree",1)

    y%val = a*x%val + y%val

    return
  end subroutine faxpy_r

  subroutine field_square(the_field)
    type(field), intent(in out) :: the_field
    integer                     :: field_state

    field_state = the_field%state
    if( field_state == RECIPROCAL_SPACE ) &
         call field_ft(the_field,RECIPROCAL_TO_DIRECT_SPACE)

    the_field%val(:,:,:) = the_field%val(:,:,:) * conjg( the_field%val(:,:,:) )

    if( field_state == RECIPROCAL_SPACE ) &
         call field_ft(the_field,DIRECT_TO_RECIPROCAL_SPACE)

    return
  end subroutine field_square

  function average_field(the_field)
    complex(DP) :: average_field
    type(field), intent(in) :: the_field
    
    if( the_field%state == RECIPROCAL_SPACE ) then
       average_field = the_field%val(1,1,1)
    else
       average_field = sum(the_field%val) &
            / (the_field%nr1*the_field%nr2*the_field%nr3)
    end if

    return
  end function average_field

  subroutine copy_wvfct_to_field(the_field,the_wvfct)
    type (field),         intent(in out) :: the_field
    type (wave_function), intent(in)     :: the_wvfct
    integer                              :: the_field_state, &
                                            i, igk_of_i, n1,n2,n3

    if (.not. available_wvfct(the_wvfct) ) call error &
         ("copy_wvfct_to_field","the_wvfct is not defined",1) 
    
    if( .not. available_field(the_field) ) &
         call construct_field(the_field,RECIPROCAL_SPACE)

    the_field%val(:,:,:) = cmplx(ZERO,ZERO)
    the_field_state      = the_field%state
    the_field%state      = RECIPROCAL_SPACE

    do i=1, the_wvfct%k%npw
       igk_of_i                = the_wvfct%k%igk(i)
       n1                      = the_field%ig1(igk_of_i)
       n2                      = the_field%ig2(igk_of_i)
       n3                      = the_field%ig3(igk_of_i)
       the_field%val(n1,n2,n3) = the_wvfct%val(i)
    end do

    if(the_field_state == DIRECT_SPACE) &
         call field_ft(the_field,RECIPROCAL_TO_DIRECT_SPACE)
 
    return
  end subroutine copy_wvfct_to_field

  subroutine copy_field_to_wvfct(the_wvfct,the_field)
    type (wave_function), intent(in out) :: the_wvfct
    type (field),         intent(in)     :: the_field
    integer                              :: i, igk_of_i, n1,n2,n3
    
    if (.not.available_field(the_field)) call error &
         ("copy_field_to_wvfct","cannot copy an idle field",1)
    
    if( .not. available_wvfct(the_wvfct)) call error &
         ("copy_field_to_wvfct","destination wvfct cannot be idle",1) 

    the_wvfct%val = cmplx(ZERO,ZERO)
    if (the_field%state /= RECIPROCAL_SPACE) call error &
         ("copy_field_to_wvfct","cannot copy to a field in real space",1)

    do i=1, the_wvfct%k%npw
       igk_of_i         = the_wvfct%k%igk(i)
       n1               = the_field%ig1(igk_of_i)
       n2               = the_field%ig2(igk_of_i)
       n3               = the_field%ig3(igk_of_i)
       the_wvfct%val(i) = the_field%val(n1,n2,n3)
    end do
    
    return
  end subroutine copy_field_to_wvfct

  subroutine copy_field_to_field(field_out,field_in)
    type (field),         intent(in)     :: field_in
    type (field),         intent(in out) :: field_out
    
    if (.not. available_field(field_in) ) call error &
         ("copy_field_to_field","cannot copy an idle field",1)

    if (.not. available_field(field_out) ) &
         call construct_field(field_out,field_in%state)

    field_out%state =  field_in%state
    field_out%val   =  field_in%val

    return
  end subroutine copy_field_to_field

  function wvfct_dot_wvfct(psi_1,psi_2) result(dot)
    type (wave_function), intent(in) :: psi_1, psi_2
    complex(kind=DP)                 :: dot

    if ( .not.available_wvfct(psi_1) .or. .not.available_wvfct(psi_2) ) &
         call error("wvfct_dot_wvfct","input wvfct's cannot be idle",1)

    if( any ( psi_1%k%k /= psi_2%k%k ) ) call error &
         ("wvfct_dot_wvfct", "wave-function refer to different k points",1)

    dot = dot_product(psi_1%val,psi_2%val)

    return
  end function wvfct_dot_wvfct

  function field_dot_field(field_1,field_2) result(dot)
    type (field), intent(in) :: field_1, field_2
    complex(kind=DP)         :: dot
    integer                  :: i,j,k, nr1,nr2,nr3, state
    
    if ( .not.available_field(field_1) .or. .not.available_field(field_2) ) &
         call error("field_dot_field","the input fields cannot be idle",1)

    if( field_1%nr1   == field_2%nr1 .and. &
        field_1%nr2   == field_2%nr2 .and. &
        field_1%nr3   == field_2%nr3 .and. &
        field_1%state == field_2%state )  then
       nr1   = field_1%nr1
       nr2   = field_1%nr2
       nr3   = field_1%nr3
       state = field_1%state
    else
       call error("field_dot_field","field dimensions/state do not match",1)
    end if

    dot = cmplx(zero,zero)
    
    do k=1, nr3
       do j=1, nr2
          do i=1, nr1
             dot = dot + conjg(field_1%val(i,j,k)) * field_2%val(i,j,k)
          end do
       end do
    end do

    if(state==DIRECT_SPACE) dot = dot / (nr1*nr2*nr3)

    return
  end function field_dot_field

  subroutine field_ft(the_field,sign)
    use fourier, only: fft
    type(field), intent(in out) :: the_field
    integer,     intent(in)     :: sign

    if ( .not.available_field(the_field) ) &
         call error("field_ft","the field cannot be idle",1)

    if ( sign /= the_field%state ) call error("field_ft", &
         "sign of ft and field state do not match",1)

    call fft(the_field%val,the_field%state)
    the_field%state = -the_field%state

    return
  end subroutine field_ft

  subroutine field_times_wvfct(the_field,the_wvfct,resulting_wvfct)
    type(field),         intent(in)     :: the_field
    type(wave_function), intent(in)     :: the_wvfct
    type(wave_function), intent(in out) :: resulting_wvfct
    type(field)                         :: aux_field

    if (.not.available_field(the_field)) call error &
         ("field_times_wvfct","the field cannot be idle",1)

    if (.not.available_wvfct(the_wvfct)) call error &
         ("field_times_wvfct","the input wvfct cannot be idle",1)

    if (.not.available_wvfct(resulting_wvfct)) &
         call construct_wvfct(resulting_wvfct,the_wvfct%k)

    call construct_field(aux_field,RECIPROCAL_SPACE)
    
    aux_field =  the_wvfct
    
    call field_ft(aux_field,RECIPROCAL_TO_DIRECT_SPACE)

    aux_field%val   = the_field%val * aux_field%val
    
    call field_ft(aux_field,DIRECT_TO_RECIPROCAL_SPACE)

    resulting_wvfct = aux_field

    call destroy_field(aux_field)
    
    return
  end subroutine field_times_wvfct

end module pw_types
