package Photonic::WEM::S::Haydock;
$Photonic::WEM::S::Haydock::VERSION = '0.025';

=encoding UTF-8

=head1 NAME

Photonic::WEM::S::Haydock

=head1 VERSION

version 0.025

=head1 SYNOPSIS

    use Photonic::WEM::S::Haydock;
    my $nr=Photonic::WEM::S::Haydock->new(metric=>$g, polarization=>$p);
    $nr->iterate;
    say $nr->iteration;
    say $nr->current_a;
    say $nr->next_b2;
    my $state=$nr->next_state;

=head1 DESCRIPTION

Implements calculation of Haydock coefficients and Haydock states for
the calculation of the retarded dielectric function of arbitrary
periodic systems (unbounded and bounded) with magnetic permeability
being either 1 or different than 1 in arbitrary number of
dimensions, one Haydock coefficient at a time. It uses the wave
equation and the spinor representation.

Consumes L<Photonic::Roles::Haydock>, L<Photonic::Roles::UseMask>,
L<Photonic::Roles::EpsFromGeometry>
- please see those for attributes.

=head1 ATTRIBUTES

=over 5

=item * metric Photonic::WEM::S::Metric

A L<Photonic::WEM::S::Metric> object defining the geometry of the
system, the characteristic function, the wavenumber, wavevector and
host dielectric function. Required in the initializer.

=item * B ndims dims epsilon or mu

Accessors handled by metric (see L<Photonic::WEM::S::Metric>)

=item * polarization complex PDL

A non null vector defining the complex direction of the macroscopic
field.

=item * normalizedPolarization

The polarization, normalised

=back

=head1 METHODS

=over 4

=item * applyMetric($psi)

Returns the result of applying the metric to the state $psi.

=back

=head1 ATTRIBUTES SUPPLIED FOR ROLE

=over 4

=item * applyOperator($psi_G)

Apply the 'Hamiltonian' operator to state $psi_G. State is
ri,xy,pm,nx,ny... The Hamiltonian is the metric followed by the
dielectric esponse relative to the reference response.

=item * innerProduct($left, $right)

Returns the inner Euclidean product between states with the metric.

=item * magnitude($psi)

Returns the magnitude of a state as the square root of
the magnitude of inner product of the state with itself.

=item * changesign

Returns 0, as there is no need to change sign.

=item * complexCoeffs

Haydock coefficients are complex

=back

=cut

=head1 COPYRIGHT NOTICE

Photonic - A perl package for calculations on photonics and
metamaterials.

Copyright (C) 2016 by W. Luis Mochán

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA  02110-1301 USA

    mochan@fis.unam.mx

    Instituto de Ciencias Físicas, UNAM
    Apartado Postal 48-3
    62251 Cuernavaca, Morelos
    México

=cut

use namespace::autoclean;
use PDL::Lite;
use PDL::NiceSlice;
use Carp;
use Photonic::Types -all;
use Photonic::Utils qw(VSProd any_complex GtoR RtoG mvN);
use Moo;
#use MooX::StrictConstructor;

has 'metric'=>(is=>'ro', isa => InstanceOf['Photonic::WEM::S::Metric'],
	       handles=>{B=>'B', ndims=>'ndims', dims=>'dims',
			 geometry=>'geometry', epsilonR=>'epsilon',
	                 mu=>'mu'},
	       required=>1);
has 'polarization' =>(is=>'ro', required=>1, isa=>PDLComplex);
has 'normalizedPolarization' =>(is=>'ro', isa=>PDLComplex,
     init_arg=>undef, writer=>'_normalizedPolarization');
has 'complexCoeffs'=>(is=>'ro', init_arg=>undef, default=>1,
		      documentation=>'Haydock coefficients are complex');

with 'Photonic::Roles::Haydock', 'Photonic::Roles::UseMask',
'Photonic::Roles::EpsFromGeometry';

# the state to whish we apply the hamiltonian is $g_psi_G
sub applyOperator {
    my $self=shift;
    my $psi=shift; #psi is xyz:pm:nx:ny:nz
    my $mask=undef;
    $mask=$self->mask if $self->use_mask;
    my $g = $self->metric; #metric object
    # apply metric
    my $g_psi_G=$g->apply($psi); # xyz:pm:nx:ny:nz.
    # FIRST TERM
    # get longitudinal projector and apply it to g psi
    my $PL_g_psi_G = $g->LP #xyz:xyz:pm:nx:ny:nz
			  ->inner($g_psi_G(:,*1)) #xyz:1:pm:nx:ny:nz
			 ; # matrix-vector product xyz:pm:nx:ny:nz
    #SECOND TERM applied to g_psi
    #FT g_psi to real space
    my $g_psi_r = GtoR(mvN($g_psi_G,0,1,-1),$self->ndims,0); #nx:ny:nz:xyz:pm
    # left-multiply by epsilon in real space
    my $eps_psi_r = ($self->epsilon * $g_psi_r); #nx:ny:nz:xyz:pm
    # FT the product to reciprocal space
    my $eps_psi_G = mvN(RtoG($eps_psi_r, $self->ndims, 0),-2,-1,0); #xyz:pm:nx:ny:nz
    ### Apply Hamiltonian in G space
    my $H_g_psi_G = $PL_g_psi_G - $eps_psi_G;
    #psi_G is xyz:pm:nx:ny:nz mask is nx:ny:nz
    $H_g_psi_G *= $mask->(*1,*1) if defined $mask; #use dummies for xyz:pm
    return $H_g_psi_G;
}

sub applyMetric {
    my $self=shift;
    my $psi=shift;
    return $self->metric->apply($psi);
}

sub innerProduct {  #Return Hermitian product with metric
    my $self=shift;
    my $psi1=shift;
    my $psi2=shift;
    my $g_psi2=$self->metric->apply($psi2);
    return VSProd($psi1, $g_psi2);
}

sub magnitude {
    my $self=shift;
    my $psi=shift;
    return $self->innerProduct($psi, $psi)->abs->sqrt;
}

sub changesign { #don't change sign
    return 0;
}

sub _build_firstState { #\delta_{G0}
    my $self=shift;
    my $v=PDL->zeroes(@{$self->dims})->r2C; #nx:ny...
    my $arg=join ',', ("(0)") x $self->ndims; #(0),(0),... ndims times
    $v->slice($arg).=1/sqrt(2);
    my $e=$self->polarization; #xy
    my $d=$e->dim(0);
    confess "Polarization has wrong dimensions. " .
	  " Should be $d-dimensional complex vector, got ($e)."
	unless any_complex($e) && $e->dim(0)==$d;
    my $modulus=$e->magnover->re;
    confess "Polarization should be non null" unless
	$modulus > 0;
    $e=$e/$modulus;
    $self->_normalizedPolarization($e);
    #Use same helicity for k and for -k, conjugate polarization, for allowing chirality
    my $phi=pdl($e, $e->conj)*$v->(*1,*1); #initial state ordinarily normalized
                       # xy:pm:nx:ny
    return $phi;
}

__PACKAGE__->meta->make_immutable;

1;
