Commit 44c11f06bad21a8b0e1bf76d968102ea52580a6e

Authored by Chris Smartt
1 parent 5f44abed

Include software updates for infinite ground plane model, new flex cable and ite…

…rative solver in Laplace'
Showing 32 changed files with 2229 additions and 187 deletions   Show diff stats
SRC/BUNDLE_DOMAIN_CREATION/create_global_domain_structure.F90
... ... @@ -72,6 +72,7 @@
72 72 ! so that we can work out the is_shield flag properly in all circumstances.
73 73 ! 18/10/2017 CJS: include 8b. Copy the cable based conductor labels to the bundle structure
74 74 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
  75 +! 16/3/2018 CJS add y offset for ML_flex_cable
75 76 !
76 77  
77 78 SUBROUTINE create_global_domain_structure(bundle)
... ... @@ -994,7 +995,8 @@ USE maths
994 995 PUL%y(conductor)=bundle%cable_y_offset(cable)
995 996 PUL%rtheta(conductor)=bundle%cable_angle(cable)
996 997  
997   - PUL%o(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_ox
  998 + PUL%ox(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_ox
  999 + PUL%oy(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_oy
998 1000 PUL%r(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_radius
999 1001 PUL%rw(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_width
1000 1002 PUL%rw2(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_width2
... ... @@ -1002,7 +1004,8 @@ USE maths
1002 1004 PUL%rd(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_radius
1003 1005 PUL%rdw(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_width
1004 1006 PUL%rdh(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_height
1005   - PUL%rdo(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_ox
  1007 + PUL%rdox(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_ox
  1008 + PUL%rdoy(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_oy
1006 1009 PUL%epsr(conductor)=bundle%cable(cable)%external_model(local_conductor)%dielectric_epsr
1007 1010  
1008 1011 end if ! not a ground plane
... ...
SRC/BUNDLE_DOMAIN_CREATION/plot_bundle_cross_section.F90
... ... @@ -45,7 +45,7 @@
45 45 ! 14/6/2016 CJS Create the arrays of x and y coordinates of each conductor which are used in the incident field excitation
46 46 ! 5/9/2016 CJS include additional shielded cable types with surface impedance loss models
47 47 ! 20/4/2017 CJS Separate the set_conductor_positions_for_Einc process from plot_bundle_cross_section and make use of generate_shapes.F90
48   -!
  48 +! 16/3/2018 CJS plot ML_flex_cable
49 49 !
50 50  
51 51 SUBROUTINE plot_bundle_cross_section(bundle)
... ... @@ -151,6 +151,13 @@ USE maths
151 151 bundle%cable_x_offset(cable), &
152 152 bundle%cable_y_offset(cable), &
153 153 bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
  154 +
  155 + else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_ML_flex_cable) then
  156 +
  157 + CALL ML_flex_cable_plot( bundle%cable(cable), &
  158 + bundle%cable_x_offset(cable), &
  159 + bundle%cable_y_offset(cable), &
  160 + bundle%cable_angle(cable),xmin,xmax,ymin,ymax )
154 161  
155 162 else if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_dconnector) then
156 163  
... ...
SRC/BUNDLE_DOMAIN_CREATION/set_conductor_positions_for_Einc.F90
... ... @@ -46,7 +46,7 @@
46 46 ! 14/6/2016 CJS Create the arrays of x and y coordinates of each conductor which are used in the incident field excitation
47 47 ! 5/9/2016 CJS include additional shielded cable types with surface impedance loss models
48 48 ! 20/4/2017 CJS Separate the set_conductor_positions_for_Einc process from plot_bundle_cross_section
49   -!
  49 +! 16/3/2018 CJS add y offset for ML_flex_cable
50 50 !
51 51  
52 52 SUBROUTINE set_conductor_positions_for_Einc(bundle)
... ... @@ -98,7 +98,8 @@ USE maths
98 98 do cable=1,bundle%n_cables
99 99  
100 100 ! loop over the conductors in the cable
101   - if (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_flex_cable) then
  101 + if ((bundle%cable(cable)%cable_type.EQ.cable_geometry_type_flex_cable).OR. &
  102 + (bundle%cable(cable)%cable_type.EQ.cable_geometry_type_ML_flex_cable) ) then
102 103  
103 104 ! We include a fix here for flex cables which have to have their conductor offsets calculated here
104 105 ! work out the centre of this conductor before rotation
... ... @@ -107,7 +108,7 @@ USE maths
107 108  
108 109 do i=1,bundle%cable(cable)%tot_n_conductors
109 110 FC_x0=bundle%cable(cable)%external_model(i)%conductor_ox
110   - FC_y0=0.0
  111 + FC_y0=bundle%cable(cable)%external_model(i)%conductor_oy
111 112 ! work out the centre of this conductor when the flex cable is rotated and offset
112 113 conductor=conductor+1
113 114 bundle%conductor_x_offset(conductor)=FC_x0*cos(theta)-FC_y0*sin(theta)+bundle%cable_x_offset(cable)
... ...
SRC/CABLE_BUNDLE_MODULES/cable_bundle_module.F90
... ... @@ -892,7 +892,8 @@ CONTAINS
892 892 theta=bundle%cable_angle(cable1)
893 893 type1=bundle%cable(cable1)%cable_type
894 894  
895   - if (bundle%cable(cable1)%cable_type.NE.cable_geometry_type_flex_cable) then
  895 + if ((bundle%cable(cable1)%cable_type.NE.cable_geometry_type_flex_cable).AND. &
  896 + (bundle%cable(cable1)%cable_type.NE.cable_geometry_type_ML_flex_cable) ) then
896 897 nec1=bundle%cable(cable1)%n_external_conductors
897 898 else
898 899 nec1=1
... ... @@ -953,7 +954,8 @@ CONTAINS
953 954 theta=bundle%cable_angle(cable2)
954 955 type2=bundle%cable(cable2)%cable_type
955 956  
956   - if (bundle%cable(cable2)%cable_type.NE.cable_geometry_type_flex_cable) then
  957 + if ((bundle%cable(cable1)%cable_type.NE.cable_geometry_type_flex_cable).AND. &
  958 + (bundle%cable(cable1)%cable_type.NE.cable_geometry_type_ML_flex_cable) ) then
957 959 nec2=bundle%cable(cable2)%n_external_conductors
958 960 else
959 961 nec2=1
... ...
SRC/CABLE_MODULES/ML_flex_cable.F90 0 → 100644
... ... @@ -0,0 +1,471 @@
  1 +!
  2 +! This file is part of SACAMOS, State of the Art CAble MOdels in Spice.
  3 +! It was developed by the University of Nottingham and the Netherlands Aerospace
  4 +! Centre (NLR) for ESA under contract number 4000112765/14/NL/HK.
  5 +!
  6 +! Copyright (C) 2016-2017 University of Nottingham
  7 +!
  8 +! SACAMOS is free software: you can redistribute it and/or modify it under the
  9 +! terms of the GNU General Public License as published by the Free Software
  10 +! Foundation, either version 3 of the License, or (at your option) any later
  11 +! version.
  12 +!
  13 +! SACAMOS is distributed in the hope that it will be useful, but
  14 +! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  15 +! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  16 +! for more details.
  17 +!
  18 +! A copy of the GNU General Public License version 3 can be found in the
  19 +! file GNU_GPL_v3 in the root or at <http://www.gnu.org/licenses/>.
  20 +!
  21 +! SACAMOS uses the EISPACK library (in /SRC/EISPACK). EISPACK is subject to
  22 +! the GNU Lesser General Public License. A copy of the GNU Lesser General Public
  23 +! License version can be found in the file GNU_LGPL in the root of EISPACK
  24 +! (/SRC/EISPACK ) or at <http://www.gnu.org/licenses/>.
  25 +!
  26 +! The University of Nottingham can be contacted at: ggiemr@nottingham.ac.uk
  27 +!
  28 +! File Contents:
  29 +! SUBROUTINE ML_flex_cable_set_parameters
  30 +! SUBROUTINE ML_flex_cable_set_internal_domain_information
  31 +! SUBROUTINE ML_flex_cable_plot
  32 +!
  33 +! NAME
  34 +! ML_flex_cable_set_parameters
  35 +!
  36 +! AUTHORS
  37 +! Chris Smartt
  38 +!
  39 +! DESCRIPTION
  40 +! Set the overall parameters for a ML_flex_cable cable
  41 +!
  42 +! COMMENTS
  43 +!
  44 +!
  45 +! HISTORY
  46 +!
  47 +! started 26/9/2016 CJS
  48 +! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
  49 +!
  50 +!
  51 +SUBROUTINE ML_flex_cable_set_parameters(cable)
  52 +
  53 +USE type_specifications
  54 +
  55 +IMPLICIT NONE
  56 +
  57 +! variables passed to subroutine
  58 +
  59 + type(cable_specification_type),intent(INOUT) :: cable
  60 +
  61 +! local variables
  62 +
  63 +! START
  64 +
  65 + cable%cable_type=cable_geometry_type_ML_flex_cable
  66 + cable%tot_n_conductors=0 ! this is set in the cable specification file
  67 + cable%tot_n_domains=1
  68 + cable%n_external_conductors=0 ! this is set in the cable specification file
  69 + cable%n_internal_conductors=0
  70 + cable%n_internal_domains=0
  71 + cable%n_parameters=0
  72 + cable%n_dielectric_filters=1
  73 + cable%n_transfer_impedance_models=0
  74 +
  75 +END SUBROUTINE ML_flex_cable_set_parameters
  76 +!
  77 +! NAME
  78 +! ML_flex_cable_set_internal_domain_information
  79 +!
  80 +! AUTHORS
  81 +! Chris Smartt
  82 +!
  83 +! DESCRIPTION
  84 +! Set the overall parameters for a ML_flex_cable cable
  85 +!
  86 +! COMMENTS
  87 +! Set the dimension of the domain transformation matrices to include an external reference conductor for the cable
  88 +!
  89 +!
  90 +! HISTORY
  91 +!
  92 +! started 13/4/2016 CJS
  93 +! 8/5/2017 CJS: Include references to Theory_Manual
  94 +!
  95 +!
  96 +SUBROUTINE ML_flex_cable_set_internal_domain_information(cable)
  97 +
  98 +USE type_specifications
  99 +USE general_module
  100 +USE constants
  101 +
  102 +IMPLICIT NONE
  103 +
  104 +! variables passed to subroutine
  105 +
  106 + type(cable_specification_type),intent(INOUT) :: cable
  107 +
  108 +! local variables
  109 +
  110 + integer :: nc
  111 + integer :: dim
  112 + integer :: i,prow,prow2,row2,row,col,conductivity_row
  113 +
  114 + real(dp) :: full_width,ML_flex_cable_xmin
  115 +
  116 +! variables for cable parameter checks
  117 + logical :: cable_spec_error
  118 + real(dp) :: wd ! dielectric width
  119 + real(dp) :: hd ! dielectric height
  120 + integer :: nrows ! number of rows of conductors
  121 +
  122 + real(dp) :: w ! conductor width
  123 + real(dp) :: h ! conductor height
  124 + real(dp) :: s ! conductor separation
  125 + real(dp) :: ox ! conductor offset x
  126 + real(dp) :: oy ! conductor offset y
  127 + integer :: ncrow ! number of conductors in this row
  128 + integer :: conductor ! counter for conductors
  129 +
  130 + real(dp) :: w1,h1,w2,h2,ox1,ox2,oy1,oy2
  131 +
  132 + real(dp) :: sigma
  133 +
  134 + type(Sfilter) :: epsr
  135 +
  136 + integer :: nclocal
  137 +
  138 + character(LEN=error_message_length) :: message
  139 +
  140 + character(LEN=2) :: conductor_string
  141 +
  142 + integer :: check_type
  143 +
  144 +! START
  145 +
  146 + nc=cable%tot_n_conductors
  147 +
  148 +! set the information related ot the number of conductors
  149 +
  150 + cable%n_external_conductors=nc
  151 +
  152 +! Set the domain decomposition matrices ! Theory_Manual_Eqn 6.17, 6.18
  153 +
  154 +! The dimension of the domain transformation matrices is the number of conductors+1
  155 + dim=nc+1
  156 +
  157 + cable%MI%dim=dim
  158 + ALLOCATE(cable%MI%mat(dim,dim))
  159 + cable%MI%mat(:,:)=0d0
  160 +
  161 + cable%MV%dim=dim
  162 + ALLOCATE(cable%MV%mat(dim,dim))
  163 + cable%MV%mat(:,:)=0d0
  164 +
  165 + do i=1,nc
  166 + row=i
  167 + col=row
  168 + cable%MI%mat(row,col)=1d0
  169 + end do
  170 + do i=1,dim
  171 + row=dim
  172 + col=i
  173 + cable%MI%mat(row,col)=1d0
  174 + end do
  175 +
  176 + do i=1,nc
  177 + row=i
  178 + col=row
  179 + cable%MV%mat(row,col)=1d0
  180 + cable%MV%mat(row,dim)=-1d0
  181 + end do
  182 + cable%MV%mat(dim,dim)=1d0
  183 +
  184 +! Set the local reference conductor numbering
  185 + ALLOCATE( cable%local_reference_conductor(nc) )
  186 + cable%local_reference_conductor(1:nc)=0 ! external domain conductor, reference not known
  187 +
  188 +! Set the local domain information: include a reference conductor in the count
  189 + ALLOCATE( cable%local_domain_n_conductors(1:cable%tot_n_domains) )
  190 + cable%local_domain_n_conductors(1)=nc+1 ! external domain
  191 +
  192 +! Read the parameter list and set the conductor information
  193 +
  194 + nrows=NINT(cable%parameters(3))
  195 +
  196 +! check that the number of conductors is consistent
  197 + prow=3
  198 + nclocal=0
  199 +
  200 + do row=1,nrows ! loop over rows of conductors
  201 +
  202 + ncrow=NINT(cable%parameters(prow+6))
  203 + nclocal=nclocal+ncrow
  204 + prow=prow+6
  205 +
  206 + end do ! next row of conductors
  207 +
  208 +! check that the number of conductors is consistent
  209 + if (nclocal.NE.nc) then
  210 + write(message,*)' Nc in .cable file=',nc,' conductor count=',nclocal
  211 + run_status='ERROR in cable_model_builder, inconsistent conductor count for flex_cable:' &
  212 + //trim(cable%cable_name)//'. '//trim(message)
  213 + CALL write_program_status()
  214 + STOP 1
  215 + end if
  216 +
  217 +! conductivity for the conductor loss models
  218 + conductivity_row=prow+1
  219 + sigma=cable%parameters(conductivity_row) ! conductivity
  220 +
  221 + ALLOCATE( cable%external_model(cable%n_external_conductors) )
  222 +
  223 + prow=3
  224 + conductor=0 ! reset the conductor count
  225 +
  226 + do row=1,nrows ! loop over rows of conductors
  227 +
  228 +! get the parameters for this row of conductors
  229 + ox=cable%parameters(prow+1) ! conductor offset in x
  230 + oy=cable%parameters(prow+2) ! conductor offset in y
  231 + w=cable%parameters(prow+3) ! conductor width
  232 + h=cable%parameters(prow+4) ! conductor height
  233 + s=cable%parameters(prow+5) ! conductor separation
  234 + ncrow=NINT(cable%parameters(prow+6))
  235 +
  236 + full_width=w*ncrow+s*(ncrow-1)
  237 + ML_flex_cable_xmin=-full_width/2d0
  238 +
  239 + do i=1,ncrow ! loop over the conductors in this row
  240 +
  241 + conductor=conductor+1
  242 +
  243 +! set the conductor impedance model for this conductor
  244 + cable%conductor_impedance(conductor)%impedance_model_type=impedance_model_type_rectangular_with_conductivity
  245 + cable%conductor_impedance(conductor)%width=w
  246 + cable%conductor_impedance(conductor)%height=h
  247 + cable%conductor_impedance(conductor)%conductivity=sigma
  248 +
  249 +! Set the external domain conductor information
  250 +
  251 + CALL reset_external_conductor_model(cable%external_model(conductor))
  252 + cable%external_model(conductor)%conductor_type=rectangle
  253 + cable%external_model(conductor)%conductor_width=w
  254 + cable%external_model(conductor)%conductor_width2=w
  255 + cable%external_model(conductor)%conductor_height=h
  256 +
  257 +! work out the offset of the ith conductor
  258 + cable%external_model(conductor)%conductor_ox=ox+ML_flex_cable_xmin+(w+s)*(i-1)+w/2d0
  259 + cable%external_model(conductor)%conductor_oy=oy
  260 +
  261 + end do ! next conductor in this row
  262 +
  263 + prow=prow+6
  264 +
  265 + end do ! next row of conductors
  266 +
  267 +! dielectric data
  268 +
  269 + epsr=cable%dielectric_filter(1)
  270 + wd=cable%parameters(1) ! dielectric width
  271 + hd=cable%parameters(2) ! dielectric height
  272 +
  273 +! do some consistency checks
  274 + cable_spec_error=.FALSE. ! assume no errors initially
  275 + message=''
  276 +
  277 +! Do some intersection checks on the flex cable
  278 +
  279 + prow=3
  280 + do row=1,nrows ! loop over rows of conductors
  281 +
  282 +! get the parameters for this row of conductors
  283 + ox1=cable%parameters(prow+1) ! conductor offset in x
  284 + oy1=cable%parameters(prow+2) ! conductor offset in y
  285 + w=cable%parameters(prow+3) ! conductor width
  286 + h1=cable%parameters(prow+4) ! conductor height
  287 + s=cable%parameters(prow+5) ! conductor separation
  288 + ncrow=NINT(cable%parameters(prow+6))
  289 +
  290 + w1=w*ncrow+s*(ncrow-1) ! w1 is the full width of the row of conductors
  291 +
  292 +! check whether this row of conductors is well specified - conductor width, height and spearation >0
  293 + CALL flex_cable_check(ncrow,w,h1,s,0d0,0d0,cable_spec_error,cable%cable_name,message)
  294 +
  295 + if (cable_spec_error) then
  296 + run_status='ERROR in cable_model_builder, error on parameters for cable:'//trim(cable%cable_name)//'. '//trim(message)
  297 + CALL write_program_status()
  298 + STOP 1
  299 + end if
  300 +
  301 +! check whether this row of conductors intersects the dielectric boundary of the flex cable
  302 + check_type=2
  303 + CALL ML_flex_cable_check(w1,h1,ox1,oy1,wd,hd,0d0,0d0,check_type,cable_spec_error,cable%cable_name,message)
  304 +
  305 + if (cable_spec_error) then
  306 + run_status='ERROR in cable_model_builder, error on parameters for cable:'//trim(cable%cable_name)//'. '//trim(message)
  307 + CALL write_program_status()
  308 + STOP 1
  309 + end if
  310 +
  311 +! loop over all the other rows to check for intersections between the rows of conductors
  312 +
  313 + prow=prow+6
  314 +
  315 + prow2=prow
  316 +
  317 + do row2=row+1,nrows
  318 +
  319 +! get the parameters for this row of conductors
  320 + ox2=cable%parameters(prow2+1) ! conductor offset in x
  321 + oy2=cable%parameters(prow2+2) ! conductor offset in y
  322 + w=cable%parameters(prow2+3) ! conductor width
  323 + h2=cable%parameters(prow2+4) ! conductor height
  324 + s=cable%parameters(prow2+5) ! conductor separation
  325 + ncrow=NINT(cable%parameters(prow2+6))
  326 +
  327 + w2=w*ncrow+s*(ncrow-1) ! w2 is the full width of the second row of conductors
  328 +
  329 +
  330 +! check whether the two rows of conductors intersect
  331 + check_type=1
  332 + CALL ML_flex_cable_check(w1,h1,ox1,oy1,w2,h2,ox2,oy2,check_type,cable_spec_error,cable%cable_name,message)
  333 +
  334 + if (cable_spec_error) then
  335 + run_status='ERROR in cable_model_builder, error on parameters for cable:'//trim(cable%cable_name)//'. '//trim(message)
  336 + CALL write_program_status()
  337 + STOP 1
  338 + end if
  339 +
  340 + prow2=prow2+6
  341 +
  342 + end do ! next row2 for checking intersection between rows of conductors
  343 +
  344 + end do ! next row of conductors to check
  345 +
  346 + CALL dielectric_check(epsr,cable_spec_error,cable%cable_name,message)
  347 +
  348 + if (cable_spec_error) then
  349 + run_status='ERROR in cable_model_builder, error on parameters for cable:'//trim(cable%cable_name)//'. '//trim(message)
  350 + CALL write_program_status()
  351 + STOP 1
  352 + end if
  353 +
  354 +! add a dielectric region to the first conductor which encloses the whole cable
  355 +
  356 +! write the dielectric which is offset from the conductors
  357 +! The dielectric is centred at the cable centre
  358 +
  359 + cable%external_model(1)%dielectric_width=wd
  360 + cable%external_model(1)%dielectric_height=hd
  361 + cable%external_model(1)%dielectric_ox=0d0
  362 + cable%external_model(1)%dielectric_oy=0d0
  363 + cable%external_model(1)%dielectric_epsr=epsr
  364 +
  365 + CALL deallocate_Sfilter(epsr)
  366 +
  367 + ALLOCATE( cable%conductor_label(1:cable%tot_n_conductors) )
  368 + do i=1,cable%tot_n_conductors
  369 + write(conductor_string,'(I2)')i
  370 + cable%conductor_label(i)='Cable name: '//trim(cable%cable_name)// &
  371 + '. type: '//trim(cable%cable_type_string)//'. conductor '//conductor_string//' : ML_flex_cable conductor'
  372 + end do
  373 +
  374 +END SUBROUTINE ML_flex_cable_set_internal_domain_information
  375 +!
  376 +! NAME
  377 +! ML_flex_cable_plot
  378 +!
  379 +! AUTHORS
  380 +! Chris Smartt
  381 +!
  382 +! DESCRIPTION
  383 +! plot ML_flex_cable cable
  384 +!
  385 +! COMMENTS
  386 +!
  387 +!
  388 +! HISTORY
  389 +!
  390 +! started 23/9/2016 CJS
  391 +!
  392 +!
  393 +SUBROUTINE ML_flex_cable_plot(cable,x_offset,y_offset,theta,xmin,xmax,ymin,ymax)
  394 +
  395 +USE type_specifications
  396 +USE general_module
  397 +
  398 +IMPLICIT NONE
  399 +
  400 +! variables passed to subroutine
  401 +
  402 + type(cable_specification_type),intent(IN) :: cable
  403 +
  404 + real(dp),intent(IN) :: x_offset,y_offset,theta
  405 + real(dp),intent(INOUT) :: xmin,xmax,ymin,ymax
  406 +
  407 +! local variables
  408 +
  409 + integer nc
  410 +
  411 + real(dp) :: full_width,ML_flex_cable_xmin
  412 + real(dp) :: xoff,yoff,x,y,w,h,s,wd,hd,ox,oy
  413 +
  414 + integer nrows,ncrow,row,prow
  415 + integer i
  416 +
  417 +! START
  418 +
  419 +! plot ML_flex_cable conductor
  420 +
  421 + nc=cable%tot_n_conductors
  422 +
  423 + nrows=NINT(cable%parameters(3))
  424 +
  425 + prow=3
  426 +
  427 + do row=1,nrows ! loop over rows of conductors
  428 +
  429 +! get the parameters for this row of conductors
  430 + ox=cable%parameters(prow+1) ! conductor offset in x
  431 + oy=cable%parameters(prow+2) ! conductor offset in y
  432 + w=cable%parameters(prow+3) ! conductor width
  433 + h=cable%parameters(prow+4) ! conductor height
  434 + s=cable%parameters(prow+5) ! conductor separation
  435 + ncrow=NINT(cable%parameters(prow+6))
  436 +
  437 + full_width=w*ncrow+s*(ncrow-1)
  438 + ML_flex_cable_xmin=-full_width/2d0
  439 +
  440 + do i=1,ncrow ! loop over the conductors in this row
  441 +
  442 +! work out the centre of this conductor before rotation
  443 + xoff=ox+ML_flex_cable_xmin+(w+s)*(i-1)+w/2d0
  444 + yoff=oy
  445 +
  446 +! work out the centre of this conductor when the flex cable is rotated and offset
  447 + x=x_offset+xoff*cos(theta)-yoff*sin(theta)
  448 + y=y_offset+xoff*sin(theta)+yoff*cos(theta)
  449 +
  450 +! write the conductor
  451 + CALL write_rectangle(x,y,w,h,theta,conductor_geometry_file_unit,xmin,xmax,ymin,ymax)
  452 +
  453 + end do ! next conductor in this row
  454 +
  455 + prow=prow+6
  456 +
  457 + end do ! next row of conductors
  458 +
  459 +! write the dielectric which is offset from the conductors
  460 +
  461 + wd=cable%external_model(1)%dielectric_width
  462 + hd=cable%external_model(1)%dielectric_height
  463 + CALL write_rectangle(x_offset,y_offset,wd,hd,theta,dielectric_geometry_file_unit,xmin,xmax,ymin,ymax)
  464 +
  465 + RETURN
  466 +
  467 +END SUBROUTINE ML_flex_cable_plot
  468 +
  469 +
  470 +
  471 +
... ...
SRC/CABLE_MODULES/Makefile
... ... @@ -8,6 +8,7 @@ $(OBJ_MOD_DIR)/cable_module.o: cable_module.F90 $(TYPE_SPEC_MODULE) $(GENERAL_M
8 8 twinax.F90 \
9 9 spacewire.F90 \
10 10 flex_cable.F90 \
  11 + ML_flex_cable.F90 \
11 12 Dconnector.F90 \
12 13 overshield.F90 \
13 14 ground_plane.F90 \
... ...
SRC/CABLE_MODULES/cable_checks.F90
... ... @@ -627,6 +627,142 @@ RETURN
627 627 END SUBROUTINE flex_cable_check
628 628 !
629 629 ! NAME
  630 +! ML_flex_cable_check
  631 +!
  632 +! AUTHORS
  633 +! Chris Smartt
  634 +!
  635 +! DESCRIPTION
  636 +! check that the parameters defining a multi-layer flex cable are consistent
  637 +! This check takes the width, height and offset of two rectangles and checks whether they intersect
  638 +! It is used for checking intersection of rows of conductors and conducotrs and dielectric in flex cable models
  639 +! If the check fails the cable_spec_error flag is set on return, otherwise it is left unchanged
  640 +!
  641 +! COMMENTS
  642 +!
  643 +!
  644 +! HISTORY
  645 +!
  646 +!
  647 +! started 12/6/2018 CJS, based on flex_cable_check
  648 +!
  649 +!
  650 +SUBROUTINE ML_flex_cable_check(w1,h1,ox1,oy1,w2,h2,ox2,oy2,check_type,cable_spec_error,cable_name,message)
  651 +
  652 + real(dp),intent(IN) :: w1,h1
  653 + real(dp),intent(IN) :: ox1,oy1
  654 + real(dp),intent(IN) :: w2,h2
  655 + real(dp),intent(IN) :: ox2,oy2
  656 +
  657 + integer,intent(IN) :: check_type
  658 +
  659 + logical,intent(INOUT) :: cable_spec_error
  660 +
  661 + character(LEN=line_length),intent(IN) :: cable_name
  662 + character(LEN=error_message_length),intent(INOUT) :: message
  663 +
  664 +! local variables
  665 +
  666 +logical :: intersect,internal
  667 +
  668 +real(dp) :: p1,p2,p3,p4
  669 +logical :: internalp3,internalp4
  670 +
  671 +logical :: intersectx,internalx,externalx
  672 +logical :: intersecty,internaly,externaly
  673 +
  674 +! START
  675 +
  676 +if (cable_spec_error) RETURN ! return if an error has already been flagged
  677 +
  678 +intersect=.FALSE.
  679 +internal=.FALSE.
  680 +intersectx=.FALSE.
  681 +internalx=.FALSE.
  682 +externalx=.FALSE.
  683 +intersecty=.FALSE.
  684 +internaly=.FALSE.
  685 +externaly=.FALSE.
  686 +
  687 +p1=ox1-w1/2.0
  688 +p2=ox1+w1/2.0
  689 +p3=ox2-w2/2.0
  690 +p4=ox2+w2/2.0
  691 +
  692 +internalp3=.FALSE.
  693 +internalp4=.FALSE.
  694 +
  695 +if ((p3.GE.p1).AND.(p3.LE.p2)) internalp3=.TRUE.
  696 +if ((p4.GE.p1).AND.(p4.LE.p2)) internalp4=.TRUE.
  697 +
  698 +if (internalp3.AND.internalp4) then
  699 + intersectx=.TRUE.
  700 + internalx=.TRUE. ! rectangle 2 is inside rectangel1
  701 +else if (internalp3.OR.internalp4) then
  702 + intersectx=.TRUE.
  703 + internalx=.FALSE.
  704 +else
  705 +! p3 and p4 are outside the p1-p2 range, we now nead to decide if p1-p2 is inside the range p3-p4
  706 + if ((p3.LT.p1).AND.(p4.GT.p2)) then
  707 + intersectx=.TRUE.
  708 + externalx=.TRUE. ! rectangle 2 is outside rectangel1
  709 + end if
  710 +end if
  711 +
  712 +p1=oy1-h1/2.0
  713 +p2=oy1+h1/2.0
  714 +p3=oy2-h2/2.0
  715 +p4=oy2+h2/2.0
  716 +
  717 +internalp3=.FALSE.
  718 +internalp4=.FALSE.
  719 +
  720 +if ((p3.GE.p1).AND.(p3.LE.p2)) internalp3=.TRUE.
  721 +if ((p4.GE.p1).AND.(p4.LE.p2)) internalp4=.TRUE.
  722 +
  723 +if (internalp3.AND.internalp4) then
  724 + intersecty=.TRUE.
  725 + internaly=.TRUE. ! rectangle 2 is inside rectangel1
  726 +else if (internalp3.OR.internalp4) then
  727 + intersecty=.TRUE.
  728 + internaly=.FALSE.
  729 +else
  730 +! p3 and p4 are outside the p1-p2 range, we now nead to decide if p1-p2 is inside the range p3-p4
  731 + if ((p3.LT.p1).AND.(p4.GT.p2)) then
  732 + intersecty=.TRUE.
  733 + externaly=.TRUE. ! rectangle 2 is outside rectangel1
  734 + end if
  735 +end if
  736 +
  737 +if (intersectx.AND.intersecty) intersect=.TRUE.
  738 +if (internalx.AND.internaly) internal=.TRUE.
  739 +if (externalx.AND.externaly) internal=.TRUE. ! rectangle 2 is outside rectangel1
  740 +
  741 +if ( (check_type.EQ.1).AND.(intersect) ) then
  742 +! we are checking conductor intersections
  743 + write(*,*)'Error in cable:',trim(cable_name)
  744 + message='conductors intersect'
  745 + write(*,'(A)')trim(message)
  746 + cable_spec_error=.TRUE.
  747 + RETURN
  748 +
  749 +end if
  750 +
  751 +! this is the chek for dielectrc being outside the condustor row, the dielectric is shape 2 when
  752 +! the subroutine is called
  753 +if ( (check_type.EQ.2).AND.( .NOT.(externalx.AND.externaly) ) ) then
  754 + write(*,*)'Error in cable:',trim(cable_name)
  755 + message='Dielectric intersects conductors'
  756 + write(*,'(A)')trim(message)
  757 + cable_spec_error=.TRUE.
  758 + RETURN
  759 +end if
  760 +
  761 +RETURN
  762 +
  763 +END SUBROUTINE ML_flex_cable_check
  764 +!
  765 +! NAME
630 766 ! dielectric_check
631 767 !
632 768 ! AUTHORS
... ...
SRC/CABLE_MODULES/cable_module.F90
... ... @@ -92,6 +92,10 @@
92 92 ! flex_cable.F90: SUBROUTINE flex_cable_set_internal_domain_information
93 93 ! flex_cable.F90: SUBROUTINE flex_cable_plot
94 94 !
  95 +! ML_flex_cable.F90: SUBROUTINE ML_flex_cable_set_parameters
  96 +! ML_flex_cable.F90: SUBROUTINE ML_flex_cable_set_internal_domain_information
  97 +! ML_flex_cable.F90: SUBROUTINE ML_flex_cable_plot
  98 +!
95 99 ! Dconnector.F90: SUBROUTINE Dconnector_set_parameters
96 100 ! Dconnector.F90: SUBROUTINE Dconnector_set_internal_domain_information
97 101 ! Dconnector.F90: SUBROUTINE Dconnector_plot
... ... @@ -120,6 +124,7 @@
120 124 ! Include general conductor impedance model 12/05/2016 CJS
121 125 ! put the external condcutor model information into its own structure 6/10/2016 CJS
122 126 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
  127 +! 16/3/2018 CJS Add ML_flex_cable
123 128 !
124 129 MODULE cable_module
125 130  
... ... @@ -171,10 +176,12 @@ TYPE:: external_conductor_model
171 176 real(dp) :: conductor_width2
172 177 real(dp) :: conductor_height
173 178 real(dp) :: conductor_ox
  179 + real(dp) :: conductor_oy
174 180 real(dp) :: dielectric_radius
175 181 real(dp) :: dielectric_width
176 182 real(dp) :: dielectric_height
177 183 real(dp) :: dielectric_ox
  184 + real(dp) :: dielectric_oy
178 185 type(Sfilter) :: dielectric_epsr
179 186  
180 187 END TYPE external_conductor_model
... ... @@ -261,6 +268,7 @@ integer,parameter :: cable_geometry_type_twinax =7
261 268 integer,parameter :: cable_geometry_type_flex_cable =8
262 269 integer,parameter :: cable_geometry_type_Dconnector =9
263 270 integer,parameter :: cable_geometry_type_ground_plane =10
  271 +integer,parameter :: cable_geometry_type_ML_flex_cable =11
264 272  
265 273 integer,parameter :: impedance_model_type_PEC =0
266 274 integer,parameter :: impedance_model_type_cylindrical_with_conductivity =1
... ... @@ -280,6 +288,7 @@ include &#39;shielded_twisted_pair.F90&#39;
280 288 include 'spacewire.F90'
281 289 include 'twinax.F90'
282 290 include 'flex_cable.F90'
  291 +include 'ML_flex_cable.F90'
283 292 include 'Dconnector.F90'
284 293 include 'overshield.F90'
285 294 include 'ground_plane.F90'
... ... @@ -329,10 +338,12 @@ include &#39;conductor_impedance_model.F90&#39;
329 338 ext_model%conductor_width2=0d0
330 339 ext_model%conductor_height=0d0
331 340 ext_model%conductor_ox=0d0
  341 + ext_model%conductor_oy=0d0
332 342 ext_model%dielectric_radius=0d0
333 343 ext_model%dielectric_width=0d0
334 344 ext_model%dielectric_height=0d0
335 345 ext_model%dielectric_ox=0d0
  346 + ext_model%dielectric_oy=0d0
336 347 ext_model%dielectric_epsr=1d0
337 348  
338 349 END SUBROUTINE reset_external_conductor_model
... ... @@ -372,6 +383,7 @@ END SUBROUTINE reset_external_conductor_model
372 383 integer :: matrix_dimension
373 384  
374 385 logical :: file_exists
  386 + character(len=line_length) :: line
375 387  
376 388 ! START
377 389  
... ... @@ -502,11 +514,27 @@ END SUBROUTINE reset_external_conductor_model
502 514 read(file_unit,*) cable%external_model(i)%conductor_width
503 515 read(file_unit,*) cable%external_model(i)%conductor_width2
504 516 read(file_unit,*) cable%external_model(i)%conductor_height
505   - read(file_unit,*) cable%external_model(i)%conductor_ox
  517 +
  518 +! format change. This way of reading allows backward compatibility
  519 + read(file_unit,'(A)')line
  520 + read(line,*,err=100) cable%external_model(i)%conductor_ox,cable%external_model(i)%conductor_oy
  521 + GOTO 110
  522 +100 read(line,*) cable%external_model(i)%conductor_ox
  523 + cable%external_model(i)%conductor_oy=0d0
  524 +110 CONTINUE
  525 +
506 526 read(file_unit,*) cable%external_model(i)%dielectric_radius
507 527 read(file_unit,*) cable%external_model(i)%dielectric_width
508 528 read(file_unit,*) cable%external_model(i)%dielectric_height
509   - read(file_unit,*) cable%external_model(i)%dielectric_ox
  529 +
  530 +! format change. This way of reading allows backward compatibility
  531 + read(file_unit,'(A)')line
  532 + read(line,*,err=200) cable%external_model(i)%dielectric_ox,cable%external_model(i)%dielectric_oy
  533 + GOTO 210
  534 +200 read(line,*) cable%external_model(i)%dielectric_ox
  535 + cable%external_model(i)%dielectric_oy=0d0
  536 +210 CONTINUE
  537 +
510 538 CALL read_Sfilter(cable%external_model(i)%dielectric_epsr,cable_file_unit)
511 539 end do
512 540  
... ... @@ -677,11 +705,13 @@ END SUBROUTINE reset_external_conductor_model
677 705 write(file_unit,*) cable%external_model(i)%conductor_width ,' conductor_width '
678 706 write(file_unit,*) cable%external_model(i)%conductor_width2 ,' conductor_width2 '
679 707 write(file_unit,*) cable%external_model(i)%conductor_height ,' conductor_height '
680   - write(file_unit,*) cable%external_model(i)%conductor_ox ,' conductor_ox '
  708 + write(file_unit,*) cable%external_model(i)%conductor_ox,cable%external_model(i)%conductor_oy &
  709 + ,' conductor_ox, conductor_oy '
681 710 write(file_unit,*) cable%external_model(i)%dielectric_radius ,' dielectric_radius'
682 711 write(file_unit,*) cable%external_model(i)%dielectric_width ,' dielectric_width '
683 712 write(file_unit,*) cable%external_model(i)%dielectric_height ,' dielectric_height'
684   - write(file_unit,*) cable%external_model(i)%dielectric_ox ,' dielectric_ox '
  713 + write(file_unit,*) cable%external_model(i)%dielectric_ox,cable%external_model(i)%dielectric_oy &
  714 + ,' dielectric_ox, dielectric_oy '
685 715 CALL write_Sfilter(cable%external_model(i)%dielectric_epsr,cable_file_unit)
686 716 end do
687 717  
... ...
SRC/CABLE_MODULES/flex_cable.F90
... ... @@ -249,7 +249,7 @@ IMPLICIT NONE
249 249 do i=1,cable%tot_n_conductors
250 250 write(conductor_string,'(I2)')i
251 251 cable%conductor_label(i)='Cable name: '//trim(cable%cable_name)// &
252   - '. type: '//trim(cable%cable_type_string)//'. conductor '//conductor_string//' : flex_cable conductor'
  252 + '. type: '//trim(cable%cable_type_string)//'. conductor '//conductor_string//' : original_flex_cable conductor'
253 253 end do
254 254  
255 255 END SUBROUTINE flex_cable_set_internal_domain_information
... ...
SRC/GENERAL_MODULES/constants.F90
... ... @@ -104,6 +104,8 @@ IMPLICIT NONE
104 104  
105 105 real(dp) :: Laplace_surface_mesh_constant=3d0 ! the mesh edge length on boundaries is calculated as radius/Laplace_surface_mesh_constant
106 106 ! if Laplace_surface_mesh_constant=5 we have just over 30 elements on the circumference
  107 +
  108 + real(dp) :: max_mesh_edge_length=1d30 ! the maximum mesh edge length on internal boundaries
107 109  
108 110 real(dp) :: Twisted_pair_equivalent_radius=1.5d0 ! The twisted pair commmon mode interaction is calculated by treating the
109 111 ! common mode as being carried on an 'equivalent cylindrical conductor'
... ...
SRC/GENERAL_MODULES/general_module.F90
... ... @@ -132,6 +132,8 @@ integer,parameter :: Pspice =3
132 132 integer,parameter :: circle =1
133 133 integer,parameter :: rectangle=2
134 134 integer,parameter :: Dshape=3
  135 +integer,parameter :: semicircle=4
  136 +integer,parameter :: semicircle_diameter=5
135 137  
136 138 integer :: spice_version
137 139  
... ... @@ -168,6 +170,13 @@ logical :: verbose=.FALSE.
168 170  
169 171 logical :: plot_propagation_correction_filter_fit_data=.FALSE.
170 172  
  173 +logical :: direct_solver=.FALSE.
  174 +
  175 +logical :: inf_gnd=.TRUE.
  176 +
  177 +!logical :: use_ABC=.TRUE.
  178 +logical :: use_ABC=.FALSE.
  179 +
171 180 ! There are some differences between windows and unix relating to
172 181 ! file separators and making directories. The different formats for
173 182 ! the two ooperating systems supported are included below
... ...
SRC/GENERAL_MODULES/generate_shapes.F90
... ... @@ -30,6 +30,7 @@
30 30 !SUBROUTINE generate_rectangle_points
31 31 !SUBROUTINE generate_Dshape_points
32 32 !SUBROUTINE generate_arc_points
  33 +!SUBROUTINE generate_semicircle_points
33 34 !
34 35 !SUBROUTINE generate_circle_points
35 36 !
... ... @@ -545,3 +546,76 @@ IMPLICIT NONE
545 546 RETURN
546 547  
547 548 END SUBROUTINE generate_line_points
  549 +!
  550 +!SUBROUTINE generate_semicircle_points
  551 +!
  552 +! NAME
  553 +! SUBROUTINE generate_semicircle_points
  554 +!
  555 +! DESCRIPTION
  556 +! write a semicircle with specified x,y centre and radius to file for plotting with gnuplot
  557 +! the semicircle is in the region y>=ycentre
  558 +!
  559 +!
  560 +! COMMENTS
  561 +! return the extent of the plotting area...
  562 +!
  563 +! HISTORY
  564 +!
  565 +! started 10/05/2013 CJS
  566 +!
  567 +!
  568 +SUBROUTINE generate_semicircle_points(npts,shape_x,shape_y,x,y,r)
  569 +
  570 +USE type_specifications
  571 +USE constants
  572 +
  573 +IMPLICIT NONE
  574 +
  575 + integer,intent(OUT) :: npts
  576 + real(dp),allocatable,intent(INOUT) :: shape_x(:)
  577 + real(dp),allocatable,intent(INOUT) :: shape_y(:)
  578 + real(dp),intent(IN) :: x,y,r ! centre x and y coordinates and radius
  579 +
  580 +! local variables
  581 +
  582 + real(dp) x1,y1
  583 + real(dp) x2,y2
  584 + real(dp) x3,y3
  585 +
  586 + integer :: loop
  587 +
  588 +! START
  589 +
  590 +! write the semicircle as two arcs and a straight line to close the shape
  591 +! the straght line is formed by the first and last points of the arc
  592 +
  593 + x1=x+r
  594 + y1=y
  595 +
  596 + x2=x
  597 + y2=y+r
  598 +
  599 + x3=x-r
  600 + y3=y
  601 +
  602 + do loop=1,2 ! first pass to count the points, second pass to set the point coordinates
  603 +
  604 + npts=0
  605 +
  606 + CALL generate_arc_points(npts,shape_x,shape_y,loop,x,y,x1,y1,x2,y2)
  607 +
  608 + CALL generate_arc_points(npts,shape_x,shape_y,loop,x,y,x2,y2,x3,y3)
  609 +
  610 + CALL generate_line_points(npts,shape_x,shape_y,loop,x3,y3,x1,y1)
  611 +
  612 + if (loop.EQ.1) then
  613 + ALLOCATE( shape_x(1:npts) )
  614 + ALLOCATE( shape_y(1:npts) )
  615 + end if
  616 +
  617 + end do ! next loop
  618 +
  619 + RETURN
  620 +
  621 +END SUBROUTINE generate_semicircle_points
... ...
SRC/GENERAL_MODULES/plot_geometry.F90
... ... @@ -29,6 +29,7 @@
29 29 !SUBROUTINE write_circle
30 30 !SUBROUTINE write_rectangle
31 31 !SUBROUTINE write_Dshape
  32 +!SUBROUTINE write_semicircle
32 33 !
33 34 !SUBROUTINE write_circle
34 35 !
... ... @@ -220,3 +221,67 @@ IMPLICIT NONE
220 221 RETURN
221 222  
222 223 END SUBROUTINE write_Dshape
  224 +!
  225 +!SUBROUTINE write_semicircle
  226 +!
  227 +! NAME
  228 +! SUBROUTINE write_semicircle
  229 +!
  230 +! DESCRIPTION
  231 +! write a semicircle with specified x,y centre and radius to file for plotting with gnuplot
  232 +! the semicircle is in the region y>=0
  233 +!
  234 +!
  235 +! COMMENTS
  236 +! return the extent of the plotting area...
  237 +!
  238 +! HISTORY
  239 +!
  240 +! started 10/05/2013 CJS
  241 +! using generate_shapes.F90 20/4/2017 CJS
  242 +!
  243 +!
  244 +SUBROUTINE write_semicircle(x,y,r,unit,xmin,xmax,ymin,ymax)
  245 +
  246 +USE type_specifications
  247 +USE constants
  248 +
  249 +IMPLICIT NONE
  250 +
  251 + real(dp),intent(IN) :: x,y,r ! centre x and y coordinates and radius
  252 + real(dp),intent(INOUT) :: xmin,xmax,ymin,ymax ! extent of the plotting area
  253 + integer, intent(IN) :: unit ! unit to write to
  254 +
  255 +! local variables
  256 +
  257 + integer :: npts
  258 + real(dp),allocatable :: shape_x(:)
  259 + real(dp),allocatable :: shape_y(:)
  260 +
  261 + integer :: i
  262 +
  263 +! START
  264 +
  265 + CALL generate_semicircle_points(npts,shape_x,shape_y,x,y,r)
  266 +
  267 + do i=1,npts
  268 +
  269 + write(unit,8000)shape_x(i),shape_y(i)
  270 +8000 format (4E14.6)
  271 +
  272 + xmin=min(xmin,shape_x(i))
  273 + xmax=max(xmax,shape_x(i))
  274 + ymin=min(ymin,shape_y(i))
  275 + ymax=max(ymax,shape_y(i))
  276 +
  277 + end do
  278 +
  279 + write(unit,*)
  280 + write(unit,*)
  281 +
  282 + DEALLOCATE( shape_x )
  283 + DEALLOCATE( shape_y )
  284 +
  285 + RETURN
  286 +
  287 +END SUBROUTINE write_semicircle
... ...
SRC/MATHS_MODULES/cmatrix.F90
... ... @@ -32,6 +32,7 @@
32 32 ! SUBROUTINE write_cmatrix_abs(Mat,dim,unit)
33 33 ! SUBROUTINE cinvert_Gauss_Jordan(A,n,AI,dim)
34 34 ! SUBROUTINE c_condition_number (A,n,condition_number,dim)
  35 +!
35 36 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
36 37 !
37 38 ! NAME
... ... @@ -454,3 +455,5 @@ IMPLICIT NONE
454 455 RETURN
455 456  
456 457 END SUBROUTINE c_condition_number
  458 +
  459 +
... ...
SRC/MATHS_MODULES/dmatrix.F90
... ... @@ -28,6 +28,7 @@
28 28 ! SUBROUTINE dwrite_matrix(a,ar,ac,dim,unit)
29 29 ! SUBROUTINE dread_matrix(a,ar,ac,dim,unit)
30 30 ! SUBROUTINE dinvert_Gauss_Jordan(A,ar,AI,dim)
  31 +!
31 32 !_____________________________________________________________________
32 33 !
33 34 ! NAME
... ... @@ -283,3 +284,4 @@ IMPLICIT NONE
283 284 RETURN
284 285  
285 286 END SUBROUTINE dinvert_Gauss_Jordan
  287 +
... ...
SRC/PUL_PARAMETER_CALCULATION/Aprod.F90 0 → 100644
... ... @@ -0,0 +1,207 @@
  1 +! This file is part of SACAMOS, State of the Art CAble MOdels in Spice.
  2 +! It was developed by the University of Nottingham and the Netherlands Aerospace
  3 +! Centre (NLR) for ESA under contract number 4000112765/14/NL/HK.
  4 +!
  5 +! Copyright (C) 2016-2017 University of Nottingham
  6 +!
  7 +! SACAMOS is free software: you can redistribute it and/or modify it under the
  8 +! terms of the GNU General Public License as published by the Free Software
  9 +! Foundation, either version 3 of the License, or (at your option) any later
  10 +! version.
  11 +!
  12 +! SACAMOS is distributed in the hope that it will be useful, but
  13 +! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  14 +! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  15 +! for more details.
  16 +!
  17 +! A copy of the GNU General Public License version 3 can be found in the
  18 +! file GNU_GPL_v3 in the root or at <http://www.gnu.org/licenses/>.
  19 +!
  20 +! SACAMOS uses the EISPACK library (in /SRC/EISPACK). EISPACK is subject to
  21 +! the GNU Lesser General Public License. A copy of the GNU Lesser General Public
  22 +! License version can be found in the file GNU_LGPL in the root of EISPACK
  23 +! (/SRC/EISPACK ) or at <http://www.gnu.org/licenses/>.
  24 +!
  25 +! The University of Nottingham can be contacted at: ggiemr@nottingham.ac.uk
  26 +!
  27 +! File Contents:
  28 +!
  29 +! SUBROUTINE Aprod
  30 +! SUBROUTINE ATprod
  31 +! SUBROUTINE zAprod
  32 +! SUBROUTINE zATprod
  33 +!
  34 +! NAME
  35 +! SUBROUTINE Aprod
  36 +!
  37 +! DESCRIPTION
  38 +! Matrix vector multiplication for sparse, real matrices
  39 +!
  40 +! COMMENTS
  41 +!
  42 +!
  43 +! HISTORY
  44 +! 19/3/2018 CJS
  45 +!
  46 +!
  47 +SUBROUTINE Aprod ( n, x, y )
  48 +
  49 +! form the vector y=K*x
  50 +
  51 +USE type_specifications
  52 +
  53 +IMPLICIT NONE
  54 +
  55 +integer n
  56 +real(dp) :: x(n), y(n)
  57 +
  58 +integer :: i,row,col
  59 +
  60 +! START
  61 +
  62 +y(:)=0d0
  63 +
  64 +do i=1,n_entry
  65 + row=i_K(i)
  66 + col=j_K(i)
  67 +
  68 +! if (row.GT.n) then
  69 +! write(*,*)'Error in Aprod, row=',row,' n=',n
  70 +! end if
  71 +! if (col.GT.n) then
  72 +! write(*,*)'Error in Aprod, col=',col,' n=',n
  73 +! end if
  74 +
  75 + y(row)=y(row)+s_K_re(i)*x(col)
  76 +
  77 +end do
  78 +
  79 +RETURN
  80 +
  81 +END SUBROUTINE Aprod
  82 +!
  83 +! NAME
  84 +! SUBROUTINE ATprod
  85 +!
  86 +! DESCRIPTION
  87 +! Transpose Matrix vector multiplication for sparse, real matrices
  88 +!
  89 +! COMMENTS
  90 +!
  91 +!
  92 +! HISTORY
  93 +! 19/3/2018 CJS
  94 +!
  95 +!
  96 +SUBROUTINE ATprod ( n, x, y )
  97 +
  98 +! form the vector y=AT*x
  99 +
  100 +USE type_specifications
  101 +
  102 +IMPLICIT NONE
  103 +
  104 +integer n
  105 +real(dp) :: x(n), y(n)
  106 +
  107 +integer :: i,row,col
  108 +
  109 +! START
  110 +
  111 +y(:)=0d0
  112 +
  113 +do i=1,n_entry
  114 + row=j_K(i)
  115 + col=i_K(i)
  116 +
  117 + y(row)=y(row)+s_K_re(i)*x(col)
  118 +
  119 +end do
  120 +
  121 +RETURN
  122 +
  123 +END SUBROUTINE ATprod
  124 +!
  125 +! NAME
  126 +! SUBROUTINE zAprod
  127 +!
  128 +! DESCRIPTION
  129 +! Matrix vector multiplication for sparse, real matrices
  130 +!
  131 +! COMMENTS
  132 +!
  133 +!
  134 +! HISTORY
  135 +! 19/3/2018 CJS
  136 +!
  137 +!
  138 +SUBROUTINE zAprod ( n, x, y )
  139 +
  140 +! form the vector y=A*x
  141 +
  142 +USE type_specifications
  143 +
  144 +IMPLICIT NONE
  145 +
  146 +integer n
  147 +complex(dp) :: x(n), y(n)
  148 +
  149 +integer :: i,row,col
  150 +
  151 +! START
  152 +
  153 +y(:)=0d0
  154 +
  155 +do i=1,n_entry
  156 + row=i_K(i)
  157 + col=j_K(i)
  158 +
  159 + y(row)=y(row)+s_K(i)*x(col)
  160 +
  161 +end do
  162 +
  163 +RETURN
  164 +
  165 +END SUBROUTINE zAprod
  166 +!
  167 +! NAME
  168 +! SUBROUTINE zATprod
  169 +!
  170 +! DESCRIPTION
  171 +! Transpose Matrix vector multiplication for sparse, real matrices
  172 +!
  173 +! COMMENTS
  174 +!
  175 +!
  176 +! HISTORY
  177 +! 19/3/2018 CJS
  178 +!
  179 +!
  180 +SUBROUTINE zATprod ( n, x, y )
  181 +
  182 +! form the vector y=AT*x
  183 +
  184 +USE type_specifications
  185 +
  186 +IMPLICIT NONE
  187 +
  188 +integer n
  189 +complex(dp) :: x(n), y(n)
  190 +
  191 +integer :: i,row,col
  192 +
  193 +! START
  194 +
  195 +y(:)=0d0
  196 +
  197 +do i=1,n_entry
  198 + row=j_K(i)
  199 + col=i_K(i)
  200 +
  201 + y(row)=y(row)+(s_K(i))*x(col)
  202 +
  203 +end do
  204 +
  205 +RETURN
  206 +
  207 +END SUBROUTINE zATprod
... ...
SRC/PUL_PARAMETER_CALCULATION/CG_solve.F90 0 → 100644
... ... @@ -0,0 +1,382 @@
  1 +!
  2 +! This file is part of SACAMOS, State of the Art CAble MOdels in Spice.
  3 +! It was developed by the University of Nottingham and the Netherlands Aerospace
  4 +! Centre (NLR) for ESA under contract number 4000112765/14/NL/HK.
  5 +!
  6 +! Copyright (C) 2016-2017 University of Nottingham
  7 +!
  8 +! SACAMOS is free software: you can redistribute it and/or modify it under the
  9 +! terms of the GNU General Public License as published by the Free Software
  10 +! Foundation, either version 3 of the License, or (at your option) any later
  11 +! version.
  12 +!
  13 +! SACAMOS is distributed in the hope that it will be useful, but
  14 +! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  15 +! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  16 +! for more details.
  17 +!
  18 +! A copy of the GNU General Public License version 3 can be found in the
  19 +! file GNU_GPL_v3 in the root or at <http://www.gnu.org/licenses/>.
  20 +!
  21 +! SACAMOS uses the EISPACK library (in /SRC/EISPACK). EISPACK is subject to
  22 +! the GNU Lesser General Public License. A copy of the GNU Lesser General Public
  23 +! License version can be found in the file GNU_LGPL in the root of EISPACK
  24 +! (/SRC/EISPACK ) or at <http://www.gnu.org/licenses/>.
  25 +!
  26 +! The University of Nottingham can be contacted at: ggiemr@nottingham.ac.uk
  27 +!
  28 +! SUBROUTINE solve_real_symm(n, b, x,tol)
  29 +! SUBROUTINE dot ( n, x, y ,res)
  30 +! SUBROUTINE solve_complex_symm(n, b, x,tol)
  31 +! SUBROUTINE zdot ( n, x, y ,res)
  32 +!
  33 +! NAME
  34 +! solve_real_symm
  35 +!
  36 +! DESCRIPTION
  37 +!
  38 +! Solve the system Ax=b using a conjugate gradient method.
  39 +! The iterative solution halts when the norm of the residual is less than tol
  40 +!
  41 +! HISTORY
  42 +!
  43 +! started 19/6/2018 CJS
  44 +!
  45 +! COMMENTS
  46 +!
  47 +SUBROUTINE solve_real_symm(n, b, x,tol)
  48 +
  49 +USE type_specifications
  50 +
  51 +IMPLICIT NONE
  52 +
  53 +! variables passed to subroutine
  54 +
  55 +integer,intent(IN) :: n
  56 +
  57 +real(dp),intent(IN) :: b(n)
  58 +real(dp),intent(INOUT) :: x(n) ! x contains the initial guess for x
  59 +real(dp),intent(IN) :: tol
  60 +
  61 +! local variables
  62 +
  63 +real(dp) :: ak
  64 +real(dp) :: rk(n),rkb(n)
  65 +real(dp) :: pk(n),pkb(n)
  66 +real(dp) :: bk
  67 +
  68 +real(dp) :: t1(n),t2(n)
  69 +real(dp) :: res(n),res_norm
  70 +real(dp) :: num,den
  71 +
  72 +integer :: i,ii,itloop
  73 +
  74 +logical :: minres
  75 +
  76 +! START
  77 +
  78 +write(*,*)'CALLED solve_real_symm with n=',n
  79 +
  80 +! choice between normal conjugate gradient and minimum residual forms.
  81 +
  82 +minres=.TRUE.
  83 +
  84 +! set starting values
  85 +
  86 +! calculate the residual res=b-A.xk
  87 + CALL Aprod( n, x, t1 )
  88 + res(:)=b(:)-t1(:)
  89 +
  90 +! calculate the size of the residual
  91 + res_norm=0d0
  92 + do i=1,n
  93 + res_norm=res_norm+res(i)*res(i)
  94 + end do
  95 + res_norm=sqrt(res_norm)
  96 +
  97 + write(*,*)'iteration ',0,' norm=',res_norm
  98 +
  99 +! initial r1=b-A.x
  100 + CALL Aprod( n, x, t1 )
  101 + rk(:)=b(:)-t1(:)
  102 +
  103 + if (minres) then
  104 +! For the minimum residual algorithm r1b=A.r1
  105 + CALL Aprod( n, rk, rkb )
  106 + else
  107 +! For the normal algorithm r1b=r1
  108 + rkb(:)=rk(:)
  109 + end if
  110 +
  111 +! p1=r1
  112 + pk=rk
  113 +
  114 +! p1b=r1b
  115 + pkb=rkb
  116 +
  117 +! iteration loop
  118 + do itloop=1,2*n
  119 +
  120 +! calculate ak=(rkb.rk)/(pkb.A.pk)
  121 +
  122 + CALL dot(n,rkb,rk,num)
  123 +
  124 + CALL Aprod( n, pk, t1 )
  125 + CALL dot(n,pkb,t1,den)
  126 +
  127 + ak=num/den
  128 +
  129 +! calculate the next value of the solution vector, xk+1=xk+ak*pk
  130 + x(:)=x(:)+ak*pk(:)
  131 +
  132 +! calculate the residual res=b-A.xk
  133 + CALL Aprod( n, x, t2 )
  134 + res(:)=b(:)-t2(:)
  135 +
  136 +! calculate the size of the residual
  137 + res_norm=0d0
  138 + do i=1,n
  139 + res_norm=res_norm+res(i)*res(i)
  140 + end do
  141 + res_norm=sqrt(res_norm)
  142 +
  143 + if (res_norm.LT.tol) then
  144 + write(*,*)'iteration ',itloop,' norm=',res_norm,' ak=',ak
  145 + RETURN
  146 + end if
  147 +
  148 +! calculate rk+1=rk-ak*A.pk
  149 + rk(:) =rk(:) -ak*t1(:)
  150 +
  151 +! calculate rk+1b=rkb-ak*AT.pkb, note for the symmetric matrices here AT=A
  152 + CALL ATprod( n, pkb, t2 )
  153 + rkb(:)=rkb(:)-ak*t2(:)
  154 +
  155 +! calculate bk=(rk+1b.rk+1)/(rkb.rk)
  156 + den=num
  157 + CALL dot(n,rkb,rk,num)
  158 + bk=num/den
  159 +
  160 + write(*,*)'iteration ',itloop,' norm=',res_norm,' ak=',ak,' bk=',bk
  161 +
  162 +! calculate pk+1=rk+1-bk*pk
  163 + pk(:)=rk(:)+bk*pk(:)
  164 +
  165 +! calculate pk+1b=rk+1b-bk*pkb
  166 + pkb(:)=rkb(:)+bk*pkb(:)
  167 +
  168 + end do ! next iteration
  169 +
  170 +! finish
  171 +
  172 + RETURN
  173 +
  174 +
  175 +END SUBROUTINE solve_real_symm
  176 +!
  177 +! _________________________________________________________________________
  178 +!
  179 +!
  180 +
  181 +SUBROUTINE dot ( n, x, y ,res)
  182 +
  183 +! form the dot product of x and y
  184 +
  185 +USE type_specifications
  186 +
  187 +IMPLICIT NONE
  188 +
  189 +integer n
  190 +real(dp) :: x(n), y(n), res
  191 +
  192 +integer :: i
  193 +
  194 +! START
  195 +
  196 +res=0d0
  197 +
  198 +do i=1,n
  199 +
  200 + res=res+x(i)*y(i)
  201 +
  202 +end do
  203 +
  204 +RETURN
  205 +
  206 +END SUBROUTINE dot
  207 +!
  208 +! NAME
  209 +! solve_complex_symm
  210 +!
  211 +! DESCRIPTION
  212 +!
  213 +! Solve the system Ax=b using a conjugate gradient method.
  214 +! The iterative solution halts when the norm of the residual is less than tol
  215 +!
  216 +! HISTORY
  217 +!
  218 +! started 19/6/2018 CJS
  219 +!
  220 +! COMMENTS
  221 +!
  222 + SUBROUTINE solve_complex_symm(n, b, x,tol)
  223 +
  224 +USE type_specifications
  225 +
  226 +IMPLICIT NONE
  227 +
  228 +! variables passed to subroutine
  229 +
  230 +integer,intent(IN) :: n
  231 +
  232 +complex(dp),intent(IN) :: b(n)
  233 +complex(dp),intent(INOUT) :: x(n) ! x contains the initial guess for x
  234 +real(dp),intent(IN) :: tol
  235 +
  236 +! local variables
  237 +
  238 +complex(dp) :: ak
  239 +complex(dp) :: rk(n),rkb(n)
  240 +complex(dp) :: pk(n),pkb(n)
  241 +complex(dp) :: bk
  242 +
  243 +complex(dp) :: t1(n),t2(n)
  244 +complex(dp) :: res(n)
  245 +real(dp) :: res_norm
  246 +complex(dp) :: num,den
  247 +
  248 +integer :: i,ii,itloop
  249 +
  250 +logical :: minres
  251 +
  252 +! START
  253 +
  254 +write(*,*)'CALLED solve_real_symm with n=',n
  255 +
  256 +! choice between normal conjugate gradient and minimum residual forms.
  257 +
  258 +minres=.TRUE.
  259 +
  260 +! set starting values
  261 +
  262 +! calculate the residual res=b-A.xk
  263 + CALL zAprod( n, x, t1 )
  264 + res(:)=b(:)-t1(:)
  265 +
  266 +! calculate the size of the residual
  267 + res_norm=0d0
  268 + do i=1,n
  269 + res_norm=res_norm+res(i)*res(i)
  270 + end do
  271 + res_norm=sqrt(res_norm)
  272 +
  273 + write(*,*)'iteration ',0,' norm=',res_norm
  274 +
  275 +! initial r1=b-A.x
  276 + CALL zAprod( n, x, t1 )
  277 + rk(:)=b(:)-t1(:)
  278 +
  279 + if (minres) then
  280 +! For the minimum residual algorithm r1b=A.r1
  281 + CALL zAprod( n, rk, rkb )
  282 + else
  283 +! For the normal algorithm r1b=r1
  284 + rkb(:)=rk(:)
  285 + end if
  286 +
  287 +! p1=r1
  288 + pk=rk
  289 +
  290 +! p1b=r1b
  291 + pkb=rkb
  292 +
  293 +! iteration loop
  294 + do itloop=1,2*n
  295 +
  296 +! calculate ak=(rkb.rk)/(pkb.A.pk)
  297 +
  298 + CALL zdot(n,rkb,rk,num)
  299 +
  300 + CALL zAprod( n, pk, t1 )
  301 + CALL zdot(n,pkb,t1,den)
  302 +
  303 + ak=num/den
  304 +
  305 +! calculate the next value of the solution vector, xk+1=xk+ak*pk
  306 + x(:)=x(:)+ak*pk(:)
  307 +
  308 +! calculate the residual res=b-A.xk
  309 + CALL zAprod( n, x, t2 )
  310 + res(:)=b(:)-t2(:)
  311 +
  312 +! calculate the size of the residual
  313 + res_norm=0d0
  314 + do i=1,n
  315 + res_norm=res_norm+abs(res(i))**2
  316 + end do
  317 + res_norm=sqrt(res_norm)
  318 +
  319 + if (res_norm.LT.tol) then
  320 + write(*,*)'iteration ',itloop,' norm=',res_norm,' ak=',ak
  321 + RETURN
  322 + end if
  323 +
  324 +! calculate rk+1=rk-ak*A.pk
  325 + rk(:) =rk(:) -ak*t1(:)
  326 +
  327 +! calculate rk+1b=rkb-ak*AT.pkb, note for the symmetric matrices here AT=A
  328 + CALL zATprod( n, pkb, t2 )
  329 + rkb(:)=rkb(:)-ak*t2(:)
  330 +
  331 +! calculate bk=(rk+1b.rk+1)/(rkb.rk)
  332 + den=num
  333 + CALL zdot(n,rkb,rk,num)
  334 + bk=num/den
  335 +
  336 + write(*,*)'iteration ',itloop,' norm=',res_norm,' ak=',ak,' bk=',bk
  337 +
  338 +! calculate pk+1=rk+1-bk*pk
  339 + pk(:)=rk(:)+bk*pk(:)
  340 +
  341 +! calculate pk+1b=rk+1b-bk*pkb
  342 + pkb(:)=rkb(:)+bk*pkb(:)
  343 +
  344 + end do ! next iteration
  345 +
  346 +! finish
  347 +
  348 + RETURN
  349 +
  350 +
  351 +END SUBROUTINE solve_complex_symm
  352 +!
  353 +! _________________________________________________________________________
  354 +!
  355 +!
  356 +
  357 +SUBROUTINE zdot ( n, x, y ,res)
  358 +
  359 +! form the dot product of x and y
  360 +
  361 +USE type_specifications
  362 +
  363 +IMPLICIT NONE
  364 +
  365 +integer n
  366 +complex(dp) :: x(n), y(n), res
  367 +
  368 +integer :: i
  369 +
  370 +! START
  371 +
  372 +res=0d0
  373 +
  374 +do i=1,n
  375 +
  376 + res=res+x(i)*y(i) ! note no complex conjugate in the inner product here. This gives the biconjugate gradient method.
  377 +
  378 +end do
  379 +
  380 +RETURN
  381 +
  382 +END SUBROUTINE zdot
... ...
SRC/PUL_PARAMETER_CALCULATION/Laplace.F90
... ... @@ -106,6 +106,7 @@
106 106 ! started 5/7/2016 CJS. This subroutineis based on software from NLR and has been
107 107 ! translated from Matlab to Fortran.
108 108 ! 8/5/2017 CJS: Include references to Theory_Manual
  109 +! 19/6/2018 CJS: Include iterative solver based on the biconjugate gradient method
109 110 !
110 111 SUBROUTINE Laplace(mesh_filename,dim,first_surface_is_free_space_boundary, &
111 112 n_dielectric_regions,dielectric_region_epsr,frequency,Lmat,Cmat,Gmat,ox,oy)
... ... @@ -169,7 +170,7 @@ integer :: N_nodes_in ! number of nodes in t
169 170 integer :: N_elements_in ! number of elements in the gmsh file (this is not necessarily the number of triangular elements in the FE mesh)
170 171  
171 172 integer :: n_boundaries ! number of boundaries, not including dielectric (internal) boundaries
172   -integer :: N_boundaries_max ! maximum boundary number generated by PUL_LC_Laplace and found in the mesh file
  173 +integer :: N_boundaries_max ! maximum boundary number generated by PUL_LC_Laplace and found insolve_real_symm(n, b, x,tol) the mesh file
173 174 integer :: N_boundary ! number of viable boundaries in the mesh i.e. boundaries with two or more points on
174 175 integer :: boundary_number
175 176 integer :: N_elements_boundary_temp
... ... @@ -202,7 +203,7 @@ integer :: N_unknown ! number of known node voltages i.e
202 203 integer :: N_known ! number of unknown node voltages
203 204  
204 205 integer :: jmax ! maximum boundary number (i.e. number of conductors)
205   - ! this is used to determine the number of finite element solutions (right hand sides to solve for) to
  206 + ! this is used to determine the number of finite element solutions (right hand solve_real_symm(n, b, x,tol)sides to solve for) to
206 207 ! fill the capacitance/conductance matrix
207 208  
208 209 integer :: total_n_boundary_nodes ! total number of boundary nodes i.e. the number of known node values
... ... @@ -216,10 +217,12 @@ complex(dp),allocatable :: c(:,:) ! element based array of constants re
216 217 complex(dp),allocatable :: delta(:) ! element based array with a value related to the element geometry
217 218 complex(dp),allocatable :: eps_r(:) ! element based array with the complex relative permittivity of the element
218 219  
219   -! 1D arrays used in the construction of the K matrix ( K(i_K(:),j_K(:))=K(i_K(:),j_K(:))+s_K(:) )
220   -integer,allocatable :: i_K(:)
221   -integer,allocatable :: j_K(:)
222   -complex(dp),allocatable :: s_K(:)
  220 +!
  221 +!integer :: n_entrysolve_real_symm(n, b, x,tol)
  222 +!! 1D arrays used in the construction of the K matrix ( K(i_K(:),j_K(:))=K(i_K(:),j_K(:))+s_K(:) )
  223 +!integer,allocatable :: i_K(:)
  224 +!integer,allocatable :: j_K(:)
  225 +!complex(dp),allocatable :: s_K(:)
223 226  
224 227 ! 1D arrays used in the construction of the right hand side vectors ( K_rhs(i_K_rhs(:),j_K_rhs(:))=K_rhs(i_K_rhs(:),j_K_rhs(:))+s_K_rhs(:) )
225 228 integer,allocatable :: i_K_rhs(:) ! row number
... ... @@ -248,7 +251,6 @@ real(dp),allocatable :: Conductance_energy(:,:)
248 251 integer :: node,new_node
249 252 integer :: element
250 253  
251   -integer :: n_entry
252 254 integer :: n_entry_K_rhs
253 255 integer :: n1,n2,n3
254 256 complex(dp) :: x1,x2,x3,y1,y2,y3
... ... @@ -280,6 +282,37 @@ integer :: nr
280 282  
281 283 integer :: ierr ! error code for matrix inversion
282 284  
  285 +! variables for iterative solver
  286 +
  287 +logical checkA
  288 +integer itnlim
  289 +real(dp) rtol
  290 +integer nout
  291 +logical goodb
  292 +logical precon
  293 +real(dp) shift
  294 +
  295 +integer istop, itn
  296 +real(dp) anorm, acond, rnorm, ynorm
  297 +
  298 +real(dp),allocatable :: r1(:)
  299 +real(dp),allocatable :: r2(:)
  300 +real(dp),allocatable :: vt(:)
  301 +real(dp),allocatable :: wt(:)
  302 +real(dp),allocatable :: yt(:)
  303 +real(dp),allocatable :: bt(:)
  304 +real(dp),allocatable :: xt(:)
  305 +
  306 +logical :: lossy_dielectric ! flag to indicate lossy dielectric i.e. we must solve a complex problem
  307 +
  308 +logical :: wantse
  309 +integer :: n,m
  310 +real(dp) :: atol, btol, conlim, damp
  311 +real(dp) :: Arnorm, xnorm
  312 +real(dp),allocatable :: se(:)
  313 +
  314 +real(dp) :: Vout
  315 +
283 316 ! START
284 317  
285 318 if (verbose) write(*,*)'CALLED: Laplace'
... ... @@ -542,12 +575,16 @@ if (verbose) write(*,*)&#39; Number of materials=&#39;,N_materials
542 575  
543 576 ALLOCATE ( Mat_prop(1:N_materials,1:4) )
544 577  
  578 +lossy_dielectric=.FALSE.
  579 +
545 580 do i=1,N_materials
546 581 Mat_prop(i,1)=i ! material number
547 582 Mat_prop(i,2)=dble(dielectric_region_epsr(i-1)) ! Re{epsr}
548 583 Mat_prop(i,3)=aimag(dielectric_region_epsr(i-1)) ! Im{epsr}
549 584 Mat_prop(i,4)=frequency
550 585  
  586 + if ( abs(Mat_prop(i,3)).GT.small ) lossy_dielectric=.TRUE.
  587 +
551 588 if (verbose) then
552 589 count=0
553 590 do element=1,N_elements
... ... @@ -942,7 +979,16 @@ do loop=1,2
942 979  
943 980 ls=sqrt((x2-x1)**2+(y2-y1)**2) ! l2= boundary element edge length
944 981  
945   - gamma=-eps_r(el)/(log(rho)*rho) ! gamma (see equation 4.3 with equation 4.93)
  982 + if (use_ABC) then
  983 +! This implements an asymptotic boundary condition. This apears to cause convergence
  984 +! issues for the Capacitance matrix calculation so should be used with caution.
  985 +! The default is the Neumann boundary condition (gamma=0)
  986 + gamma=-eps_r(el)/(log(rho)*rho) ! gamma (see equation 4.3 with equation 4.93)
  987 + else
  988 +! Neumann boundary condition on the outer boundary. This effectively sets the charge to zero on the outer
  989 +! boundary and the convergence of the capacitance matrix is improved compared with the ABC
  990 + gamma=0d0
  991 + end if
946 992  
947 993 ! K11 contributions according to equation 4.51 (note delta_ij=1 if i=j, 0 otherwise)
948 994 n_entry=n_entry+1
... ... @@ -1002,8 +1048,6 @@ ALLOCATE ( v_tmp(1:N_known) )
1002 1048  
1003 1049 ! solution based on a full matrix inverse
1004 1050  
1005   -ALLOCATE ( K(1:N_unknown,1:N_unknown) )
1006   -ALLOCATE ( KI(1:N_unknown,1:N_unknown) )
1007 1051 ALLOCATE ( K_rhs(1:N_unknown,1:N_known) )
1008 1052  
1009 1053 if(verbose) then
... ... @@ -1011,12 +1055,6 @@ if(verbose) then
1011 1055 write(*,*)'Number of entries in K_rhs',n_entry_K_rhs
1012 1056 end if
1013 1057  
1014   -! STAGE 11a: fill the K matrix
1015   -K(1:N_unknown,1:N_unknown)=0d0
1016   -do i=1,n_entry
1017   - K(i_K(i),j_K(i))=K(i_K(i),j_K(i))+s_K(i)
1018   -end do
1019   -
1020 1058 ! STAGE 11b: fill the K_rhs matrix
1021 1059 K_rhs(1:N_unknown,1:N_known)=0d0
1022 1060 do i=1,n_entry_K_rhs
... ... @@ -1030,20 +1068,108 @@ else
1030 1068 write(*,*)'Dimension of K in Laplace is',N_unknown,N_unknown
1031 1069 end if
1032 1070  
  1071 +if (direct_solver) then
  1072 + ALLOCATE ( K(1:N_unknown,1:N_unknown) )
  1073 + ALLOCATE ( KI(1:N_unknown,1:N_unknown) )
  1074 +
  1075 +! STAGE 11a: fill the K matrix
  1076 + K(1:N_unknown,1:N_unknown)=0d0
  1077 + do i=1,n_entry
  1078 + K(i_K(i),j_K(i))=K(i_K(i),j_K(i))+s_K(i)
  1079 + end do
  1080 +
1033 1081 ! STAGE 11c: Invert the K matrix
1034   -if(verbose) write(*,*)'Invert the K matrix'
1035   -ierr=0 ! set ierr=0 to cause an error within cinvert_Gauss_Jordan if there is a problem calculating the inverse
1036   -CALL cinvert_Gauss_Jordan(K,N_unknown,KI,N_unknown,ierr)
  1082 + if(verbose) write(*,*)'Invert the K matrix'
  1083 + ierr=0 ! set ierr=0 to cause an error within cinvert_Gauss_Jordan if there is a problem calculating the inverse
  1084 + CALL cinvert_Gauss_Jordan(K,N_unknown,KI,N_unknown,ierr)
1037 1085  
1038 1086 ! STAGE 11d loop over all the RHS vectors solving the matrix equation
1039   -do j1=1,jmax-1
1040   - do j2=j1,jmax-1
  1087 + do j1=1,jmax-1
  1088 + do j2=j1,jmax-1
  1089 + v_tmp(1:n_known)=V(j1,j2,1:n_known)
  1090 + b_tmp(1:N_unknown)=-matmul(K_rhs,v_tmp)
  1091 + x_tmp=matmul(KI,b_tmp)
  1092 + x(j1,j2,1:N_unknown)=x_tmp(1:N_unknown)
  1093 + end do
  1094 + end do
  1095 +
  1096 +else if(.NOT.lossy_dielectric) then
  1097 +
  1098 + checkA = .true.
  1099 + itnlim = N_unknown * 2
  1100 + rtol = 1.0D-12
  1101 + nout=6
  1102 + goodb=.FALSE.
  1103 + precon = .FALSE.
  1104 + shift=0d0
  1105 +
  1106 + allocate(r1(1:N_unknown))
  1107 + allocate(r2(1:N_unknown))
  1108 + allocate(vt(1:N_unknown))
  1109 + allocate(wt(1:N_unknown))
  1110 + allocate(yt(1:N_unknown))
  1111 + allocate(xt(1:N_unknown))
  1112 + allocate(bt(1:N_unknown))
  1113 +
  1114 + ALLOCATE( s_K_re(1:n_entry) )
  1115 + s_K_re(1:n_entry)=dble(s_K(1:n_entry))
  1116 +
  1117 +! Iterative solution
  1118 + do j1=1,jmax-1
  1119 + do j2=j1,jmax-1
  1120 +
1041 1121 v_tmp(1:n_known)=V(j1,j2,1:n_known)
1042 1122 b_tmp(1:N_unknown)=-matmul(K_rhs,v_tmp)
1043   - x_tmp=matmul(KI,b_tmp)
  1123 + bt(1:N_unknown)=b_tmp(1:N_unknown)
  1124 +
  1125 +! UoN conjugate gradient solution
  1126 + CALL solve_real_symm(N_unknown, bt, xt, rtol)
  1127 +
  1128 + x(j1,j2,1:N_unknown)=xt(1:N_unknown)
  1129 +
  1130 + end do
  1131 + end do
  1132 +
  1133 + deallocate(r1)
  1134 + deallocate(r2)
  1135 + deallocate(vt)
  1136 + deallocate(wt)
  1137 + deallocate(yt)
  1138 + deallocate(xt)
  1139 + deallocate(bt)
  1140 +
  1141 +else if (lossy_dielectric) then
  1142 +
  1143 + itnlim=4*N_unknown
  1144 + nout=6
  1145 + wantse=.FALSE.
  1146 + atol=1D-8
  1147 + btol=1d-8
  1148 + conlim=1d10
  1149 + damp=0d0
  1150 + allocate(se(1:N_unknown))
  1151 +
  1152 +! Iterative solution
  1153 + do j1=1,jmax-1
  1154 + do j2=j1,jmax-1
  1155 +
  1156 + v_tmp(1:n_known)=V(j1,j2,1:n_known)
  1157 + b_tmp(1:N_unknown)=-matmul(K_rhs,v_tmp)
  1158 + n=N_unknown
  1159 + m=N_unknown
  1160 +
  1161 +! UoN conjugate gradient solution
  1162 + rtol = 1.0D-12
  1163 + CALL solve_complex_symm(N_unknown, b_tmp, x_tmp, rtol)
  1164 +
1044 1165 x(j1,j2,1:N_unknown)=x_tmp(1:N_unknown)
1045   - end do
1046   -end do
  1166 +
  1167 + end do
  1168 + end do
  1169 +
  1170 + deallocate(se)
  1171 +
  1172 +end if
1047 1173  
1048 1174 ! STAGE 12 Determine the voltage phi in each node of the mesh
1049 1175  
... ... @@ -1321,6 +1447,7 @@ DEALLOCATE( eps_r )
1321 1447 DEALLOCATE( i_K )
1322 1448 DEALLOCATE( j_K )
1323 1449 DEALLOCATE( s_K )
  1450 +if ( ALLOCATED(s_K_re) ) DEALLOCATE( s_K_re )
1324 1451  
1325 1452 DEALLOCATE( i_K_rhs )
1326 1453 DEALLOCATE( j_K_rhs )
... ... @@ -1330,8 +1457,8 @@ DEALLOCATE ( x )
1330 1457 DEALLOCATE ( x_tmp )
1331 1458 DEALLOCATE ( b_tmp )
1332 1459 DEALLOCATE ( v_tmp )
1333   -DEALLOCATE ( K )
1334   -DEALLOCATE ( KI )
  1460 +if ( ALLOCATED(K) ) DEALLOCATE ( K )
  1461 +if ( ALLOCATED(KI) ) DEALLOCATE ( KI )
1335 1462 DEALLOCATE ( K_rhs )
1336 1463  
1337 1464 DEALLOCATE( phi )
... ...
SRC/PUL_PARAMETER_CALCULATION/Makefile
1 1 default: $(PUL_PARAMETER_CALCULATION_OBJS)
2 2 #
3 3 $(OBJ_MOD_DIR)/%.o: %.F90 $(TYPE_SPEC_MODULE) $(CONSTANTS_MODULE) $(GENERAL_MODULE) \
4   - PUL_analytic.F90 PUL_LC_Laplace.F90 Laplace.F90
  4 + PUL_analytic.F90 PUL_LC_Laplace.F90 Laplace.F90 Aprod.F90 CG_solve.F90
5 5 $(FC) $(FLAGS) -c -o $@ $<
... ...
SRC/PUL_PARAMETER_CALCULATION/PUL_LC_Laplace.F90
... ... @@ -57,8 +57,9 @@
57 57 ! 14/10/2017 CJS make the filter fitting minimum aorder=1, border=0 and
58 58 ! ensure that border=aorder-1 to make the choice of model order more sensible
59 59 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
  60 +! 4/3/2018 CJS Start to include the infinite ground plane option
60 61 !
61   -!
  62 +! 16/3/2018 CJS add offset to x and y for shapes. Relates to ML_flex cables
62 63 !
63 64 SUBROUTINE PUL_LC_Laplace(PUL,name,fit_order,freq_spec,domain)
64 65 !
... ... @@ -89,6 +90,8 @@ IMPLICIT NONE
89 90  
90 91 ! flags to indicate the configuration
91 92 logical :: ground_plane
  93 + logical :: finite_ground_plane
  94 + logical :: infinite_ground_plane
92 95 logical :: overshield
93 96 logical :: open_boundary
94 97  
... ... @@ -115,16 +118,20 @@ IMPLICIT NONE
115 118 ! variables required for generating the gmsh geometry input file: we may be able to simplify
116 119 ! things here as there is some overlap with the PUL structure
117 120 integer,allocatable :: shape_type(:) ! holds a nuber which indicates the shape type
  121 + integer,allocatable :: loop_number(:) ! holds the loop number for this shape
118 122 real(dp),allocatable :: x(:) ! x coordinate of the centre of the cable to which this shape belongs
119 123 real(dp),allocatable :: y(:) ! y coordinate of the centre of the cable to which this shape belongs
120 124 real(dp),allocatable :: r(:) ! radius of a circular shape or curve radius for a Dshape
121 125 real(dp),allocatable :: rw(:) ! width1 (x dimension) of rectangular/ Dshape
122 126 real(dp),allocatable :: rw2(:) ! width2 (x dimension) of rectangular/ Dshape
123 127 real(dp),allocatable :: rh(:) ! height (y dimension) of rectangular shape
124   - real(dp),allocatable :: ro(:) ! offset in the x direction of this shape from the centre (x():),y(:) above)
  128 + real(dp),allocatable :: rox(:) ! offset in the x direction of this shape from the centre (x():),y(:) above)
  129 + real(dp),allocatable :: roy(:) ! offset in the y direction of this shape from the centre (x():),y(:) above)
125 130 real(dp),allocatable :: rtheta(:) ! rotation angle of conductor
126 131 real(dp),allocatable :: dl(:) ! edge length for the mesh on this shape
127 132 logical,allocatable :: conductor_has_dielectric(:) ! flag to indicate that a conductor has a dielectric around it
  133 +
  134 + real(dp) :: dl_local ! edge length for the mesh at rectangle edge centre
128 135  
129 136 complex(dp) :: epsr ! relative permittivity value
130 137  
... ... @@ -151,6 +158,7 @@ IMPLICIT NONE
151 158 real(dp) :: rl,rt,rdl,rx1,rx2,ry1,ry2
152 159 real(dp) :: xp,yp,xt,yt
153 160 integer :: p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12
  161 + real(dp) :: edge_length
154 162  
155 163 character(LEN=filename_length) :: command ! string used for the command which runs gmsh from the shell
156 164 integer :: gmsh_exit_stat ! exit status from the shell command which runs gmsh.
... ... @@ -171,6 +179,8 @@ IMPLICIT NONE
171 179 logical :: dielectric_defined ! flag to indicate whether there is a dielectric
172 180 logical :: frequency_dependent_dielectric ! flag to indicate whether there is a frequency dependent dielectric
173 181  
  182 + integer :: gpline1,gpline2 ! line segments for infinite ground plane
  183 +
174 184 integer :: row,col ! loop variables for matrix elements
175 185  
176 186 integer :: i,ii ! temporary loop variables
... ... @@ -181,9 +191,11 @@ IMPLICIT NONE
181 191 ! STAGE 1: work out the configuration for the calculation i.e. is there a ground plane, is the outer boundary free space or a conductor (overshield)
182 192  
183 193 ground_plane=.FALSE.
  194 + infinite_ground_plane=.FALSE.
  195 + finite_ground_plane=.FALSE.
184 196 overshield=.FALSE.
185 197 open_boundary=.FALSE.
186   -
  198 +
187 199 if ((.NOT.PUL%overshield_present).AND.(.NOT.PUL%ground_plane_present)) then
188 200  
189 201 ! SOLUTION TYPE 1: NO OVERSHIELD, NO GROUND PLANE
... ... @@ -200,10 +212,16 @@ IMPLICIT NONE
200 212 ! SOLUTION TYPE 2: NO OVERSHIELD, WITH GROUND PLANE
201 213  
202 214 ground_plane=.TRUE.
  215 + if (inf_gnd) then
  216 + infinite_ground_plane=.TRUE.
  217 + else
  218 + finite_ground_plane=.TRUE.
  219 + end if
  220 +
  221 + tot_n_boundaries_without_dielectric=PUL%n_conductors+1 ! add a free space boundary
203 222 first_surface_is_free_space_boundary=.TRUE.
204 223 end_conductor_loop=PUL%n_conductors-1 ! the ground plane is not included here - added separately
205   - end_conductor_to_dielectric_loop=PUL%n_conductors
206   - tot_n_boundaries_without_dielectric=PUL%n_conductors+1 ! add a free space boundary
  224 + end_conductor_to_dielectric_loop=PUL%n_conductors
207 225 first_conductor_shape=2 ! shape 1 is for the outer boundary
208 226  
209 227 else
... ... @@ -221,6 +239,8 @@ IMPLICIT NONE
221 239  
222 240 if (verbose) then
223 241 write(*,*)'ground_plane:',ground_plane
  242 + write(*,*)'infinite_ground_plane:',infinite_ground_plane
  243 + write(*,*)'finite_ground_plane:',finite_ground_plane
224 244 write(*,*)'open_boundary:',open_boundary
225 245 write(*,*)'overshield:',overshield
226 246 write(*,*)'first_surface_is_free_space_boundary:',first_surface_is_free_space_boundary
... ... @@ -304,13 +324,16 @@ IMPLICIT NONE
304 324 n_shapes=tot_n_boundaries
305 325 ALLOCATE( shape_type(1:n_shapes) )
306 326 shape_type(1:n_shapes)=circle ! set all boudaries to type circle initially
  327 + ALLOCATE( loop_number(1:n_shapes) )
  328 + loop_number(1:n_shapes)=-1 ! set all boudaries to -1 i.e. not set
307 329 ALLOCATE( x(1:n_shapes) )
308 330 ALLOCATE( y(1:n_shapes) )
309 331 ALLOCATE( r(1:n_shapes) )
310 332 ALLOCATE( rw(1:n_shapes) )
311 333 ALLOCATE( rw2(1:n_shapes) )
312 334 ALLOCATE( rh(1:n_shapes) )
313   - ALLOCATE( ro(1:n_shapes) )
  335 + ALLOCATE( rox(1:n_shapes) )
  336 + ALLOCATE( roy(1:n_shapes) )
314 337 ALLOCATE( rtheta(1:n_shapes) )
315 338 ALLOCATE( dl(1:n_shapes) )
316 339 ALLOCATE( shape_to_region(1:n_shapes,1:2) )
... ... @@ -332,17 +355,17 @@ IMPLICIT NONE
332 355 do i=1,end_conductor_loop ! if the last conductor is the ground plane it is included in x/y,max/min calculation later
333 356 if (PUL%shape(i).EQ.circle) then
334 357  
335   - xmin=min(xmin,PUL%x(i)-PUL%r(i)+PUL%o(i))
336   - xmax=max(xmax,PUL%x(i)+PUL%r(i)+PUL%o(i))
337   - ymin=min(ymin,PUL%y(i)-PUL%r(i))
338   - ymax=max(ymax,PUL%y(i)+PUL%r(i))
  358 + xmin=min(xmin,PUL%x(i)-PUL%r(i)+PUL%ox(i))
  359 + xmax=max(xmax,PUL%x(i)+PUL%r(i)+PUL%ox(i))
  360 + ymin=min(ymin,PUL%y(i)-PUL%r(i)+PUL%oy(i))
  361 + ymax=max(ymax,PUL%y(i)+PUL%r(i)+PUL%oy(i))
339 362  
340 363 else if (PUL%shape(i).EQ.rectangle) then
341 364  
342   - xmin=min(xmin,PUL%x(i)-PUL%rw(i)+PUL%o(i))
343   - xmax=max(xmax,PUL%x(i)+PUL%rw(i)+PUL%o(i))
344   - ymin=min(ymin,PUL%y(i)-PUL%rh(i))
345   - ymax=max(ymax,PUL%y(i)+PUL%rh(i))
  365 + xmin=min(xmin,PUL%x(i)-PUL%rw(i)+PUL%ox(i))
  366 + xmax=max(xmax,PUL%x(i)+PUL%rw(i)+PUL%ox(i))
  367 + ymin=min(ymin,PUL%y(i)-PUL%rh(i)+PUL%oy(i))
  368 + ymax=max(ymax,PUL%y(i)+PUL%rh(i)+PUL%oy(i))
346 369  
347 370 else if (PUL%shape(i).EQ.Dshape) then
348 371  
... ... @@ -352,13 +375,17 @@ IMPLICIT NONE
352 375 ymin=min(ymin,PUL%y(i)-PUL%rh(i))
353 376 ymax=max(ymax,PUL%y(i)+PUL%rh(i))
354 377  
355   - else
  378 +! note don't check semicircle as this is only for infinite ground only
  379 +
  380 + else if (PUL%shape(i).NE.semicircle) then
  381 +
356 382 write(*,*)'Unknown shape type',PUL%shape(i)
  383 +
357 384 end if
358 385 end do ! next conductor
359 386  
360 387 if (ground_plane) then
361   -! include the ground plane in the bundle sizing
  388 +! include the ground plane in the bundle sizing by adding the origin point
362 389 ! here we assume that the ground plane is along the x axis.
363 390  
364 391 xmin=min(xmin,0d0)
... ... @@ -382,21 +409,48 @@ IMPLICIT NONE
382 409 write(*,*)'boundary radius=',rboundary
383 410 end if
384 411  
385   -! set the first shape information to relate to the outer boundary, this is a circle, centred on the bundle centre
  412 +! set the first shape information to relate to the outer boundary
  413 +!
  414 +! If we have a finite gound plane of free space boundary then this is a circle, centred on the bundle centre
386 415 ! note that for the Laplace calculation the geometry will be shifted so that the origin is at xc,yc so the
387 416 ! free space outer boundary is centred on the origin. This is required for the free space boundary condition in Laplace to work correctly.
388 417  
389   - x(1)=xc
390   - y(1)=yc
391   - r(1)=rboundary
392   - rw(1)=0d0
393   - rw2(1)=0d0
394   - rh(1)=0d0
395   - ro(1)=0d0
396   - rtheta(1)=0d0
397   - dl(1)=r(1)/(2*Laplace_surface_mesh_constant)
398   - shape_to_region(1,inside) =0 ! inside is the dielectric region
399   - shape_to_region(1,outside)=-1 ! no outside region
  418 + if (.NOT.infinite_ground_plane) then
  419 +
  420 + x(1)=xc
  421 + y(1)=yc
  422 + r(1)=rboundary
  423 + rw(1)=0d0
  424 + rw2(1)=0d0
  425 + rh(1)=0d0
  426 + rox(1)=0d0
  427 + roy(1)=0d0
  428 + rtheta(1)=0d0
  429 + dl(1)=r(1)/(2*Laplace_surface_mesh_constant)
  430 + shape_to_region(1,inside) =0 ! inside is the dielectric region
  431 + shape_to_region(1,outside)=-1 ! no outside region
  432 +
  433 + else
  434 +!
  435 +! If we have an infinite ground plane then we have a semicircle centred on the origin
  436 +
  437 + shape_type(1)=semicircle
  438 + xc=0d0
  439 + yc=0d0
  440 + x(1)=xc
  441 + y(1)=yc
  442 + r(1)=rboundary
  443 + rw(1)=0d0
  444 + rw2(1)=0d0
  445 + rh(1)=0d0
  446 + rox(1)=0d0
  447 + roy(1)=0d0
  448 + rtheta(1)=0d0
  449 + dl(1)=r(1)/(2*Laplace_surface_mesh_constant)
  450 + shape_to_region(1,inside) =0 ! inside is the dielectric region
  451 + shape_to_region(1,outside)=-1 ! no outside region
  452 +
  453 + end if ! infinite ground plane
400 454  
401 455 else ! there is an overshield specified so we do not need to offset the bundle to define a free space outer boundary
402 456  
... ... @@ -418,7 +472,8 @@ IMPLICIT NONE
418 472 rw(shape)=PUL%rw(i)
419 473 rw2(shape)=PUL%rw2(i)
420 474 rh(shape)=PUL%rh(i)
421   - ro(shape)=PUL%o(i)
  475 + rox(shape)=PUL%ox(i)
  476 + roy(shape)=PUL%oy(i)
422 477 rtheta(shape)=PUL%rtheta(i)
423 478 if (shape_type(shape).EQ.circle) then
424 479 dl(shape)=r(shape)/Laplace_surface_mesh_constant
... ... @@ -426,6 +481,8 @@ IMPLICIT NONE
426 481 dl(shape)=min(rw(shape),rh(shape))/Laplace_surface_mesh_constant
427 482 else if (shape_type(shape).EQ.Dshape) then
428 483 dl(shape)=r(shape)/(2D0*Laplace_surface_mesh_constant)
  484 + else if (shape_type(shape).EQ.semicircle) then
  485 + dl(shape)=r(shape)/Laplace_surface_mesh_constant
429 486 else
430 487 write(*,*)'Unknown shape type',shape_type(shape),' i=',i,' shape=',shape
431 488 end if
... ... @@ -434,22 +491,46 @@ IMPLICIT NONE
434 491 if (ground_plane) then ! Add the ground plane information
435 492  
436 493 shape=PUL%n_conductors+1 ! ground plane
437   - shape_type(shape)=rectangle
438   -
439   - rl=rboundary*Laplace_ground_plane_ratio ! width of the ground plane (x dimension) see constants.F90 for parameter
440   - rt=rl*Laplace_ground_plane_thickness_ratio ! height of the ground plane (y dimension) see constants.F90 for parameter
441   - rdl=rt/2d0
442   - x(shape)=xc ! x centre of ground plane rectangle
443   - y(shape)=-rt ! y centre of ground plane rectangle
444   - r(shape)=0d0 ! not used
445   - rw(shape)=rl*2d0 ! x extent of the ground plane
446   - rw2(shape)=rw(shape) ! x extent of the ground plane
447   - rh(shape)=rt*2d0 ! y extent of the ground plane
448   - ro(shape)=0d0 ! no offset from centre
449   - rtheta(shape)=0d0 ! always zero for ground plane
450   - dl(shape)=rdl ! this is the thickness of the ground plane
451   - shape_to_region(shape,inside) =-1 ! no internal region
452   - shape_to_region(shape,outside) = 0 ! no dielectric so a free space region
  494 +
  495 + if (finite_ground_plane) then
  496 +
  497 + shape_type(shape)=rectangle
  498 + rl=rboundary*Laplace_ground_plane_ratio ! width of the ground plane (x dimension) see constants.F90 for parameter
  499 + rt=rl*Laplace_ground_plane_thickness_ratio ! height of the ground plane (y dimension) see constants.F90 for parameter
  500 + rdl=rt/2d0
  501 + x(shape)=xc ! x centre of ground plane rectangle
  502 + y(shape)=-rt ! y centre of ground plane rectangle
  503 + r(shape)=0d0 ! not used
  504 + rw(shape)=rl*2d0 ! x extent of the ground plane
  505 + rw2(shape)=rw(shape) ! x extent of the ground plane
  506 + rh(shape)=rt*2d0 ! y extent of the ground plane
  507 + rox(shape)=0d0 ! no offset from centre
  508 + roy(shape)=0d0 ! no offset from centre
  509 + rtheta(shape)=0d0 ! always zero for ground plane
  510 + dl(shape)=rdl ! this is the thickness of the ground plane
  511 + shape_to_region(shape,inside) =-1 ! no internal region
  512 + shape_to_region(shape,outside) = 0 ! no dielectric so a free space region
  513 +
  514 + else
  515 +
  516 + shape_type(shape)=semicircle_diameter
  517 + rl=0d0 ! not used
  518 + rt=0d0 ! not used
  519 + rdl=0d0 ! not used
  520 + x(shape)=0d0 ! x centre of ground plane
  521 + y(shape)=0d0 ! y centre of ground plane
  522 + r(shape)=rboundary ! semicircle radius
  523 + rw(shape)=0d0 ! not used
  524 + rw2(shape)=0d0 ! not used
  525 + rh(shape)=0d0 ! not used
  526 + rox(shape)=0d0 ! no offset from centre
  527 + roy(shape)=0d0 ! no offset from centre
  528 + rtheta(shape)=0d0 ! always zero for infinite ground plane
  529 + dl(shape)=r(1)/(2*Laplace_surface_mesh_constant)
  530 + shape_to_region(shape,inside) =-1 ! no internal region
  531 + shape_to_region(shape,outside) = 0 ! no dielectric so a free space region
  532 +
  533 + end if ! infinite ground plane
453 534  
454 535 else if (overshield) then ! Add the overshield conductor information
455 536  
... ... @@ -461,7 +542,8 @@ IMPLICIT NONE
461 542 rw(shape)=PUL%overshield_w
462 543 rw2(shape)=PUL%overshield_w2
463 544 rh(shape)=PUL%overshield_h
464   - ro(shape)=0d0
  545 + rox(shape)=0d0
  546 + roy(shape)=0d0
465 547 rtheta(shape)=0d0
466 548 dl(shape)=r(shape)/(2d0*Laplace_surface_mesh_constant)
467 549 shape_to_region(shape,inside) = 0 ! inside the overshield is the free space region
... ... @@ -489,7 +571,8 @@ IMPLICIT NONE
489 571 rw(shape)=PUL%rdw(i)
490 572 rw2(shape)=PUL%rw2(i)
491 573 rh(shape)=PUL%rdh(i)
492   - ro(shape)=PUL%rdo(i)
  574 + rox(shape)=PUL%rdox(i)
  575 + roy(shape)=PUL%rdoy(i)
493 576 rtheta(shape)=PUL%rtheta(i)
494 577  
495 578 if (shape_type(shape).EQ.circle) then
... ... @@ -525,8 +608,8 @@ IMPLICIT NONE
525 608 ! calculate the centre of the conductor (the test point)
526 609  
527 610 ! xp,yp is the coordinate of the centre of the conductor relative to the centre of the cable
528   - xp=ro(conductor_shape)
529   - yp=0d0
  611 + xp=rox(conductor_shape)
  612 + yp=roy(conductor_shape)
530 613  
531 614 ! rotate the cable about it's origin then translate to the cable position to give the final conductor position
532 615 xt=x(conductor_shape)+xp*cos(rtheta(conductor_shape))-yp*sin(rtheta(conductor_shape))
... ... @@ -537,7 +620,8 @@ IMPLICIT NONE
537 620 dielectric_region=dielectric_region+1
538 621  
539 622 ! check whether the conductor is inside the dielectric
540   - if (point_is_inside(xt,yt,shape_type(shape),x(shape),y(shape),r(shape),rh(shape),rw(shape),ro(shape),rtheta(shape))) then
  623 + if (point_is_inside(xt,yt,shape_type(shape),x(shape),y(shape),r(shape),rh(shape),rw(shape), &
  624 + rox(shape),roy(shape),rtheta(shape))) then
541 625  
542 626 shape_to_region(conductor_shape,outside) =dielectric_region
543 627  
... ... @@ -581,56 +665,121 @@ IMPLICIT NONE
581 665  
582 666 write(gmsh_geometry_file_unit,*)' // circle ',i
583 667 point=point+1
584   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+ro(i),',' ,y(i)-yc,',',0.0,',' ,dl(i),' };'
  668 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i),',' &
  669 + ,y(i)-yc+roy(i),',',0.0,',' ,dl(i),' };'
585 670 point=point+1
586   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+ro(i),',' ,y(i)-yc-r(i),',',0.0,',',dl(i),' };'
  671 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i),',' &
  672 + ,y(i)-yc-r(i)+roy(i),',',0.0,',',dl(i),' };'
587 673 point=point+1
588   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+ro(i)+r(i),',',y(i)-yc,',',0.0,',' ,dl(i),' };'
  674 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i)+r(i),',' &
  675 + ,y(i)-yc+roy(i),',',0.0,',' ,dl(i),' };'
589 676 point=point+1
590   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+ro(i),',' ,y(i)-yc+r(i),',',0.0,',',dl(i),' };'
  677 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i),',' &
  678 + ,y(i)-yc+r(i)+roy(i),',',0.0,',',dl(i),' };'
591 679 point=point+1
592   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+ro(i)-r(i),',',y(i)-yc,',',0.0,',' ,dl(i),' };'
  680 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i)-r(i),',' &
  681 + ,y(i)-yc+roy(i),',',0.0,',' ,dl(i),' };'
593 682  
594 683 else if (shape_type(i).EQ.rectangle) then
595 684  
596 685 write(gmsh_geometry_file_unit,*)' // rectangle ',i
597   - point=point+1
598   -
599   - xt=rw(i)/2d0+ro(i)
600   - yt=rh(i)/2d0
  686 +
  687 +! corner point
  688 + point=point+1
  689 + xt=rw(i)/2d0+rox(i)
  690 + yt=rh(i)/2d0+roy(i)
601 691 xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
602 692 yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
603   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl(i),' };'
604   - point=point+1
605   -
606   - xt=-rw(i)/2d0+ro(i)
607   - yt=rh(i)/2d0
  693 + edge_length=min(max_mesh_edge_length,dl(i))
  694 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',edge_length,' };'
  695 +
  696 +! edge centre point
  697 + point=point+1
  698 + xt=rox(i)
  699 + yt=rh(i)/2d0+roy(i)
608 700 xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
609 701 yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
610   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl(i),' };'
611   - point=point+1
612   -
613   - xt=-rw(i)/2d0+ro(i)
614   - yt=-rh(i)/2d0
  702 + dl_local=min(max_mesh_edge_length,rw(i)/Laplace_surface_mesh_constant)
  703 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl_local,' };'
  704 +
  705 +! corner point
  706 + point=point+1
  707 + xt=-rw(i)/2d0+rox(i)
  708 + yt=rh(i)/2d0+roy(i)
615 709 xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
616 710 yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
617   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl(i),' };'
618   - point=point+1
619   -
620   - xt=rw(i)/2d0+ro(i)
621   - yt=-rh(i)/2d0
  711 + edge_length=min(max_mesh_edge_length,dl(i))
  712 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',edge_length,' };'
  713 +
  714 +! edge centre point
  715 + point=point+1
  716 + xt=-rw(i)/2d0+rox(i)
  717 + yt=roy(i)
  718 + xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
  719 + yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
  720 + dl_local=min(max_mesh_edge_length,rh(i)/Laplace_surface_mesh_constant)
  721 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl_local,' };'
  722 +
  723 +! corner point
  724 + point=point+1
  725 + xt=-rw(i)/2d0+rox(i)
  726 + yt=-rh(i)/2d0+roy(i)
  727 + xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
  728 + yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
  729 + edge_length=min(max_mesh_edge_length,dl(i))
  730 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',edge_length,' };'
  731 +
  732 +! edge centre point
  733 + point=point+1
  734 + xt=rox(i)
  735 + yt=-rh(i)/2d0+roy(i)
  736 + xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
  737 + yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
  738 + dl_local=min(max_mesh_edge_length,rw(i)/Laplace_surface_mesh_constant)
  739 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl_local,' };'
  740 +
  741 +! corner point
  742 + point=point+1
  743 + xt=rw(i)/2d0+rox(i)
  744 + yt=-rh(i)/2d0+roy(i)
622 745 xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
623 746 yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
624   - write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl(i),' };'
  747 + edge_length=min(max_mesh_edge_length,dl(i))
  748 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',edge_length,' };'
  749 +
  750 +! edge centre point
  751 + point=point+1
  752 + xt=rw(i)/2d0+rox(i)
  753 + yt=roy(i)
  754 + xp=x(i)-xc+xt*cos(rtheta(i))-yt*sin(rtheta(i))
  755 + yp=y(i)-yc+xt*sin(rtheta(i))+yt*cos(rtheta(i))
  756 + dl_local=min(max_mesh_edge_length,rh(i)/Laplace_surface_mesh_constant)
  757 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl_local,' };'
625 758  
626 759 else if (shape_type(i).EQ.Dshape) then
627 760  
628   - CALL write_Dshape_gmsh(x(i),y(i),rw(i),rw2(i),rh(i),r(i),ro(i),rtheta(i),dl(i),point,i,gmsh_geometry_file_unit)
  761 + CALL write_Dshape_gmsh(x(i),y(i),rw(i),rw2(i),rh(i),r(i),rox(i),roy(i),rtheta(i),dl(i),point,i,gmsh_geometry_file_unit)
  762 +
  763 + else if (shape_type(i).EQ.semicircle) then
629 764  
630   - end if
  765 + write(gmsh_geometry_file_unit,*)' // semicircle ',i
  766 + point=point+1
  767 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i),',' &
  768 + ,y(i)-yc+roy(i),',',0.0,',' ,dl(i),' };'
  769 + point=point+1
  770 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i)+r(i),',' &
  771 + ,y(i)-yc+roy(i),',',0.0,',',dl(i),' };'
  772 + point=point+1
  773 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i) ,',' &
  774 + ,y(i)-yc+r(i)+roy(i),',',0.0,',' ,dl(i),' };'
  775 + point=point+1
  776 + write(gmsh_geometry_file_unit,*)'Point(',point,' ) = {',x(i)-xc+rox(i)-r(i),',' &
  777 + ,y(i)-yc+roy(i),',',0.0,',',dl(i),' };'
631 778  
  779 + end if
  780 +
632 781 end do ! next shape
633   -
  782 +
634 783 ! write the boudary line segment definitions for each shape, these are constructed from the previously defined points
635 784  
636 785 write(gmsh_geometry_file_unit,*)' '
... ... @@ -666,6 +815,10 @@ IMPLICIT NONE
666 815 p2=point+2
667 816 p3=point+3
668 817 p4=point+4
  818 + p5=point+5
  819 + p6=point+6
  820 + p7=point+7
  821 + p8=point+8
669 822  
670 823 write(gmsh_geometry_file_unit,*)' // rectangle line segments ',i
671 824 line=line+1
... ... @@ -675,9 +828,17 @@ IMPLICIT NONE
675 828 line=line+1
676 829 write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p3,',',p4,' };'
677 830 line=line+1
678   - write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p4,',',p1,' };'
  831 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p4,',',p5,' };'
  832 + line=line+1
  833 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p5,',',p6,' };'
  834 + line=line+1
  835 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p6,',',p7,' };'
  836 + line=line+1
  837 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p7,',',p8,' };'
  838 + line=line+1
  839 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p8,',',p1,' };'
679 840  
680   - point=point+4
  841 + point=point+8
681 842  
682 843 else if (shape_type(i).EQ.Dshape) then
683 844  
... ... @@ -713,7 +874,36 @@ IMPLICIT NONE
713 874 write(gmsh_geometry_file_unit,*)'Circle(',line,' ) = {',p11,',',p12,',',p1,' };'
714 875  
715 876 point=point+12
716   -
  877 +
  878 + else if (shape_type(i).EQ.semicircle) then
  879 +
  880 + p1=point+1
  881 + p2=point+2
  882 + p3=point+3
  883 + p4=point+4
  884 +
  885 + write(gmsh_geometry_file_unit,*)' // semicircle ',i
  886 + line=line+1
  887 + write(gmsh_geometry_file_unit,*)'Circle(',line,' ) = {',p2,',',p1,',',p3,' };'
  888 + line=line+1
  889 + write(gmsh_geometry_file_unit,*)'Circle(',line,' ) = {',p3,',',p1,',',p4,' };'
  890 +
  891 + point=point+4
  892 +
  893 + else if (shape_type(i).EQ.semicircle_diameter) then
  894 +! this is the infinite ground plane line so pick points from the outer boundary circle
  895 + p1=4 ! semicircle end point 2
  896 + p2=1 ! centre
  897 + p3=2 ! semicircle end point 1
  898 +
  899 + write(gmsh_geometry_file_unit,*)' // semicircle_diameter ',i
  900 + line=line+1
  901 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p1,',',p2,' };'
  902 + gpline1=line
  903 + line=line+1
  904 + write(gmsh_geometry_file_unit,*)'Line(',line,' ) = {',p2,',',p3,' };'
  905 + gpline2=line
  906 +
717 907 end if
718 908  
719 909 end do ! next shape
... ... @@ -728,10 +918,11 @@ IMPLICIT NONE
728 918 line_loop=0 ! initialise line_loop counter
729 919 line=0 ! reset the line counter to the first line
730 920 do i=1,n_shapes
731   -
732   - line_loop=line_loop+1
  921 +
  922 + if ( (shape_type(i).EQ.circle) ) then
733 923  
734   - if ( (shape_type(i).EQ.circle).OR.(shape_type(i).EQ.rectangle) ) then
  924 + line_loop=line_loop+1
  925 + loop_number(i)=line_loop
735 926  
736 927 write(gmsh_geometry_file_unit,*)'Line Loop(',line_loop,' ) = {',line+1,',',line+2,',',line+3,',',line+4,' };'
737 928  
... ... @@ -739,11 +930,46 @@ IMPLICIT NONE
739 930 do ii=1,4
740 931 write(boundary_file_unit,*)line+ii,i,' # boundary segment number and boundary number'
741 932 end do
742   -
  933 +
743 934 line=line+4
  935 +
  936 + else if ( shape_type(i).EQ.rectangle ) then
  937 +
  938 + line_loop=line_loop+1
  939 + loop_number(i)=line_loop
  940 +
  941 + write(gmsh_geometry_file_unit,*)'Line Loop(',line_loop,' ) = {',line+1,',',line+2,',',line+3,',',line+4,',', &
  942 + line+5,',',line+6,',',line+7,',',line+8,' };'
  943 +
  944 +! write the boundary segment and the boundary number to the boundary file
  945 + do ii=1,8
  946 + write(boundary_file_unit,*)line+ii,i,' # boundary segment number and boundary number'
  947 + end do
  948 +
  949 + line=line+8
  950 +
  951 + else if (shape_type(i).EQ.semicircle) then
  952 +
  953 +! this is the outer boundary with infinite ground plane.
  954 +! the line loop consists of 4 lines, 2 for the semicircle and 2 for the ground plane
  955 +
  956 + line_loop=line_loop+1
  957 + loop_number(i)=line_loop
  958 +
  959 + write(gmsh_geometry_file_unit,*)'Line Loop(',line_loop,' ) = {',line+1,',',line+2,',',gpline1,',',gpline2,' };'
  960 +
  961 +! write the boundary segment and the boundary number to the boundary file
  962 + do ii=1,2
  963 + write(boundary_file_unit,*)line+ii,i,' # boundary segment number and boundary number'
  964 + end do
  965 +
  966 + line=line+2
744 967  
745 968 else if (shape_type(i).EQ.Dshape) then
746 969  
  970 + line_loop=line_loop+1
  971 + loop_number(i)=line_loop
  972 +
747 973 write(gmsh_geometry_file_unit,*)'Line Loop(',line_loop,' ) = {',line+1,',',line+2,',',line+3,',',line+4,',', &
748 974 line+5,',',line+6,',',line+7,',',line+8,' };'
749 975  
... ... @@ -753,6 +979,18 @@ IMPLICIT NONE
753 979 end do
754 980  
755 981 line=line+8
  982 +
  983 +
  984 + else if (shape_type(i).EQ.semicircle_diameter) then
  985 +! note there is no line loop for the semicircle_diameter shape as this is dealt with along with the semicircle
  986 +! just skip these lines
  987 +
  988 +! write the boundary segment and the boundary number to the boundary file
  989 + do ii=1,2
  990 + write(boundary_file_unit,*)line+ii,i,' # boundary segment number and boundary number'
  991 + end do
  992 +
  993 + line=line+2
756 994  
757 995 end if
758 996  
... ... @@ -766,6 +1004,7 @@ IMPLICIT NONE
766 1004 surface=0 ! initialise surface counter
767 1005  
768 1006 ! loop over the dielectric regions (including free space) as each one contributes a surface to be meshed.
  1007 +
769 1008 do dielectric_region=0,n_dielectric_regions ! 0 is the free space region which always exists
770 1009  
771 1010 surface=surface+1
... ... @@ -785,32 +1024,39 @@ IMPLICIT NONE
785 1024 ! The overshield reference conductor should be the last conductor
786 1025  
787 1026 i=PUL%n_conductors
  1027 + line_loop=loop_number(i)
788 1028 if( (shape_to_region(i,inside).EQ.dielectric_region).OR. &
789 1029 (shape_to_region(i,outside).EQ.dielectric_region) ) then
790   - CALL add_integer_to_string(string1,i,string2)
  1030 + CALL add_integer_to_string(string1,line_loop,string2)
791 1031 string1=trim(string2)//', '
792 1032 end if
793 1033  
794 1034 end if ! overshield
795   -
796   - do i=1,n_shapes
  1035 +
  1036 + do i=1,n_shapes ! don't include ground plane in check
  1037 + line_loop=loop_number(i)
797 1038 if ((.NOT.overshield).OR.(i.NE.PUL%n_conductors)) then
798 1039 if( (shape_to_region(i,inside).EQ.dielectric_region).OR. &
799   - (shape_to_region(i,outside).EQ.dielectric_region) ) then
800   - CALL add_integer_to_string(string1,i,string2)
801   - string1=trim(string2)//', '
  1040 + (shape_to_region(i,outside).EQ.dielectric_region) ) then
  1041 + if (line_loop.GT.0) then
  1042 + CALL add_integer_to_string(string1,line_loop,string2)
  1043 + string1=trim(string2)//', '
  1044 + end if
802 1045 end if
803 1046 end if
804   - end do ! next shape
  1047 + end do ! next shape
805 1048  
806   - else
  1049 + else ! not the fisrt surface
807 1050 ! dielectric boundaries are defined second so reverse the order of the loop for dielectric regions
808 1051  
809 1052 do i=n_shapes,1,-1
  1053 + line_loop=loop_number(i)
810 1054 if( (shape_to_region(i,inside).EQ.dielectric_region).OR. &
811   - (shape_to_region(i,outside).EQ.dielectric_region) ) then
812   - CALL add_integer_to_string(string1,i,string2)
813   - string1=trim(string2)//', '
  1055 + (shape_to_region(i,outside).EQ.dielectric_region) ) then
  1056 + if (line_loop.GT.0) then
  1057 + CALL add_integer_to_string(string1,line_loop,string2)
  1058 + string1=trim(string2)//', '
  1059 + end if
814 1060 end if
815 1061 end do
816 1062  
... ... @@ -834,13 +1080,15 @@ IMPLICIT NONE
834 1080 ! Dealllocate the local shape geometry data.
835 1081  
836 1082 if (allocated( shape_type )) DEALLOCATE( shape_type )
  1083 + if (allocated( loop_number )) DEALLOCATE( loop_number )
837 1084 if (allocated( x )) DEALLOCATE( x )
838 1085 if (allocated( y )) DEALLOCATE( y )
839 1086 if (allocated( r )) DEALLOCATE( r )
840 1087 if (allocated( rw )) DEALLOCATE( rw )
841 1088 if (allocated( rw2 )) DEALLOCATE( rw2 )
842 1089 if (allocated( rh )) DEALLOCATE( rh )
843   - if (allocated( ro )) DEALLOCATE( ro )
  1090 + if (allocated( rox )) DEALLOCATE( rox )
  1091 + if (allocated( roy )) DEALLOCATE( roy )
844 1092 if (allocated( rtheta )) DEALLOCATE( rtheta )
845 1093 if (allocated( dl )) DEALLOCATE( dl )
846 1094 if (allocated( shape_to_region )) DEALLOCATE( shape_to_region )
... ...
SRC/PUL_PARAMETER_CALCULATION/PUL_parameter_module.F90
... ... @@ -40,6 +40,14 @@
40 40 !PUL_analytic.F90: SUBROUTINE PUL_LC_calc_overshield_wide_separation_approximation
41 41 !PUL_analytic.F90: SUBROUTINE calculate_height_over_ground_plane
42 42 !PUL_LC_Laplace.F90: SUBROUTINE PUL_LC_Laplace
  43 +!Aprod.F90: SUBROUTINE Aprod
  44 +!Aprod.F90: SUBROUTINE ATprod
  45 +!Aprod.F90: SUBROUTINE zAprod
  46 +!Aprod.F90: SUBROUTINE zATprod
  47 +!CG_solve.F90: SUBROUTINE solve_real_symm(n, b, x,tol)
  48 +!CG_solve.F90: SUBROUTINE solve_complex_symm(n, b, x,tol)
  49 +!
  50 +!
43 51 !
44 52 ! NAME
45 53 ! MODULE PUL_parameters
... ... @@ -47,13 +55,18 @@
47 55 ! Data relating to the calculation of PUL_parameters
48 56 !
49 57 ! COMMENTS
50   -!
  58 +! The conjugate gradient solutions are included in this module rather than the maths module
  59 +! as they are intimately linked with the matrix-vector product subroutine which in turn relies
  60 +! on the sparse matrix storage structure in this module
51 61 !
52 62 ! HISTORY
53 63 ! started 25/11/2015 CJS
54 64 ! 30/3/2016 CJS fix factor of 2 in mutual inductance of wires over ground plane
55 65 ! 18_4_2016 CJS include calculation for conductors within a cylindrical shield for oversheild domains
56 66 ! 5_7_2016 CJS include numerical Laplace solver for L,C,G in inhomogeneous regions
  67 +! 13/3/2018CJS include iterative solver stuff based on Stanford University symmlq.f
  68 +! 16/3/2018 CJS add y offset for ML_flex_cable (PUL%ox, and PUL%oy)(PUL%rdox, and PUL%rdoy)
  69 +! 19/6/2018 CJS include iterative sparse matrix solver based on the biconjugate gradient method
57 70 !
58 71 MODULE PUL_parameter_module
59 72  
... ... @@ -74,14 +87,16 @@ TYPE::PUL_type
74 87 real(dp),allocatable :: r(:) ! radius of a circular conductor
75 88 real(dp),allocatable :: x(:) ! x coordinate of the centre of the cable to which this conductor belongs
76 89 real(dp),allocatable :: y(:) ! y coordinate of the centre of the cable to which this conductor belongs
77   - real(dp),allocatable :: o(:) ! offset in the x direction of this conductor from the cable centre (x():),y(:) above)
  90 + real(dp),allocatable :: ox(:) ! offset in the x direction of this conductor from the cable centre (x():),y(:) above)
  91 + real(dp),allocatable :: oy(:) ! offset in the y direction of this conductor from the cable centre (x():),y(:) above)
78 92 real(dp),allocatable :: rh(:) ! height (y dimension) of rectangular conductor
79 93 real(dp),allocatable :: rw(:) ! width1 (x dimension) of rectangular conductor/ Dshape
80 94 real(dp),allocatable :: rw2(:) ! width2 (x dimension) of rectangular conductor/ Dshape
81 95 real(dp),allocatable :: rd(:) ! radius of dielectric surrounding a circular conductor
82 96 real(dp),allocatable :: rdh(:) ! height (y dimension) of rectangular dielectric around conductor
83 97 real(dp),allocatable :: rdw(:) ! width (x dimension) of rectangular dielectric around conductor
84   - real(dp),allocatable :: rdo(:) ! offset of dielectric in the x direction of this conductor from the cable centre
  98 + real(dp),allocatable :: rdox(:) ! offset of dielectric in the x direction of this conductor from the cable centre
  99 + real(dp),allocatable :: rdoy(:) ! offset of dielectric in the y direction of this conductor from the cable centre
85 100 real(dp),allocatable :: rtheta(:) ! rotation angle of conductor
86 101 type(Sfilter),allocatable :: epsr(:) ! relative permittivity of dielecrtric surrounding the conductor
87 102  
... ... @@ -112,6 +127,15 @@ TYPE::PUL_type
112 127  
113 128 END TYPE PUL_type
114 129  
  130 +integer,public :: n_entry
  131 +
  132 +! 1D arrays used in the construction of the K matrix ( K(i_K(:),j_K(:))=K(i_K(:),j_K(:))+s_K(:) )
  133 +integer,allocatable,public :: i_K(:)
  134 +integer,allocatable,public :: j_K(:)
  135 +real(dp),allocatable,public :: s_K_re(:)
  136 +complex(dp),allocatable,public :: s_K(:)
  137 +
  138 +
115 139 CONTAINS
116 140  
117 141 include "PUL_analytic.F90"
... ... @@ -120,6 +144,10 @@ include &quot;PUL_LC_Laplace.F90&quot;
120 144  
121 145 include "Laplace.F90"
122 146  
  147 +include "Aprod.F90"
  148 +
  149 +include "CG_solve.F90"
  150 +
123 151 ! NAME
124 152 ! SUBROUTINE allocate_and_reset_PUL_data
125 153 !
... ... @@ -156,11 +184,13 @@ include &quot;Laplace.F90&quot;
156 184 ALLOCATE( PUL%x( PUL%n_conductors) )
157 185 ALLOCATE( PUL%y( PUL%n_conductors) )
158 186 ALLOCATE( PUL%r( PUL%n_conductors) )
159   - ALLOCATE( PUL%o( PUL%n_conductors) )
  187 + ALLOCATE( PUL%ox( PUL%n_conductors) )
  188 + ALLOCATE( PUL%oy( PUL%n_conductors) )
160 189 ALLOCATE( PUL%rd( PUL%n_conductors) )
161 190 ALLOCATE( PUL%rdw( PUL%n_conductors) )
162 191 ALLOCATE( PUL%rdh( PUL%n_conductors) )
163   - ALLOCATE( PUL%rdo( PUL%n_conductors) )
  192 + ALLOCATE( PUL%rdox( PUL%n_conductors) )
  193 + ALLOCATE( PUL%rdoy( PUL%n_conductors) )
164 194 ALLOCATE( PUL%epsr( PUL%n_conductors) )
165 195 ALLOCATE( PUL%rh( PUL%n_conductors) )
166 196 ALLOCATE( PUL%rw( PUL%n_conductors) )
... ... @@ -174,14 +204,16 @@ include &quot;Laplace.F90&quot;
174 204 PUL%x(i)=0d0
175 205 PUL%y(i)=0d0
176 206 PUL%r(i)=0d0
177   - PUL%o(i)=0d0
  207 + PUL%ox(i)=0d0
  208 + PUL%oy(i)=0d0
178 209 PUL%rh(i)=0d0
179 210 PUL%rw(i)=0d0
180 211 PUL%rw2(i)=0d0
181 212 PUL%rd(i)=0d0
182 213 PUL%rdw(i)=0d0
183 214 PUL%rdh(i)=0d0
184   - PUL%rdo(i)=0d0
  215 + PUL%rdox(i)=0d0
  216 + PUL%rdoy(i)=0d0
185 217 PUL%rtheta(i)=0d0
186 218 PUL%epsr(i)=1d0
187 219  
... ... @@ -240,14 +272,16 @@ include &quot;Laplace.F90&quot;
240 272 if (allocated(PUL%x ) ) DEALLOCATE( PUL%x )
241 273 if (allocated(PUL%y ) ) DEALLOCATE( PUL%y )
242 274 if (allocated(PUL%r ) ) DEALLOCATE( PUL%r )
243   - if (allocated(PUL%o ) ) DEALLOCATE( PUL%o )
  275 + if (allocated(PUL%ox ) ) DEALLOCATE( PUL%ox )
  276 + if (allocated(PUL%oy ) ) DEALLOCATE( PUL%oy )
244 277 if (allocated(PUL%rh ) ) DEALLOCATE( PUL%rh )
245 278 if (allocated(PUL%rw ) ) DEALLOCATE( PUL%rw )
246 279 if (allocated(PUL%rw2 ) ) DEALLOCATE( PUL%rw2 )
247 280 if (allocated(PUL%rd ) ) DEALLOCATE( PUL%rd )
248 281 if (allocated(PUL%rdw ) ) DEALLOCATE( PUL%rdw )
249 282 if (allocated(PUL%rdh ) ) DEALLOCATE( PUL%rdh )
250   - if (allocated(PUL%rdo ) ) DEALLOCATE( PUL%rdo )
  283 + if (allocated(PUL%rdox ) ) DEALLOCATE( PUL%rdox )
  284 + if (allocated(PUL%rdoy ) ) DEALLOCATE( PUL%rdoy )
251 285 if (allocated(PUL%rtheta ) ) DEALLOCATE( PUL%rtheta )
252 286  
253 287 if (allocated(PUL%epsr ) ) then
... ... @@ -281,9 +315,10 @@ include &quot;Laplace.F90&quot;
281 315 !
282 316 ! HISTORY
283 317 ! started 6/10/2016 CJS
  318 +! add rox, roy instead of only the x offset, ro 16/3/2018 CJS
284 319 !
285 320  
286   - logical FUNCTION point_is_inside(xt,yt,shape_type,x,y,r,rh,rw,ro,rtheta)
  321 + logical FUNCTION point_is_inside(xt,yt,shape_type,x,y,r,rh,rw,rox,roy,rtheta)
287 322  
288 323 real(dp),intent(IN) :: xt ! test point x
289 324 real(dp),intent(IN) :: yt ! test point y
... ... @@ -293,7 +328,8 @@ include &quot;Laplace.F90&quot;
293 328 real(dp),intent(IN) :: r ! radius of cylindrical test object
294 329 real(dp),intent(IN) :: rh ! height (y dimension) of rectangular test object
295 330 real(dp),intent(IN) :: rw ! width (x dimension) of test object
296   - real(dp),intent(IN) :: ro ! offset in the x direction of this test object from the centre
  331 + real(dp),intent(IN) :: rox ! offset in the x direction of this test object from the centre
  332 + real(dp),intent(IN) :: roy ! offset in the y direction of this test object from the centre
297 333 real(dp),intent(IN) :: rtheta ! rotation angle of test object
298 334  
299 335 ! local variables
... ... @@ -335,8 +371,8 @@ include &quot;Laplace.F90&quot;
335 371 write(*,*)'Inverse rotation on test point',xt_r,yt_r
336 372  
337 373 ! apply the inverse of the offset to the shape i.e. move it into the shifted, un-rotated coordinate system of the rectangle
338   - xt_ro=xt_r-ro
339   - yt_ro=yt_r
  374 + xt_ro=xt_r-rox
  375 + yt_ro=yt_r-roy
340 376  
341 377 write(*,*)'Offset Inverse rotation on test point',xt_ro,yt_ro
342 378  
... ... @@ -345,9 +381,9 @@ include &quot;Laplace.F90&quot;
345 381 dx=xt_ro
346 382 dy=yt_ro
347 383  
348   - write(*,*)'dielectric centre point',x,y,' offset',ro,' angle',rtheta
349   - write(*,*)'dx',dx,' rw/2',rw/2d0
350   - write(*,*)'dy',dy,' rh/2',rh/2d0
  384 +! write(*,*)'dielectric centre point',x,y,' offset',rox,roy,' angle',rtheta
  385 +! write(*,*)'dx',dx,' rw/2',rw/2d0
  386 +! write(*,*)'dy',dy,' rh/2',rh/2d0
351 387  
352 388 if ( (abs(dx).LT.rw/2d0).AND.(abs(dy).LT.rh/2d0) ) then
353 389 point_is_inside=.TRUE.
... ... @@ -442,7 +478,7 @@ include &quot;Laplace.F90&quot;
442 478 ! started 15/11/2016 CJS
443 479 !
444 480  
445   - SUBROUTINE write_Dshape_gmsh(x,y,w_in,w2_in,h_in,r,ox,theta,dl,point,number,unit)
  481 + SUBROUTINE write_Dshape_gmsh(x,y,w_in,w2_in,h_in,r,ox,oy,theta,dl,point,number,unit)
446 482  
447 483 USE type_specifications
448 484 USE general_module
... ... @@ -458,6 +494,7 @@ include &quot;Laplace.F90&quot;
458 494 real(dp),intent(IN) :: h_in ! height (x dimension) of the Dshape
459 495 real(dp),intent(IN) :: r ! radius of curves in Dshape
460 496 real(dp),intent(IN) :: ox ! x offset
  497 + real(dp),intent(IN) :: oy ! y offset
461 498 real(dp),intent(IN) :: theta ! rotation angle of Dshape
462 499 real(dp),intent(IN) :: dl ! edge length for the line segments making up the Dshape
463 500  
... ... @@ -498,7 +535,7 @@ include &quot;Laplace.F90&quot;
498 535  
499 536 ! POINT 1 ! top right
500 537 xt=w1+ox
501   - yt=h+r
  538 + yt=h+r+oy
502 539 xp=x+xt*cos(theta)-yt*sin(theta)
503 540 yp=y+xt*sin(theta)+yt*cos(theta)
504 541 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -506,7 +543,7 @@ include &quot;Laplace.F90&quot;
506 543  
507 544 ! POINT 2 ! top left
508 545 xt=-w1+ox
509   - yt=h+r
  546 + yt=h+r+oy
510 547 xp=x+xt*cos(theta)-yt*sin(theta)
511 548 yp=y+xt*sin(theta)+yt*cos(theta)
512 549 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -514,7 +551,7 @@ include &quot;Laplace.F90&quot;
514 551  
515 552 ! POINT 3 ! top left centre
516 553 xt=-w1+ox
517   - yt=h
  554 + yt=h+oy
518 555 xp=x+xt*cos(theta)-yt*sin(theta)
519 556 yp=y+xt*sin(theta)+yt*cos(theta)
520 557 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -522,7 +559,7 @@ include &quot;Laplace.F90&quot;
522 559  
523 560 ! POINT 4 ! top left edge
524 561 xt=-w1+ox+voxl
525   - yt=h+voyl
  562 + yt=h+voyl+oy
526 563 xp=x+xt*cos(theta)-yt*sin(theta)
527 564 yp=y+xt*sin(theta)+yt*cos(theta)
528 565 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -530,7 +567,7 @@ include &quot;Laplace.F90&quot;
530 567  
531 568 ! POINT 5 ! bottom left edge
532 569 xt=-w2+ox+voxl
533   - yt=-h+voyl
  570 + yt=-h+voyl+oy
534 571 xp=x+xt*cos(theta)-yt*sin(theta)
535 572 yp=y+xt*sin(theta)+yt*cos(theta)
536 573 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -538,7 +575,7 @@ include &quot;Laplace.F90&quot;
538 575  
539 576 ! POINT 6 ! bottom left centre
540 577 xt=-w2+ox
541   - yt=-h
  578 + yt=-h+oy
542 579 xp=x+xt*cos(theta)-yt*sin(theta)
543 580 yp=y+xt*sin(theta)+yt*cos(theta)
544 581 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -546,7 +583,7 @@ include &quot;Laplace.F90&quot;
546 583  
547 584 ! POINT 7 ! bottom left
548 585 xt=-w2+ox
549   - yt=-(h+r)
  586 + yt=-(h+r)+oy
550 587 xp=x+xt*cos(theta)-yt*sin(theta)
551 588 yp=y+xt*sin(theta)+yt*cos(theta)
552 589 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -554,7 +591,7 @@ include &quot;Laplace.F90&quot;
554 591  
555 592 ! POINT 8 ! bottom right
556 593 xt=w2+ox
557   - yt=-(h+r)
  594 + yt=-(h+r)+oy
558 595 xp=x+xt*cos(theta)-yt*sin(theta)
559 596 yp=y+xt*sin(theta)+yt*cos(theta)
560 597 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -562,7 +599,7 @@ include &quot;Laplace.F90&quot;
562 599  
563 600 ! POINT 9 ! bottom right centre
564 601 xt=w2+ox
565   - yt=-h
  602 + yt=-h+oy
566 603 xp=x+xt*cos(theta)-yt*sin(theta)
567 604 yp=y+xt*sin(theta)+yt*cos(theta)
568 605 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -570,7 +607,7 @@ include &quot;Laplace.F90&quot;
570 607  
571 608 ! POINT 10 ! bottom right edge
572 609 xt=w2+ox-voxl
573   - yt=-h+voyl
  610 + yt=-h+voyl+oy
574 611 xp=x+xt*cos(theta)-yt*sin(theta)
575 612 yp=y+xt*sin(theta)+yt*cos(theta)
576 613 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -578,7 +615,7 @@ include &quot;Laplace.F90&quot;
578 615  
579 616 ! POINT 11 ! top right edge
580 617 xt=w1+ox-voxl
581   - yt=h+voyl
  618 + yt=h+voyl+oy
582 619 xp=x+xt*cos(theta)-yt*sin(theta)
583 620 yp=y+xt*sin(theta)+yt*cos(theta)
584 621 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ... @@ -586,7 +623,7 @@ include &quot;Laplace.F90&quot;
586 623  
587 624 ! POINT 12 ! top right centre
588 625 xt=w1+ox
589   - yt=h
  626 + yt=h+oy
590 627 xp=x+xt*cos(theta)-yt*sin(theta)
591 628 yp=y+xt*sin(theta)+yt*cos(theta)
592 629 write(unit,*)'Point(',point,' ) = {',xp,',',yp,',',0.0,',',dl,' };'
... ...
SRC/cable_bundle_model_builder.F90
... ... @@ -74,6 +74,8 @@
74 74 ! 29/6/2016 CJS: Check that the cables are all on one side of the ground plane if it is present
75 75 ! December 2016 CJS Version 2: Rationalise cable types so that there is only a single version of each type of cable
76 76 ! 24/2/2017 CJS Allow the input name to include a path i.e. the _spec file does not need to be local.
  77 +! 13/3/2018 CJS Add flag for direct/ iterative matrix solver in Laplace solution and inf/finite ground plane
  78 +! 19/6/2018 CJS Add flag for Neumann/ Asymptotic boundary condition in Laplace solver. Default is Neumann
77 79 !
78 80 PROGRAM cable_bundle_model_builder
79 81  
... ... @@ -333,6 +335,15 @@ integer :: dim
333 335 if (INDEX(line,'no_plot_potential').NE.0) plot_potential=.FALSE.
334 336 if (INDEX(line,'plot_mesh').NE.0) plot_mesh=.TRUE.
335 337 if (INDEX(line,'no_plot_mesh').NE.0) plot_mesh=.FALSE.
  338 +
  339 + if (INDEX(line,'direct_solver').NE.0) direct_solver=.TRUE.
  340 + if (INDEX(line,'iterative_solver').NE.0) direct_solver=.FALSE.
  341 +
  342 + if (INDEX(line,'inf_gnd').NE.0) inf_gnd=.TRUE.
  343 + if (INDEX(line,'finite_gnd').NE.0) inf_gnd=.FALSE.
  344 +
  345 + if (INDEX(line,'abc').NE.0) use_ABC=.TRUE.
  346 + if (INDEX(line,'neumann').NE.0) use_ABC=.FALSE.
336 347  
337 348 ! redefine mesh generation parameters if required
338 349 if (INDEX(line,'laplace_boundary_constant').NE.0) then
... ... @@ -346,6 +357,10 @@ integer :: dim
346 357 if (INDEX(line,'twisted_pair_equivalent_radius').NE.0) then
347 358 read(bundle_spec_file_unit,*,END=100,ERR=100)Twisted_pair_equivalent_radius
348 359 end if
  360 +
  361 + if (INDEX(line,'max_mesh_edge_length').NE.0) then
  362 + read(bundle_spec_file_unit,*,END=100,ERR=100)max_mesh_edge_length
  363 + end if
349 364  
350 365 end do ! continue until all flags are read - indicated by an end of file.
351 366  
... ...
SRC/cable_model_builder.F90
... ... @@ -84,6 +84,7 @@
84 84 ! 24/2/2017 CJS Allow the input name to include a path i.e. the _spec file does not need to be local.
85 85 ! 23/10/2017 CJS Check the pole stability of the dielectric and transfer impedance filters.
86 86 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
  87 +! 13/3/2018 CJS Add flag for direct/ iterative matrix solver in Laplace solution
87 88 !
88 89 !
89 90 PROGRAM cable_model_builder
... ... @@ -214,10 +215,14 @@ integer :: i
214 215  
215 216 CALL spacewire_set_parameters(cable_spec)
216 217  
217   - else if (cable_spec%cable_type_string.eq.'flex_cable') then
  218 + else if (cable_spec%cable_type_string.eq.'original_flex_cable') then
218 219  
219 220 CALL flex_cable_set_parameters(cable_spec)
220 221  
  222 + else if (cable_spec%cable_type_string.eq.'flex_cable') then
  223 +
  224 + CALL ML_flex_cable_set_parameters(cable_spec)
  225 +
221 226 else if (cable_spec%cable_type_string.eq.'dconnector') then
222 227  
223 228 CALL Dconnector_set_parameters(cable_spec)
... ... @@ -274,11 +279,20 @@ integer :: i
274 279 STOP 1
275 280 end if
276 281  
  282 + if (cable_spec%n_parameters.NE.0) then
  283 +
277 284 ! Check that the number of parameters is consistent with this cable type
278   - if (np_in.NE.cable_spec%n_parameters) then
279   - run_status='ERROR, Wrong number of parameters'
280   - CALL write_program_status()
281   - STOP 1
  285 + if (np_in.NE.cable_spec%n_parameters) then
  286 + run_status='ERROR, Wrong number of parameters'
  287 + CALL write_program_status()
  288 + STOP 1
  289 + end if
  290 +
  291 + else
  292 +
  293 +! for a ML_flex cable the number of parameters depends on the cable specification
  294 + cable_spec%n_parameters=np_in
  295 +
282 296 end if
283 297  
284 298 ! allocate and read parameters
... ... @@ -410,6 +424,9 @@ integer :: i
410 424 if (INDEX(line,'no_plot_potential').NE.0) plot_potential=.FALSE.
411 425 if (INDEX(line,'plot_mesh').NE.0) plot_mesh=.TRUE.
412 426 if (INDEX(line,'no_plot_mesh').NE.0) plot_mesh=.FALSE.
  427 +
  428 + if (INDEX(line,'direct_solver').NE.0) direct_solver=.TRUE.
  429 + if (INDEX(line,'iterative_solver').NE.0) direct_solver=.FALSE.
413 430  
414 431 ! redefine mesh generation parameters if required
415 432 if (INDEX(line,'laplace_boundary_constant').NE.0) then
... ... @@ -423,6 +440,10 @@ integer :: i
423 440 if (INDEX(line,'twisted_pair_equivalent_radius').NE.0) then
424 441 read(cable_spec_file_unit,*,END=100,ERR=100)Twisted_pair_equivalent_radius
425 442 end if
  443 +
  444 + if (INDEX(line,'max_mesh_edge_length').NE.0) then
  445 + read(cable_spec_file_unit,*,END=100,ERR=100)max_mesh_edge_length
  446 + end if
426 447  
427 448 end do ! continue until all flags are read - indicated by an end of file.
428 449  
... ... @@ -482,6 +503,10 @@ integer :: i
482 503  
483 504 CALL flex_cable_set_internal_domain_information(cable_spec)
484 505  
  506 + else if (cable_spec%cable_type.EQ.cable_geometry_type_ML_flex_cable) then
  507 +
  508 + CALL ML_flex_cable_set_internal_domain_information(cable_spec)
  509 +
485 510 else if (cable_spec%cable_type.EQ.cable_geometry_type_dconnector) then
486 511  
487 512 CALL dconnector_set_internal_domain_information(cable_spec)
... ...
TEST_CASES/FLEX_CABLE_3_AND_SINGLE_WIRE_EINC/flex_cable_3.cable_spec
... ... @@ -2,13 +2,17 @@
2 2 .
3 3 flex_cable
4 4 3 # number of conductors
5   -6 # number of parameters
6   -1.0e-3 # parameter 1: conductor width (x dimension)
7   -0.25e-3 # parameter 2: conductor height (y dimension)
8   -0.5e-3 # parameter 3: conductor separation (x dimension)
9   -0.5e-3 # parameter 4: dielectric offset x
10   -0.5e-3 # parameter 5: dielectric offset y
11   -0.0 # parameter 6: conductivity
  5 +10 # number of parameters
  6 +5.0e-3 # parameter 1: dielectric width (x dimension)
  7 +1.25e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +3 # parameter 9: row 1 number of conductors
  15 +0.0 # parameter 10: conductivity
12 16 1 # number of frequency dependent parameters
13 17 # dielectric relative permittivity model follows
14 18 1E9 # w normalisation constant
... ...
TEST_CASES/FLEX_CABLE_3_CONDUCTOR/flex_cable_3.cable_spec
... ... @@ -2,6 +2,33 @@
2 2 .
3 3 flex_cable
4 4 3 # number of conductors
  5 +10 # number of parameters
  6 +4.4e-3 # parameter 1: dielectric width (x dimension)
  7 +0.45e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +3 # parameter 9: row 1 number of conductors
  15 +0.0 # parameter 10: conductivity
  16 +1 # number of frequency dependent parameters
  17 +# dielectric relative permittivity model follows
  18 + 1E9 # w normalisation constant
  19 + 0 # a order, a coefficients follow below:
  20 + 1.0
  21 + 0 # b order, b coefficients follow below:
  22 + 1.0
  23 +
  24 +
  25 +
  26 +# OLD model
  27 +
  28 +#MOD_cable_lib_dir
  29 +.
  30 +flex_cable
  31 +3 # number of conductors
5 32 6 # number of parameters
6 33 1.0e-3 # parameter 1: conductor width (x dimension)
7 34 0.25e-3 # parameter 2: conductor height (y dimension)
... ... @@ -16,11 +43,3 @@ flex_cable
16 43 1.0
17 44 0 # b order, b coefficients follow below:
18 45 1.0
19   -
20   -
21   -# dielectric relative permittivity model follows
22   - 1E9 # w normalisation constant
23   - 1 # a order, a coefficients follow below:
24   - 4.0 2.0
25   - 1 # b order, b coefficients follow below:
26   - 1.0 1.0
... ...
TEST_CASES/FLEX_CABLE_3_EINC/flex_cable_3.cable_spec
... ... @@ -2,6 +2,33 @@
2 2 .
3 3 flex_cable
4 4 3 # number of conductors
  5 +10 # number of parameters
  6 +5.0e-3 # parameter 1: dielectric width (x dimension)
  7 +1.25e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +3 # parameter 9: row 1 number of conductors
  15 +0.0 # parameter 10: conductivity
  16 +1 # number of frequency dependent parameters
  17 +# dielectric relative permittivity model follows
  18 + 1E9 # w normalisation constant
  19 + 0 # a order, a coefficients follow below:
  20 + 2.2
  21 + 0 # b order, b coefficients follow below:
  22 + 1.0
  23 +
  24 +
  25 +
  26 +
  27 +
  28 +#MOD_cable_lib_dir
  29 +.
  30 +flex_cable
  31 +3 # number of conductors
5 32 6 # number of parameters
6 33 1.0e-3 # parameter 1: conductor width (x dimension)
7 34 0.25e-3 # parameter 2: conductor height (y dimension)
... ...
TEST_CASES/FLEX_CABLE_3_GROUND_PLANE/flex_cable_3.cable_spec
... ... @@ -2,6 +2,32 @@
2 2 .
3 3 flex_cable
4 4 3 # number of conductors
  5 +10 # number of parameters
  6 +5.0e-3 # parameter 1: dielectric width (x dimension)
  7 +1.25e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +3 # parameter 9: row 1 number of conductors
  15 +0.0 # parameter 10: conductivity
  16 +1 # number of frequency dependent parameters
  17 +# dielectric relative permittivity model follows
  18 + 1E9 # w normalisation constant
  19 + 0 # a order, a coefficients follow below:
  20 + 2.2
  21 + 0 # b order, b coefficients follow below:
  22 + 1.0
  23 +
  24 +
  25 +
  26 +
  27 +#MOD_cable_lib_dir
  28 +.
  29 +flex_cable
  30 +3 # number of conductors
5 31 6 # number of parameters
6 32 1.0e-3 # parameter 1: conductor width (x dimension)
7 33 0.25e-3 # parameter 2: conductor height (y dimension)
... ...
TEST_CASES/FLEX_CABLE_3_OVERSHIELD/flex_cable_3.cable_spec
... ... @@ -2,6 +2,32 @@
2 2 .
3 3 flex_cable
4 4 3 # number of conductors
  5 +10 # number of parameters
  6 +5.0e-3 # parameter 1: dielectric width (x dimension)
  7 +1.25e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +3 # parameter 9: row 1 number of conductors
  15 +0.0 # parameter 10: conductivity
  16 +1 # number of frequency dependent parameters
  17 +# dielectric relative permittivity model follows
  18 + 1E9 # w normalisation constant
  19 + 0 # a order, a coefficients follow below:
  20 + 2.2
  21 + 0 # b order, b coefficients follow below:
  22 + 1.0
  23 +
  24 +
  25 +
  26 +
  27 +#MOD_cable_lib_dir
  28 +.
  29 +flex_cable
  30 +3 # number of conductors
5 31 6 # number of parameters
6 32 1.0e-3 # parameter 1: conductor width (x dimension)
7 33 0.25e-3 # parameter 2: conductor height (y dimension)
... ...
TEST_CASES/FLEX_CABLE_DIELECTRIC_3_CONDUCTOR/flex_cable_3.cable_spec
... ... @@ -2,6 +2,32 @@
2 2 .
3 3 flex_cable
4 4 3 # number of conductors
  5 +10 # number of parameters
  6 +5.0e-3 # parameter 1: dielectric width (x dimension)
  7 +1.25e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +3 # parameter 9: row 1 number of conductors
  15 +0.0 # parameter 10: conductivity
  16 +1 # number of frequency dependent parameters
  17 +# dielectric relative permittivity model follows
  18 + 1E9 # w normalisation constant
  19 + 0 # a order, a coefficients follow below:
  20 + 2.2
  21 + 0 # b order, b coefficients follow below:
  22 + 1.0
  23 +
  24 +
  25 +
  26 +
  27 +#MOD_cable_lib_dir
  28 +.
  29 +flex_cable
  30 +3 # number of conductors
5 31 6 # number of parameters
6 32 1.0e-3 # parameter 1: conductor width (x dimension)
7 33 0.25e-3 # parameter 2: conductor height (y dimension)
... ... @@ -16,3 +42,29 @@ flex_cable
16 42 2.2
17 43 0 # b order, b coefficients follow below:
18 44 1.0
  45 +#MOD_cable_lib_dir
  46 +.
  47 +ML_flex_cable
  48 +3 # number of conductors
  49 +10 # number of parameters
  50 +5.0e-3 # parameter 1: dielectric width (x dimension)
  51 +1.25e-3 # parameter 2: dielectric height (y dimension)
  52 +1 # parameter 3: number of rows of conductors
  53 +0.0e-3 # parameter 4: row 1 centre offset x
  54 +0.0e-3 # parameter 5: row 1 centre offset y
  55 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  56 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  57 +0.5e-3 # parameter 8: row 1 conductor separation
  58 +3 # parameter 9: row 1 number of conductors
  59 +0.0 # parameter 10: conductivity
  60 +1 # number of frequency dependent parameters
  61 +# dielectric relative permittivity model follows
  62 + 1E9 # w normalisation constant
  63 + 0 # a order, a coefficients follow below:
  64 + 2.2
  65 + 0 # b order, b coefficients follow below:
  66 + 1.0
  67 +
  68 +
  69 +
  70 +
... ...
TEST_CASES/FLEX_CABLE_LOSSY_2_CONDUCTOR/flex_cable_2.cable_spec
... ... @@ -2,6 +2,32 @@
2 2 .
3 3 flex_cable
4 4 2 # number of conductors
  5 +10 # number of parameters
  6 +2.9e-3 # parameter 1: dielectric width (x dimension)
  7 +0.45e-3 # parameter 2: dielectric height (y dimension)
  8 +1 # parameter 3: number of rows of conductors
  9 +0.0e-3 # parameter 4: row 1 centre offset x
  10 +0.0e-3 # parameter 5: row 1 centre offset y
  11 +1.0e-3 # parameter 6: row 1 conductor width (x dimension)
  12 +0.25e-3 # parameter 7: row 1 conductor height (y dimension)
  13 +0.5e-3 # parameter 8: row 1 conductor separation
  14 +2 # parameter 9: row 1 number of conductors
  15 +5e7 # parameter 10: conductivity
  16 +1 # number of frequency dependent parameters
  17 +# dielectric relative permittivity model follows
  18 + 1E9 # w normalisation constant
  19 + 0 # a order, a coefficients follow below:
  20 + 2.25
  21 + 0 # b order, b coefficients follow below:
  22 + 1.0
  23 +
  24 +
  25 +
  26 +
  27 +#MOD_cable_lib_dir
  28 +.
  29 +flex_cable
  30 +2 # number of conductors
5 31 6 # number of parameters
6 32 1.0e-3 # parameter 1: conductor width (x dimension)
7 33 0.25e-3 # parameter 2: conductor height (y dimension)
... ...
TEST_CASES/generate_spice_cable_bundle_model
... ... @@ -163,7 +163,6 @@ CM_TO_DM_TWISTED_PAIR_OVER_GROUND_PLANE
163 163 LOW_MASS_SPACEWIRE
164 164 "
165 165  
166   -
167 166 ERROR_STRING="\
168 167 Run using the following command:
169 168  
... ...
clean_project 0 → 100755
... ... @@ -0,0 +1,16 @@
  1 +# Script to clean object files, mod files and
  2 +# all temporary test case files before updating
  3 +# the git repository.
  4 +
  5 +cd SRC
  6 +make clean
  7 +rm -f compilation_date.inc
  8 +cd ..
  9 +#
  10 +cd TEST_CASES
  11 +./generate_spice_cable_bundle_model clean_all
  12 +cd ..
  13 +#
  14 +cd DOCUMENTATION
  15 +make clean
  16 +cd ..
... ...