!
! This file is part of SACAMOS, State of the Art CAble MOdels for Spice. 
! It was developed by the University of Nottingham and the Netherlands Aerospace 
! Centre (NLR) for ESA under contract number 4000112765/14/NL/HK.
! 
! Copyright (C) 2016-2018 University of Nottingham
! 
! SACAMOS 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 3 of the License, or (at your option) any later 
! version.
! 
! SACAMOS 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.
! 
! A copy of the GNU General Public License version 3 can be found in the 
! file GNU_GPL_v3 in the root or at <http://www.gnu.org/licenses/>.
! 
! SACAMOS uses the EISPACK library (in /SRC/EISPACK). EISPACK is subject to 
! the GNU Lesser General Public License. A copy of the GNU Lesser General Public 
! License version can be found in the file GNU_LGPL in the root of EISPACK 
! (/SRC/EISPACK ) or at <http://www.gnu.org/licenses/>.
! 
! The University of Nottingham can be contacted at: ggiemr@nottingham.ac.uk
!
!
! File Contents:
! SUBROUTINE write_s_domain_controlled_voltage_source
! SUBROUTINE write_filter_model
! SUBROUTINE write_Pspice_filter_model
!
! NAME
!     write_s_domain_controlled_voltage_source
!
! AUTHORS
!     Chris Smartt
!
! DESCRIPTION
!     Write a controlled source with a s-domain transfer function
!     The format is dependent on the target spice version.
!
!     INPUTS REQUIRED
!     1. spice_model_name      ! component name
!     2. node_1_in             ! controlling node number 1
!     3. node_2_in             ! controlling node number 2
!     4. node_1_out            ! controlled node number 1
!     5. node_2_out            ! controlled node number 2
!     6. Hp                    ! Transfer function
!     7. gain                  ! gain applied to the transfer function
!
!     OUTPUTS
!     1. components written to the spice subcircuit file
!     
!   If the s-domain transfer function is a constant i.e. not frequency dependent then a normal controlled source is used
!  
!   If the flag no_sxfer is set then a circuit which models the transfer function is written instead but only for orders 1 and 2 
!
! COMMENTS
!     
!     
!
! HISTORY
!
!     started 15/6/2016
!     16/6/2016 Make this subroutine compatible with ngspice, Pspice and LTspice
!     24/6/2016 Try out ideas for equivalent circuit implementation of s-domain transfer functions
!     17/11/2017 CJS include the network synthesis method for s-domain transfer functions
!     16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
!
  SUBROUTINE write_s_domain_controlled_voltage_source(spice_model_name,node_1_in,node_2_in, &
                                                      node_1_out,node_2_out,Hp,gain_in,vref_node,next_free_node)

USE type_specifications
USE general_module
USE filter_module

IMPLICIT NONE

! variables passed to the subroutine

character(LEN=spice_name_length),intent(IN) :: spice_model_name     ! component name

integer,intent(IN) :: node_1_in                  ! controlling node number 1
integer,intent(IN) :: node_2_in                  ! controlling node number 2
integer,intent(IN) :: node_1_out                 ! controlled node number 1
integer,intent(IN) :: node_2_out                 ! controlled node number 2

TYPE(Sfilter),intent(IN) :: Hp                   ! Transfer function
real(dp),intent(IN) :: gain_in                   ! gain applied to the transfer function

integer,intent(IN) :: vref_node                  ! spice subcircuit reference node number
integer,intent(INOUT) :: next_free_node          ! next free node number

! local variables

logical :: frequency_dependent_model        ! flag to indicate whether the transfer function has frequency dependence

character(LEN=spice_name_length) :: Source_name
character(LEN=spice_name_length) :: Hp_name

real(dp) :: gain


! START
  Hp_name='Filter_'//trim(spice_model_name)

  if ( (Hp%a%order.NE.0).OR.(Hp%b%order.NE.0)) then
  
    frequency_dependent_model=.TRUE.
    
    if (.NOT.use_s_xfer) then
! write an equivalent circuit which implments the propagation correction

      CALL network_synthesis(Hp,gain_in,Hp_name,node_1_in,node_2_in,node_1_out,node_2_out,   &
                               vref_node,next_free_node,spice_model_file_unit)

    else if (spice_version.EQ.ngspice) then
! Ngspice model using s_xfer

      CALL write_filter_model(Hp_name, Hp, gain_in, spice_model_file_unit)

! controlled source on end 1.
! note reversed node numbering compared to the controlled source form
      Source_name='AE_'//trim(spice_model_name)
      write(spice_model_file_unit,'(A30,A,2I6,A,2I6,A,A20)') Source_name,                  &
                                                            ' %vd ',node_1_in,node_2_in,   &
                                                            ' %vd ',node_1_out,node_2_out, & 
                                                            ' ',trim(Hp_name)
    else ! Pspice or LTspice model using Laplace source
    
      Source_name='E_'//trim(spice_model_name)
      CALL write_Pspice_filter_model(Source_name, Hp, gain_in, node_1_in, node_2_in, node_1_out, node_2_out ,spice_model_file_unit)
    
    end if ! spice versions
    
  else
! the transfer function is not frequency dependent so write a normal controlled source

    frequency_dependent_model=.FALSE.
    gain=gain_in*Hp%a%coeff(0)/Hp%b%coeff(0)   ! allow for a gain term in the normal controlled source
    
! this form is common to all spice versions
! note reversed node numbering compared to the s-domain transfer function form

    Source_name='E_'//trim(spice_model_name)
    write(spice_model_file_unit,'(A30,2I6,2I6,ES16.6)')Source_name,             &
                                                       node_1_out,node_2_out,   & 
                                                       node_1_in,node_2_in,gain 

  end if 

END SUBROUTINE write_s_domain_controlled_voltage_source

! NAME
!     write_filter_model
!
! AUTHORS
!     Chris Smartt
!
! DESCRIPTION
!     This code writes the given sfilter as an NGspice s-domain transfer function 
!
!     INPUTS
!        1. The filter function to write
!        2. The unit to write the s-domain transfer function to
!
!     OUTPUTS
!        1. The s-domain transfer function is written to the unit provided
!     
! COMMENTS
!     The order of the model numerator cannot be greater that the order of the denominator
!     and the order of the model denominator cannot be 0. These create an error in Ngspice
!
!     Note the fixed format write which needs to be generalised
!
! HISTORY
!
!     STAGE 4 developments started 22/4/2016 CJS
!
SUBROUTINE write_filter_model(model_name,filter,gain,unit)

USE type_specifications
USE general_module
USE spice_cable_bundle_module
USE filter_module

IMPLICIT NONE

character(len=spice_name_length),intent(IN) :: model_name
type(Sfilter),intent(IN)   :: filter                          ! filter transfer function
real(dp),intent(IN)        :: gain                            ! gain associated with the transfer function
integer,intent(IN)         :: unit                            ! unit to write to

! local variables

integer :: order,i

character(len=line_length) :: ic_list      ! string for initial conditions
character(len=line_length) :: num_list     ! string for numerator coefficients
character(len=line_length) :: den_list     ! string for denominator coefficients

character(LEN=18) :: num

! START

! check that the function is valid

if (filter%a%order.GT.filter%a%order) then
  
  run_status='ERROR in write_filter_model. The order of the model numerator is greater that the order of the denominator'
  CALL write_program_status()
  STOP 1
  
end if

if (filter%b%order.EQ.0) then
  
  run_status='ERROR in write_filter_model. The order of the model denominator cannot be 0'
  CALL write_program_status()
  STOP 1
  
end if

! create numerator list

order=filter%a%order

num_list=' '
do i=order,0,-1
  write(num,'(E18.10)')filter%a%coeff(i)
  num_list=trim(adjustl(num_list))//trim(num)//' '
end do

! create denominator list

order=filter%b%order

den_list=' '
ic_list=' '
do i=order,0,-1
  write(num,'(E18.10)')filter%b%coeff(i)
  den_list=trim(adjustl(den_list))//trim(num)//' '
  ic_list=trim(adjustl(ic_list))//' 0 '
end do

write(unit,'(A7,A20,A14,ES16.6,A,A,A)')'.model ',model_name,' s_xfer( gain=',gain,' int_ic=[',trim(ic_list),'] '
write(unit,'(A,A,A)')' + num_coeff=[',trim(num_list),'] '
write(unit,'(A,A,A)')' + den_coeff=[',trim(den_list),'] '
write(unit,'(A,E16.6,A)')' + denormalized_freq ',filter%wnorm,' )'

END SUBROUTINE write_filter_model


! NAME
!     write_Pspice_filter_model
!
! AUTHORS
!     Chris Smartt
!
! DESCRIPTION
!     This code writes a voltage controlled voltage source with the given sfilter (s-domain transfer function)
!     This model is compatible with LTspice and Pspice
!
!     INPUTS
!        1. The filter function to write
!        2. The nodes controlling the source
!        3. The nodes controled by the source
!        4. The unit to write the s-domain transfer function to
!
!     OUTPUTS
!        1. The voltage controlled voltage source with s-domain transfer function is written to the unit provided
! Example output format:
!E_m_d1_m1_e2            17     1 Laplace {V(19,1)}=
! + {(
! +   0.3127575955E+01*(s/  0.6283185307E+10)^2 +
! +   0.7705427441E+01*(s/  0.6283185307E+10) +
! +   0.1000000000E+01
! + )/
! + (
! +   0.3343016331E+01*(s/  0.6283185307E+10)^2 +
! +   0.7822649005E+01*(s/  0.6283185307E+10) +
! +   0.1000000000E+01
! + ) }
!
!     
! COMMENTS
!     The order of the model numerator cannot be greater that the order of the denominator
!     and the order of the model denominator cannot be 0. These create an error in Ngspice
!
!     Note the fixed format write which needs to be generalised
!
! HISTORY
!
!     Started 16/6/2016 CJS
!
SUBROUTINE write_Pspice_filter_model(model_name,filter,gain,node_1_in,node_2_in,node_1_out,node_2_out,unit)

USE type_specifications
USE general_module
USE spice_cable_bundle_module
USE filter_module

IMPLICIT NONE

character(len=spice_name_length),intent(IN) :: model_name ! component name
type(Sfilter),intent(IN)   :: filter                      ! Transfer function
real(dp),intent(IN)        :: gain          ! gain applied to the transfer function
integer,intent(IN) :: node_1_in             ! controlling node number 1
integer,intent(IN) :: node_2_in             ! controlling node number 2
integer,intent(IN) :: node_1_out            ! controlled node number 1
integer,intent(IN) :: node_2_out            ! controlled node number 2
                                             
integer,intent(IN)         :: unit          ! unit to write to

! local variables

integer :: order                            ! model order

! temporary strings used to generate the component spice model 
character(len=line_length) :: string1
character(len=line_length) :: string2
character(len=line_length) :: num_list
character(len=line_length) :: den_list

character(LEN=18) :: num
character(LEN=4)  :: order_string

real(dp)        :: norm      ! normalisation constant

! START

! check that the function is valid

if (filter%a%order.GT.filter%b%order) then

  run_status='ERROR in write_Pspice_filter_model. The order of the model numerator is greater that the order of the denominator'
  CALL write_program_status()
  STOP 1
  
end if

if (filter%b%order.EQ.0) then

  run_status='ERROR in write_Pspice_filter_model. The order of the model denominator cannot be 0'
  CALL write_program_status()
  STOP 1

end if

! assemble the first line of the spice component with the node numbers

write(string1,'(A20,2I6,A12)')model_name,node_1_out,node_2_out,' Laplace {V('
CALL add_integer_to_string(string1,node_1_in,string2)
string1=trim(adjustl(string2))//','
CALL add_integer_to_string(string1,node_2_in,string2)
string1=trim(adjustl(string2))//')}='

! Keep the wnorm term in explicitly in the function definition to avoid very large or very small coefficients

! Do we have to be carefult to avoid including ' + ' before a negative coefficient? Spice model will have 'number1 + - number2'

write(unit,'(A)')trim(string1)
write(unit,'(A)')' + {('

order=filter%a%order

norm=gain*filter%a%coeff(0)

! generate the numerator function term by term, one term to each line

num_list=' '
do order=filter%a%order,0,-1

  write(order_string,'(I4)')order 
  write(num,'(E18.10)')gain*filter%a%coeff(order)    
  num_list=' + '//trim(num)
  write(num,'(E18.10)')filter%wnorm
  if (order.GT.1) then
    num_list=trim(num_list)//'*(s/'//trim(num)//')^'//trim(adjustl(order_string))
  else if (order.EQ.1) then
    num_list=trim(num_list)//'*(s/'//trim(num)//')'
  end if
! We need to include a + sign at the end of the line only if the following coefficient is positive'
  if (order.GT.0)then
    if ( (gain*filter%a%coeff(order-1)).GE.0d0 ) num_list=trim(num_list)//' +'
  end if
  write(unit,'(A)')trim(num_list)
  
end do ! next order coefficient

write(unit,'(A)')' + )/'

! generate the denominator function term by term, one term to each line

write(unit,'(A)')' + ('
do order=filter%b%order,0,-1

  write(order_string,'(I4)')order 
  write(num,'(E18.10)')filter%b%coeff(order)    
  den_list=' + '//trim(num)
  write(num,'(E18.10)')filter%wnorm
  if (order.GT.1) then
    den_list=trim(den_list)//'*(s/'//trim(num)//')^'//trim(adjustl(order_string))
  else if (order.EQ.1) then
    den_list=trim(den_list)//'*(s/'//trim(num)//')'
  end if
! We need to include a + sign at the end of the line only if the following coefficient is positive'
  if (order.GT.0) then
    if ( (filter%b%coeff(order-1)).GE.0d0 ) den_list=trim(den_list)//' +'
  end if
  write(unit,'(A)')trim(den_list)
  
end do ! next order coefficient

write(unit,'(A)')' + ) }'

END SUBROUTINE write_Pspice_filter_model

