!
! 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 .
!
! 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 .
!
! The University of Nottingham can be contacted at: ggiemr@nottingham.ac.uk
!
! FILE CONTENTS:
!SUBROUTINE plot_bundle_cross_section
!
!
! NAME
! SUBROUTINE plot_bundle_cross_section
!
! DESCRIPTION
! This subroutine plots the cross section of the cables (conductors and dielectrics) which
! contitute a cable bundle.
!
! COMMENTS
!
!
! HISTORY
! started 2/12/2015 CJS
! 9/5/2016 CJS plot bundle cross section to jpeg file as well as the screen
! 14/6/2016 CJS Create the arrays of x and y coordinates of each conductor which are used in the incident field excitation
! 5/9/2016 CJS include additional shielded cable types with surface impedance loss models
! 20/4/2017 CJS Separate the set_conductor_positions_for_Einc process from plot_bundle_cross_section and make use of generate_shapes.F90
!
!
SUBROUTINE plot_bundle_cross_section(bundle)
USE type_specifications
USE general_module
USE constants
USE cable_module
USE cable_bundle_module
USE PUL_parameter_module
USE filter_module
USE maths
IMPLICIT NONE
! variables passed to subroutine
type(bundle_specification_type),intent(INOUT) :: bundle
! local variables
integer:: cable
real(dp) :: xmin,xmax,ymin,ymax ! the extent of the plot area
real(dp) :: xc,yc ! the centre of the plot area
real(dp) :: length ! edge length of the plot area
integer :: conductor ! counter for conductors
integer :: i ! loop counter
real(dp) :: FC_x0,FC_y0,theta ! flex cable conductor offset and rotation angle
! START
! open files for the dielectric and conductor geometry data
open(unit=dielectric_geometry_file_unit,file=dielectric_geometry_filename) ! file for dielectric geometry
open(unit=conductor_geometry_file_unit,file=conductor_geometry_filename) ! file for conductor geometry
! reset the extent of the plot area
xmin=1D30
xmax=-1D30
ymin=1D30
ymax=-1D30
! loop over the cables calling the appropriate plot routine for each cable in turn
! except for the ground plane which is done later once a scale for the goemetry has been worked out
do cable=1,bundle%n_cables
if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_cylindrical) then
CALL cylindrical_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_coax) then
CALL coax_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_twinax) then
CALL twinax_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_twisted_pair) then
CALL twisted_pair_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_shielded_twisted_pair) then
CALL shielded_twisted_pair_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_overshield) then
CALL overshield_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_spacewire) then
CALL spacewire_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_flex_cable) then
CALL flex_cable_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_dconnector) then
CALL dconnector_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
end if
end do ! read the next cable file in the bundle
! we now have the extent of the bundle so we can add the ground plane to the plot if it exists
do cable=1,bundle%n_cables
if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_ground_plane) then
! include the 'mid point' of the ground plane in the plot extent calculation
xmin=min(xmin,bundle%cable_x_offset(cable))
xmax=max(xmax,bundle%cable_x_offset(cable))
ymin=min(ymin,bundle%cable_y_offset(cable))
ymax=max(ymax,bundle%cable_y_offset(cable))
! edge length of the plot area including a bit of addional space to include some ground plane
length=2d0*max(xmax-xmin,ymax-ymin) ! length of the ground plane to plot
CALL ground_plane_plot( bundle%cable(cable), &
bundle%cable_x_offset(cable), &
bundle%cable_y_offset(cable), &
bundle%cable_angle(cable),length,xmin,xmax,ymin,ymax )
end if
end do ! read the next cable file in the bundle
! close the conductor and dielectric data files
close(unit=dielectric_geometry_file_unit)
close(unit=conductor_geometry_file_unit)
! open file for plotting the frame surrounding the bundle. The frame improves the
! look of the plot.
open(unit=frame_geometry_file_unit,file=frame_geometry_filename)
! work out the plotting area
! get the centre of the plot area
xc=(xmax+xmin)/2d0
yc=(ymax+ymin)/2d0
! edge length of the plot area including a bit of addional space to include some ground plane
length=1.5d0*max(xmax-xmin,ymax-ymin) ! edge length of the plot area
xmin=xc-length/2d0
xmax=xc+length/2d0
ymin=yc-length/2d0
ymax=yc+length/2d0
! write the frame coordinates to file
write(frame_geometry_file_unit,*)xmin,ymin
write(frame_geometry_file_unit,*)xmin,ymax
write(frame_geometry_file_unit,*)xmax,ymax
write(frame_geometry_file_unit,*)xmax,ymin
write(frame_geometry_file_unit,*)xmin,ymin
close(unit=frame_geometry_file_unit)
END SUBROUTINE plot_bundle_cross_section