!
! This file is part of SACAMOS, State of the Art CAble MOdels in 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-2017 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:
! MODULE cable_bundle_module
! CONTAINS
! SUBROUTINE read_cable_bundle
! SUBROUTINE write_cable_bundle
! SUBROUTINE deallocate_cable_bundle
! SUBROUTINE check_cables_wrt_ground_plane
! SUBROUTINE check_cable_intersections
!
! NAME
! MODULE cable_bundle_module
!
! Data strunctures and subroutines relating to cable bundles
!
! COMMENTS
! Need to improve error handling in file reading
! Not sure that some arrays in the type_specification need to be in this structure as they are only used in one subroutine...
!
! HISTORY
! started 25/11/2015 CJS
! stage 3 developments started 21/3/2015 CJS
! generalise conductor impedance for transfer impedance model (stage 5) CJS 12/5/2016
! CJS 25/08/2016 updates for revised transfer impedance and conductor impedance model for shields
! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
!
MODULE cable_bundle_module
USE type_specifications
USE cable_module
IMPLICIT NONE
! This is a general structure used to hold conductor based lists,
TYPE::conductor_list_type
integer :: n_elements
integer,allocatable :: element(:)
END TYPE conductor_list_type
! This is the main structure used to hold all the bundle information
TYPE::bundle_specification_type
character(LEN=line_length) :: version
character(LEN=line_length) :: bundle_name
integer :: tot_n_conductors
integer :: tot_n_shielded_conductors
integer :: tot_n_external_conductors
! dimension of the global matrix system (total number of conductors-1)
integer :: system_dimension
! cable information, total number of cables including and excluding the ground plane (if it exists)
integer :: n_cables
integer :: n_cables_without_ground_plane
! Array of cable specification data for all the cables in this bundle
type(cable_specification_type),allocatable :: cable(:)
! list of cable positions in the bundle cross section and rotation angles
real(dp),allocatable :: cable_x_offset(:)
real(dp),allocatable :: cable_y_offset(:)
real(dp),allocatable :: cable_angle(:)
! ground plane information: note we have two notations at the moment.
! This will need to be sorted out and one only adopted
logical :: ground_plane_present
real(dp) :: ground_plane_angle
real(dp) :: ground_plane_offset
real(dp) :: ground_plane_x,ground_plane_y,ground_plane_theta
real(dp) :: ground_plane_nx,ground_plane_ny
integer :: ground_plane_cable_side ! +1 if the cables are on the normal direction side of the ground plane, -1 otherwise
! domain based information
integer :: tot_n_domains
integer,allocatable :: n_conductors(:) ! number of conductors in each domain
type(conductor_list_type),allocatable :: terminal_conductor_list(:) ! external conductor number for coonductors in each domain
type(matrix),allocatable :: L(:) ! 'high frequency' inductance matrix for each domain
type(matrix),allocatable :: C(:) ! 'high frequency' capacitance matrix for each domain
type(Sfilter_matrix),allocatable :: Z(:) ! frequency dependent impedance matrix for each domain
type(Sfilter_matrix),allocatable :: Y(:) ! frequency dependent admittance matrix for each domain
! global conductor based information
type(matrix) :: global_MI ! global domain current transformation matrix
type(matrix) :: global_MV ! global domain voltage transformation matrix
type(matrix) :: global_L ! global 'high frequency' inductance matrix
type(matrix) :: global_C ! global 'high frequency' capacitance matrix
type(Sfilter_matrix) :: global_Z ! global frequency dependent impedance matrix
type(Sfilter_matrix) :: global_Y ! global frequency dependent admittance matrix
! global conductor impedance model information for each conductor
type(conductor_impedance_model),allocatable :: conductor_impedance(:)
! global conductor position in the bundle cross-section
real(dp),allocatable :: conductor_x_offset(:)
real(dp),allocatable :: conductor_y_offset(:)
! arrays for cross referecing numbering information from the global (external) conductor numbering and the domain based numbering systems
logical,allocatable :: terminal_conductor_is_shield_flag(:)
integer,allocatable :: terminal_conductor_to_inner_domain(:)
integer,allocatable :: terminal_conductor_to_outer_domain(:)
integer,allocatable :: terminal_conductor_to_global_domain_conductor(:)
integer,allocatable :: terminal_conductor_to_local_domain_conductor(:)
integer,allocatable :: terminal_conductor_to_reference_terminal_conductor(:)
! Y matrix element function fitting information for frequency dependent dielectrics
! model order for filter fitting
integer :: Y_fit_model_order
! frequency range specification
type(frequency_specification) :: Y_fit_freq_spec
character(LEN=line_length),allocatable :: conductor_label(:)
END TYPE bundle_specification_type
CONTAINS
! The following subroutines apply to all bundles and cable types
! NAME
! SUBROUTINE read_cable_bundle(unit)
!
! read cable bundle structure from a specified unit
!
! COMMENTS
!
!
! HISTORY
! started 2/12/2015 CJS
! stage 3 developments started 21/3/2015 CJS
! generalise conductor impedance for transfer impedance model (stage 5) CJS 12/5/2016
!
SUBROUTINE read_cable_bundle(bundle,file_unit)
USE type_specifications
USE constants
USE general_module
USE cable_module
USE maths
IMPLICIT NONE
! variables passed to subroutine
type(bundle_specification_type),intent(INOUT) :: bundle
integer ,intent(IN) :: file_unit
! local variables
character(len=filename_length) :: filename
logical :: file_exists
character(len=line_length) :: line
integer :: cable
integer :: n_domains
integer :: domain
integer :: matrix_dimension
integer :: n_conductors
integer :: conductor
integer :: ierr
! START
! Open the (.bundle) file to read
filename=trim(MOD_bundle_lib_dir)//trim(bundle%bundle_name)//bundle_file_extn
inquire(file=trim(filename),exist=file_exists)
if (.NOT.file_exists) then
run_status='ERROR, Cannot find the required bundle file:'//trim(filename)
CALL write_program_status()
STOP 1
end if
open(unit=file_unit,file=trim(filename))
if (verbose) write(*,*)'Opened file:',trim(filename)
! read .bundle file
read(file_unit,'(A)',ERR=9000)bundle%version
read(file_unit,'(A)',ERR=9000)bundle%bundle_name
! read cable information
read(file_unit,*,ERR=9000)bundle%n_cables_without_ground_plane
read(file_unit,*,ERR=9000)bundle%n_cables
! allocate and read cable information and cable positions in bundle
ALLOCATE( bundle%cable(1:bundle%n_cables) )
ALLOCATE( bundle%cable_x_offset(1:bundle%n_cables) )
ALLOCATE( bundle%cable_y_offset(1:bundle%n_cables) )
ALLOCATE( bundle%cable_angle(1:bundle%n_cables) )
do cable=1,bundle%n_cables_without_ground_plane
read(file_unit,'(A)')bundle%cable(cable)%cable_name
CALL read_cable(bundle%cable(cable),cable_file_unit)
read(file_unit,*,ERR=9000)bundle%cable_x_offset(cable),bundle%cable_y_offset(cable),bundle%cable_angle(cable)
! convert angle to radians
bundle%cable_angle(cable)=bundle%cable_angle(cable)*pi/180d0
end do ! next cable
! read ground plane specification
read(file_unit,'(A)',IOSTAT=ierr)line
if (ierr.NE.0) then
run_status='ERROR reading ground plane present/ absent information'
CALL write_program_status()
STOP 1
end if
CALL convert_to_lower_case(line,line_length)
bundle%ground_plane_present=(line.eq.'ground_plane')
if (bundle%ground_plane_present) then
read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_x,bundle%ground_plane_y,bundle%ground_plane_angle
read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_nx,bundle%ground_plane_ny
read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_cable_side
if (ierr.NE.0) then
run_status='ERROR reading ground plane position and angle'
CALL write_program_status()
STOP 1
end if
! convert ground plane angle to radians
bundle%ground_plane_angle=bundle%ground_plane_angle*pi/180d0
! calculate offset
bundle%ground_plane_offset=-bundle%ground_plane_x*sin(bundle%ground_plane_angle)+ &
bundle%ground_plane_y*cos(bundle%ground_plane_angle)
! set the geometric data for the last cable in the list i.e. the ground plane
cable=bundle%n_cables
bundle%cable_x_offset(cable)=bundle%ground_plane_x
bundle%cable_y_offset(cable)=bundle%ground_plane_y
bundle%cable_angle(cable)=bundle%ground_plane_angle-pi/2d0 ! note there are two ground plane spec formats at the moment...
else
! set x, y, angle and offset to 0
bundle%ground_plane_x=0d0
bundle%ground_plane_y=0d0
bundle%ground_plane_nx=0d0
bundle%ground_plane_ny=0d0
bundle%ground_plane_cable_side=0
bundle%ground_plane_angle=0d0
bundle%ground_plane_offset=0d0
end if
! read system dimension information
read(file_unit,*)bundle%tot_n_conductors
read(file_unit,*)bundle%tot_n_external_conductors
read(file_unit,*)bundle%system_dimension
! read domain information
read(file_unit,*,ERR=9000)bundle%tot_n_domains
ALLOCATE( bundle%n_conductors(1:bundle%tot_n_domains) )
ALLOCATE( bundle%L(1:bundle%tot_n_domains) )
ALLOCATE( bundle%C(1:bundle%tot_n_domains) )
ALLOCATE( bundle%Z(1:bundle%tot_n_domains))
ALLOCATE( bundle%Y(1:bundle%tot_n_domains))
ALLOCATE( bundle%terminal_conductor_list(1:bundle%tot_n_domains))
n_domains=bundle%tot_n_domains
do domain=1,bundle%tot_n_domains
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)bundle%n_conductors(domain)
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*,ERR=9000)bundle%terminal_conductor_list(domain)%n_elements
ALLOCATE( bundle%terminal_conductor_list(domain)%element(1:bundle%terminal_conductor_list(domain)%n_elements) )
do conductor=1,bundle%terminal_conductor_list(domain)%n_elements
read(file_unit,*,ERR=9000)bundle%terminal_conductor_list(domain)%element(conductor)
end do
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)matrix_dimension
bundle%L(domain)%dim=matrix_dimension
ALLOCATE( bundle%L(domain)%mat(1:matrix_dimension,1:matrix_dimension) )
CALL dread_matrix(bundle%L(domain)%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
write(*,*)'L='
CALL dwrite_matrix(bundle%L(domain)%mat,matrix_dimension,matrix_dimension,matrix_dimension,0) ! ******
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)matrix_dimension
bundle%C(domain)%dim=matrix_dimension
ALLOCATE( bundle%C(domain)%mat(1:matrix_dimension,1:matrix_dimension) )
CALL dread_matrix(bundle%C(domain)%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
write(*,*)'C='
CALL dwrite_matrix(bundle%C(domain)%mat,matrix_dimension,matrix_dimension,matrix_dimension,0) ! ******
read(file_unit,*,ERR=9000) ! comment line
CALL read_Sfilter_matrix( bundle%Z(domain),file_unit )
read(file_unit,*,ERR=9000) ! comment line
CALL read_Sfilter_matrix( bundle%Y(domain),file_unit )
end do
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)matrix_dimension
bundle%global_MI%dim=matrix_dimension
ALLOCATE( bundle%global_MI%mat(1:matrix_dimension,1:matrix_dimension) )
CALL dread_matrix(bundle%global_MI%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)matrix_dimension
bundle%global_MV%dim=matrix_dimension
ALLOCATE( bundle%global_MV%mat(1:matrix_dimension,1:matrix_dimension) )
CALL dread_matrix(bundle%global_MV%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)matrix_dimension
bundle%global_L%dim=matrix_dimension
ALLOCATE( bundle%global_L%mat(1:matrix_dimension,1:matrix_dimension) )
CALL dread_matrix(bundle%global_L%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
read(file_unit,*,ERR=9000) ! comment line
read(file_unit,*)matrix_dimension
bundle%global_C%dim=matrix_dimension
ALLOCATE( bundle%global_C%mat(1:matrix_dimension,1:matrix_dimension) )
CALL dread_matrix(bundle%global_C%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
read(file_unit,*,ERR=9000) ! comment line
CALL read_Sfilter_matrix( bundle%global_Z,file_unit )
read(file_unit,*,ERR=9000) ! comment line
CALL read_Sfilter_matrix( bundle%global_Y,file_unit )
! read the loss model information for each conductor
ALLOCATE( bundle%conductor_impedance(1:bundle%tot_n_conductors) )
read(file_unit,*) ! comment line
do conductor=1,bundle%tot_n_conductors
CALL read_conductor_impedance_model(bundle%conductor_impedance(conductor),file_unit)
end do
! read the x and y position for each conductor: this is needed for incident field excitation
ALLOCATE( bundle%conductor_x_offset(1:bundle%tot_n_conductors) )
ALLOCATE( bundle%conductor_y_offset(1:bundle%tot_n_conductors) )
read(file_unit,*) ! comment line
do conductor=1,bundle%tot_n_conductors
read(file_unit,*)bundle%conductor_x_offset(conductor),bundle%conductor_y_offset(conductor)
end do
! numbering information
read(file_unit,*) ! comment line
ALLOCATE( bundle%terminal_conductor_is_shield_flag(1:bundle%tot_n_conductors) )
ALLOCATE( bundle%terminal_conductor_to_inner_domain(1:bundle%tot_n_conductors) )
ALLOCATE( bundle%terminal_conductor_to_outer_domain(1:bundle%tot_n_conductors) )
ALLOCATE( bundle%terminal_conductor_to_global_domain_conductor(1:bundle%tot_n_conductors) )
ALLOCATE( bundle%terminal_conductor_to_local_domain_conductor(1:bundle%tot_n_conductors) )
ALLOCATE( bundle%terminal_conductor_to_reference_terminal_conductor(1:bundle%tot_n_conductors) )
do conductor=1,bundle%tot_n_conductors
read(file_unit,*)bundle%terminal_conductor_is_shield_flag(conductor), &
bundle%terminal_conductor_to_inner_domain(conductor), &
bundle%terminal_conductor_to_outer_domain(conductor), &
bundle%terminal_conductor_to_global_domain_conductor(conductor), &
bundle%terminal_conductor_to_local_domain_conductor(conductor), &
bundle%terminal_conductor_to_reference_terminal_conductor(conductor)
end do
! read the conductor labels
ALLOCATE( bundle%conductor_label(1:bundle%tot_n_conductors) )
read(file_unit,*) ! comment line
do conductor=1,bundle%tot_n_conductors
read(file_unit,'(A)')bundle%conductor_label(conductor)
end do
! close .bundle file
CLOSE(unit=file_unit)
if (verbose) write(*,*)'Closed file:',trim(filename)
RETURN
9000 run_status='ERROR reading the bundle file:'//trim(filename)
CALL write_program_status()
STOP 1
END SUBROUTINE read_cable_bundle
! NAME
! SUBROUTINE write_cable_bundle
!
! write the cable bundle structure to a specified unit
!
! COMMENTS
!
!
! HISTORY
! started 2/12/2015 CJS
! stage 3 developments started 21/3/2015 CJS
! generalise conductor impedance for transfer impedance model (stage 5) CJS 12/5/2016
!
SUBROUTINE write_cable_bundle(bundle,file_unit)
USE type_specifications
USE constants
USE general_module
USE cable_module
USE maths
IMPLICIT NONE
! variables passed to subroutine
type(bundle_specification_type),intent(INOUT) :: bundle
integer,intent(IN) :: file_unit
! local variables
character(len=filename_length) :: filename
character(len=line_length) :: line
integer :: cable
integer :: domain
integer :: matrix_dimension
integer :: conductor
integer :: n_cables_to_write
! START
! Open the output (.bundle) file
filename=trim(MOD_bundle_lib_dir)//trim(bundle%bundle_name)//bundle_file_extn
open(unit=file_unit,file=trim(filename))
! write .bundle file
write(file_unit,'(A)')trim(bundle%version)
write(file_unit,'(A)')trim(bundle%bundle_name)
write(file_unit,*)bundle%n_cables_without_ground_plane,' ! number of cables not including ground plane'
write(file_unit,*)bundle%n_cables,' ! number of cables, cable name and x y coordinates follow...'
! write cable names and coordinates
do cable=1,bundle%n_cables_without_ground_plane
write(file_unit,'(A)')trim(bundle%cable(cable)%cable_name)
write(file_unit,*)bundle%cable_x_offset(cable),bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),' x y coordinates and angle of cable '
end do ! next cable
! write ground plane specification
if (bundle%ground_plane_present) then
write(file_unit,'(A)')'ground_plane'
! note: convert angle back to degrees
write(file_unit,*)bundle%ground_plane_x,bundle%ground_plane_y,bundle%ground_plane_angle*180d0/pi, &
' x y coordinates and angle of ground plane '
write(file_unit,*)bundle%ground_plane_nx,bundle%ground_plane_ny,' ground plane normal direction'
write(file_unit,*)bundle%ground_plane_cable_side,' orientation of cables wrt ground plane'
else
write(file_unit,'(A)')'no_ground_plane'
end if
write(file_unit,*)bundle%tot_n_conductors,' # total number of conductors'
write(file_unit,*)bundle%tot_n_external_conductors,' # total number of external conductors'
write(file_unit,*)bundle%system_dimension,' # dimension of the matrix system characterising the MTL propagation'
write(file_unit,*)bundle%tot_n_domains,' # number of domains'
do domain=1,bundle%tot_n_domains
write(file_unit,*)'Domain number',domain
write(file_unit,*)bundle%n_conductors(domain),' number of conductors in this domain'
write(file_unit,*)'terminal_conductor_list'
write(file_unit,*)bundle%terminal_conductor_list(domain)%n_elements,' ! number of elements '
do conductor=1,bundle%terminal_conductor_list(domain)%n_elements
write(file_unit,*)bundle%terminal_conductor_list(domain)%element(conductor)
end do
matrix_dimension=bundle%L(domain)%dim
write(file_unit,*)'Per-Unit-length Inductance Matrix, [L]'
write(file_unit,*)matrix_dimension,' Dimension of [L]'
CALL dwrite_matrix(bundle%L(domain)%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
write(file_unit,*)'Per-Unit-length Capacitance Matrix, [C]'
write(file_unit,*)matrix_dimension,' Dimension of [C]'
CALL dwrite_matrix(bundle%C(domain)%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
write(file_unit,*)'Per-Unit-length Impedance Matrix, Z'
CALL write_Sfilter_matrix( bundle%Z(domain),file_unit )
write(file_unit,*)'Per-Unit-length Admittance Matrix, Y'
CALL write_Sfilter_matrix( bundle%Y(domain),file_unit )
end do
write(file_unit,*)'# Global current domain transformation matrix, [MI]'
matrix_dimension=bundle%global_MI%dim-1
write(file_unit,*)matrix_dimension,' Dimension of [MI]'
CALL dwrite_matrix(bundle%global_MI%mat,matrix_dimension,matrix_dimension,bundle%global_MI%dim,file_unit)
write(file_unit,*)'# Global voltage domain transformation matrix, [MV]'
matrix_dimension=bundle%global_MV%dim-1
write(file_unit,*)matrix_dimension,' Dimension of [MV]'
CALL dwrite_matrix(bundle%global_MV%mat,matrix_dimension,matrix_dimension,bundle%global_MI%dim,file_unit)
write(file_unit,*)'# Global domain based inductance matrix, [L]'
matrix_dimension=bundle%global_L%dim
write(file_unit,*)matrix_dimension,' Dimension of [L]'
CALL dwrite_matrix(bundle%global_L%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
write(file_unit,*)'# Global domain based capacitance matrix, [C]'
matrix_dimension=bundle%global_C%dim
write(file_unit,*)matrix_dimension,' Dimension of [C]'
CALL dwrite_matrix(bundle%global_C%mat,matrix_dimension,matrix_dimension,matrix_dimension,file_unit)
write(file_unit,*)'Global domain based Per-Unit-length Impedance Matrix, Z'
CALL write_Sfilter_matrix( bundle%global_Z,file_unit )
write(file_unit,*)'Global domain based Per-Unit-length Admittance Matrix, Y'
CALL write_Sfilter_matrix( bundle%global_Y,file_unit )
! write the loss model information for each conductor
write(file_unit,*)' # conductor impedance models'
do conductor=1,bundle%tot_n_conductors
CALL write_conductor_impedance_model(bundle%conductor_impedance(conductor),file_unit)
end do
! write the x and y position for each conductor: this is needed for incident field excitation
write(file_unit,*)' # conductor x y positions'
do conductor=1,bundle%tot_n_conductors
write(file_unit,*)bundle%conductor_x_offset(conductor),bundle%conductor_y_offset(conductor)
end do
! numbering information
write(file_unit,'(A)')'is_shield tc_to_in_domain tc_to_out_domain tc_to_gdc tc_to_ldc tc_to_ref_tc '
do conductor=1,bundle%tot_n_conductors
write(file_unit,8000)bundle%terminal_conductor_is_shield_flag(conductor), &
bundle%terminal_conductor_to_inner_domain(conductor), &
bundle%terminal_conductor_to_outer_domain(conductor), &
bundle%terminal_conductor_to_global_domain_conductor(conductor), &
bundle%terminal_conductor_to_local_domain_conductor(conductor), &
bundle%terminal_conductor_to_reference_terminal_conductor(conductor)
8000 format(L5,5I15)
end do
! write the conductor labels
write(file_unit,*)' # Conductor labels'
do conductor=1,bundle%tot_n_conductors
write(file_unit,*)trim(bundle%conductor_label(conductor))
end do
! close .bundle file
CLOSE(unit=file_unit)
RETURN
END SUBROUTINE write_cable_bundle
! NAME
! SUBROUTINE deallocate_cable_bundle
!
! deallocate cable_bundle structure data
!
! COMMENTS
!
!
! HISTORY
! started 2/12/2015 CJS
! generalise conductor impedance for transfer impedance model (stage 5) CJS 12/5/2016
!
SUBROUTINE deallocate_cable_bundle(bundle)
USE type_specifications
USE general_module
USE cable_module
IMPLICIT NONE
! variables passed to subroutine
type(bundle_specification_type),intent(INOUT) :: bundle
! local variables
integer :: cable
integer :: domain
integer :: conductor
! START
do cable=1,bundle%n_cables
CALL deallocate_cable(bundle%cable(cable))
end do
if (allocated(bundle%cable)) DEALLOCATE( bundle%cable )
if (allocated(bundle%cable_x_offset )) DEALLOCATE( bundle%cable_x_offset )
if (allocated(bundle%cable_y_offset )) DEALLOCATE( bundle%cable_y_offset )
if (allocated(bundle%cable_angle )) DEALLOCATE( bundle%cable_angle )
if (allocated(bundle%n_conductors )) DEALLOCATE( bundle%n_conductors )
if (allocated(bundle%terminal_conductor_list )) then
do domain=1,bundle%tot_n_domains
if (allocated(bundle%terminal_conductor_list(domain)%element )) &
DEALLOCATE( bundle%terminal_conductor_list(domain)%element )
end do
DEALLOCATE( bundle%terminal_conductor_list )
end if
if (allocated(bundle%L )) then
do domain=1,bundle%tot_n_domains
if (allocated(bundle%L(domain)%mat )) DEALLOCATE( bundle%L(domain)%mat )
end do
DEALLOCATE( bundle%L )
end if
if (allocated(bundle%C )) then
do domain=1,bundle%tot_n_domains
if (allocated(bundle%C(domain)%mat )) DEALLOCATE( bundle%C(domain)%mat )
end do
DEALLOCATE( bundle%C )
end if
if (ALLOCATED(bundle%Z)) then
do domain=1,bundle%tot_n_domains
CALL deallocate_Sfilter_matrix( bundle%Z(domain) )
end do
DEALLOCATE(bundle%Z)
end if
if (ALLOCATED(bundle%Y)) then
do domain=1,bundle%tot_n_domains
CALL deallocate_Sfilter_matrix( bundle%Y(domain) )
end do
DEALLOCATE(bundle%Y)
end if
if (allocated(bundle%global_MI%mat)) DEALLOCATE( bundle%global_MI%mat )
if (allocated(bundle%global_MV%mat)) DEALLOCATE( bundle%global_MV%mat )
if (allocated(bundle%global_L%mat)) DEALLOCATE( bundle%global_L%mat )
if (allocated(bundle%global_C%mat)) DEALLOCATE( bundle%global_C%mat )
CALL deallocate_Sfilter_matrix( bundle%global_Z )
CALL deallocate_Sfilter_matrix( bundle%global_Y )
if (ALLOCATED(bundle%conductor_impedance)) then
do conductor=1,bundle%tot_n_conductors
CALL deallocate_conductor_impedance_model(bundle%conductor_impedance(conductor))
end do
DEALLOCATE(bundle%conductor_impedance)
end if
if (ALLOCATED( bundle%conductor_x_offset )) DEALLOCATE( bundle%conductor_x_offset )
if (ALLOCATED( bundle%conductor_y_offset )) DEALLOCATE( bundle%conductor_y_offset )
! Numbering information required for transfer impedance calculation
if(ALLOCATED( bundle%terminal_conductor_is_shield_flag )) DEALLOCATE( bundle%terminal_conductor_is_shield_flag )
if(ALLOCATED( bundle%terminal_conductor_to_inner_domain )) DEALLOCATE( bundle%terminal_conductor_to_inner_domain )
if(ALLOCATED( bundle%terminal_conductor_to_outer_domain )) DEALLOCATE( bundle%terminal_conductor_to_outer_domain )
if(ALLOCATED( bundle%terminal_conductor_to_global_domain_conductor )) &
DEALLOCATE( bundle%terminal_conductor_to_global_domain_conductor )
if(ALLOCATED( bundle%terminal_conductor_to_local_domain_conductor )) &
DEALLOCATE( bundle%terminal_conductor_to_local_domain_conductor )
if(ALLOCATED( bundle%terminal_conductor_to_reference_terminal_conductor )) &
DEALLOCATE( bundle%terminal_conductor_to_reference_terminal_conductor )
if (ALLOCATED( bundle%conductor_label )) then
DEALLOCATE(bundle%conductor_label)
end if
RETURN
END SUBROUTINE deallocate_cable_bundle
!
! NAME
! SUBROUTINE check_cables_wrt_ground_plane
!
! check that the cables are all on one side of the ground plane to ensure consistency
! and indicate which side the cables are on by setting bundle%ground_plane_cable_side
!
! COMMENTS
!
!
! HISTORY
! started 29/06/2016 CJS
!
SUBROUTINE check_cables_wrt_ground_plane(bundle)
USE type_specifications
USE general_module
USE cable_module
IMPLICIT NONE
! variables passed to subroutine
type(bundle_specification_type),intent(INOUT) :: bundle
! local variables
integer :: cable
real(dp) :: norm_x,norm_y
real(dp) :: p
real(dp) :: gp_offset
real(dp) :: gp_offset_cable_1
! START
! calculate the ground plane normal direction
norm_x=bundle%ground_plane_nx
norm_y=bundle%ground_plane_ny
! The equation of the ground plane is r.norm-P=0, calculate P here
P=bundle%ground_plane_x*norm_x+bundle%ground_plane_y*norm_y
! loop over all of the cables, calculating the offset from the ground plane in the normal direction
! offset=r.norm-P, and check that all offsets have the same sign
if (verbose) then
write(*,*)'Checking the orientation of cables wrt the ground plane'
write(*,*)'GP normal:',norm_x,norm_y
write(*,*)'GP offset:',bundle%ground_plane_x+bundle%ground_plane_y
write(*,*)'P=',P
end if
do cable=1,bundle%n_cables_without_ground_plane
gp_offset=bundle%cable_x_offset(cable)*norm_x+bundle%cable_y_offset(cable)*norm_y-P
if (verbose) then
write(*,*)'Cable',cable,' offset',gp_offset
end if
if (cable.EQ.1) then
gp_offset_cable_1=gp_offset
else
! check consistency of ground plane offsets
if (gp_offset_cable_1*gp_offset.LE.0d0) then
run_status='ERROR there are cables both sides of the ground plane'
CALL write_program_status()
STOP 1
end if
end if ! cable.NE.1
end do ! next cable to check
if (gp_offset_cable_1.GT.0d0) then
bundle%ground_plane_cable_side=1
else
bundle%ground_plane_cable_side=-1
end if
RETURN
END SUBROUTINE check_cables_wrt_ground_plane
!
! NAME
! SUBROUTINE check_cable_intersections
!
! check that the cables do not intersect
! the intersection test checks intersection of the outer shape of each cable
! which is usually the outer dielectric layer apart from overshields or D connectors which
! are assumed not to have dielectric
!
! COMMENTS
! Revised to work with all cable types
!
! HISTORY
! started 8/10/2016 CJS
!
!
SUBROUTINE check_cable_intersection(bundle)
USE type_specifications
USE general_module
USE cable_module
IMPLICIT NONE
! variables passed to subroutine
type(bundle_specification_type),intent(IN) :: bundle
! local variables
integer :: cable1,cable2
integer :: nec1,nec2,ec1,ec2
integer :: shape1,shape2
integer :: type1,type2
real(dp) :: ox,oy,theta
real(dp) :: r
real(dp) :: wd,hd
integer :: nc,ncrow(2)
real(dp) :: rw,p,s,o,W(2)
integer :: npts1
real(dp),allocatable :: shape1_x(:)
real(dp),allocatable :: shape1_y(:)
integer :: npts2
real(dp),allocatable :: shape2_x(:)
real(dp),allocatable :: shape2_y(:)
logical :: intersect
logical :: intersect2
logical :: nested_1_in_2
logical :: nested_2_in_1
logical :: gp_intersect
logical :: intersection_found
! START
intersection_found=.FALSE.
! loop over cable 1
do cable1=1,bundle%n_cables_without_ground_plane
ox=bundle%cable_x_offset(cable1)
oy=bundle%cable_y_offset(cable1)
theta=bundle%cable_angle(cable1)
type1=bundle%cable(cable1)%cable_type
if ((bundle%cable(cable1)%cable_type.NE.cable_geometry_type_flex_cable).AND. &
(bundle%cable(cable1)%cable_type.NE.cable_geometry_type_ML_flex_cable) ) then
nec1=bundle%cable(cable1)%n_external_conductors
else
nec1=1
end if
! loop over the external conductors of cable 1
do ec1=1,nec1
shape1=bundle%cable(cable1)%external_model(ec1)%conductor_type
! generate a list of points on cable 1 outer surface
if (shape1.EQ.rectangle) then
wd=bundle%cable(cable1)%external_model(1)%dielectric_width
hd=bundle%cable(cable1)%external_model(1)%dielectric_height
CALL generate_rectangle_points(npts1,shape1_x,shape1_y,ox,oy,theta,wd,hd)
else if (shape1.EQ.circle) then
r=bundle%cable(cable1)%external_model(ec1)%dielectric_radius
CALL generate_circle_points(npts1,shape1_x,shape1_y,ox,oy,r)
else if (shape1.EQ.Dshape) then
nc=bundle%cable(cable1)%tot_n_conductors
rw=bundle%cable(cable1)%parameters(1)
p=bundle%cable(cable1)%parameters(2)
s=bundle%cable(cable1)%parameters(3)
o=bundle%cable(cable1)%parameters(4)
ncrow(1)=nc/2
ncrow(2)=(nc-1)-ncrow(1)
w(1)=(ncrow(1)-1)*p
w(2)=(ncrow(2)-1)*p
CALL generate_Dshape_points(npts1,shape1_x,shape1_y,ox,oy,w(1)/2d0,w(2)/2d0,s/2d0,rw+o,theta)
end if
if (bundle%ground_plane_present) then
! check for intersection of the cables with the ground plane
gp_intersect=.FALSE.
if (verbose) write(*,*)'TESTING: intersection of cable',cable1,' with the ground plane'
CALL gptest(npts1,shape1_x,shape1_y,gp_intersect)
if (gp_intersect) then
if (verbose) write(*,*)'Cable ',cable1,' intersects the ground plane'
intersection_found=.TRUE.
end if
end if
! loop over cable 2
do cable2=cable1+1,bundle%n_cables_without_ground_plane
ox=bundle%cable_x_offset(cable2)
oy=bundle%cable_y_offset(cable2)
theta=bundle%cable_angle(cable2)
type2=bundle%cable(cable2)%cable_type
if ((bundle%cable(cable1)%cable_type.NE.cable_geometry_type_flex_cable).AND. &
(bundle%cable(cable1)%cable_type.NE.cable_geometry_type_ML_flex_cable) ) then
nec2=bundle%cable(cable2)%n_external_conductors
else
nec2=1
end if
! loop over the external conductors of cable 2
do ec2=1,nec2
shape2=bundle%cable(cable2)%external_model(ec2)%conductor_type
! generate a list of points on cable 1 outer surface
if (shape2.EQ.rectangle) then
wd=bundle%cable(cable2)%external_model(1)%dielectric_width
hd=bundle%cable(cable2)%external_model(1)%dielectric_height
CALL generate_rectangle_points(npts2,shape2_x,shape2_y,ox,oy,theta,wd,hd)
else if (shape2.EQ.circle) then
r=bundle%cable(cable2)%external_model(ec2)%dielectric_radius
CALL generate_circle_points(npts2,shape2_x,shape2_y,ox,oy,r)
else if (shape2.EQ.Dshape) then
nc=bundle%cable(cable2)%tot_n_conductors
rw=bundle%cable(cable2)%parameters(1)
p=bundle%cable(cable2)%parameters(2)
s=bundle%cable(cable2)%parameters(3)
o=bundle%cable(cable2)%parameters(4)
ncrow(1)=nc/2
ncrow(2)=(nc-1)-ncrow(1)
w(1)=(ncrow(1)-1)*p
w(2)=(ncrow(2)-1)*p
CALL generate_Dshape_points(npts2,shape2_x,shape2_y,ox,oy,w(1)/2d0,w(2)/2d0,s/2d0,rw+o,theta)
end if
! assume that there is no intersection and the shapes are not nested
intersect=.FALSE.
nested_1_in_2=.FALSE.
nested_2_in_1=.FALSE.
! check for the intersection of cable 1 with cable 2 and flag if cable 1 is nested within cable 2.
if (verbose) write(*,*)'TESTING: intersection of cable',cable1,' with cable ',cable2
CALL shape_test(npts1,shape1_x,shape1_y,npts2,shape2_x,shape2_y,intersect,nested_1_in_2)
if (intersect) then
if (verbose) write(*,*)'Cable ',cable1,' intersects Cable',cable2
intersection_found=.TRUE.
end if
! Cables can only be nested if the outer cable is an overshield
if ( nested_1_in_2 ) then
if (type1.NE.cable_geometry_type_overshield) then
if (verbose) write(*,*)'Cable ',cable2,' is inside Cable',cable1
intersection_found=.TRUE.
else
if (verbose) write(*,*)'Cable ',cable2,' is OK inside Overshield Cable',cable1
end if
end if
! check for the intersection of cable 1 with cable 2 and flag if cable 1 is nested within cable 2.
if (verbose) write(*,*)'TESTING: intersection of cable',cable2,' with cable ',cable1
CALL shape_test(npts2,shape2_x,shape2_y,npts1,shape1_x,shape1_y,intersect2,nested_2_in_1)
if (intersect) then
if (verbose) write(*,*)'Cable ',cable2,' intersects Cable',cable1
intersection_found=.TRUE.
end if
! Cables can only be nested if the outer cable is an overshield
if ( nested_2_in_1 ) then
if (type2.NE.cable_geometry_type_overshield) then
if (verbose) write(*,*)'Cable ',cable1,' is inside Cable',cable2
intersection_found=.TRUE.
else
if (verbose) write(*,*)'Cable ',cable1,' is OK inside Overshield Cable',cable2
end if
end if
DEALLOCATE( shape2_x )
DEALLOCATE( shape2_y )
end do ! next external conductor of cable 2
end do ! next cable 2
DEALLOCATE( shape1_x )
DEALLOCATE( shape1_y )
end do ! next external conductor of cable1
end do ! next cable1
if (intersection_found) then
run_status='ERROR there are cables in the bundle which intersect'
CALL write_program_status()
STOP 1
end if
RETURN
END SUBROUTINE check_cable_intersection
!
! NAME
! SUBROUTINE gptest
!
! check that a cable does not intersect the ground plane
!
! COMMENTS
!
!
! HISTORY
! started 20/4/2017 CJS
!
!
SUBROUTINE gptest(npts,shape_x,shape_y,gp_intersect)
USE type_specifications
IMPLICIT NONE
integer,intent(IN) :: npts
real(dp),intent(IN) :: shape_x(npts)
real(dp),intent(IN) :: shape_y(npts)
logical,intent(OUT) :: gp_intersect
! local variables
integer :: i
! START
do i=1,npts
if (shape_y(i).LE.0D0) then
gp_intersect=.TRUE.
RETURN
end if
end do ! next point
RETURN
END SUBROUTINE gptest
!
! NAME
! SUBROUTINE shape_test
!
! check that cables do not intersect, also flag whether the first cable is nested
! i.e. lies entirely within the second
!
! COMMENTS
! We assume that the shape of the cable is convex and that the shape is closed
!
! HISTORY
! started 20/4/2017 CJS
!
!
SUBROUTINE shape_test(npts1,shape1_x,shape1_y,npts2,shape2_x,shape2_y,intersect,nested)
USE type_specifications
IMPLICIT NONE
integer,intent(IN) :: npts1
real(dp),intent(IN) :: shape1_x(npts1)
real(dp),intent(IN) :: shape1_y(npts1)
integer,intent(IN) :: npts2
real(dp),intent(IN) :: shape2_x(npts2)
real(dp),intent(IN) :: shape2_y(npts2)
logical,intent(OUT) :: intersect ! flag to indicate that shapes 1 and 2 intersect
logical,intent(OUT) :: nested ! flag to indicate shape 2 lies within shape 1
! local variables
integer :: i,j
real(dp) :: vx1,vy1
real(dp) :: vx2,vy2
real(dp) :: vp
real(dp) :: dirn
logical :: inside_point_found
logical :: outside_point_found
logical :: local_outside_point_found
! START
intersect=.FALSE.
nested=.FALSE.
inside_point_found=.FALSE.
outside_point_found=.FALSE.
! loop around test points in shape 2
do j=1,npts2
local_outside_point_found=.FALSE.
dirn=0.0 ! set to zero initially to indicate that it is not known
! loop around line segments in shape 1. Note there is one less line segment than the number of points
do i=1,npts1-1
! vector along line segment in shape 1
vx1=shape1_x(i+1)-shape1_x(i)
vy1=shape1_y(i+1)-shape1_y(i)
! vector from first point in line segment to test point
vx2=shape2_x(j)-shape1_x(i)
vy2=shape2_y(j)-shape1_y(i)
! calculate the z component of the vector product of the two vectors
vp=vx1*vy2-vx2*vy1
if (dirn.EQ.0D0) then ! maybe we need to use abs(dirn).LT.small here...
! this is the first value so this sets the direction to test for all other sets of points
dirn=vp
else
! test whether the sign of the direction has changed
if (dirn*vp.LT.0.0) then
! the signs are different then this indicates a test point outside shape 1
local_outside_point_found=.TRUE.
end if ! change in sign of direction
end if ! first test line segment.
end do ! next line segment in shape 1
if (local_outside_point_found) then
outside_point_found=.TRUE.
else
inside_point_found=.TRUE.
end if
end do ! next test point in shape 2
! work out whether we have an intersection
if (inside_point_found.AND.outside_point_found) intersect=.TRUE.
! work out whether we have a nested shape
if (inside_point_found.AND.(.NOT.outside_point_found)) nested=.TRUE.
RETURN
END SUBROUTINE
END MODULE cable_bundle_module