UoN / SACAMOS

Commit ca8ab9e90b29cfc11d3d1b8358076c5512aa66f5

Authored by Chris Smartt
1 parent ca596cf4
Exists in proximity_effects

Update to proximity effects: working for simple cases

Showing 34 changed files with 1548 additions and 81 deletions   Show diff stats
Inline Side-by-side
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/TWO_WIRE/single_wire.cable_spec
  Diff comments   View file @ca8ab9e
... ... @@ -5,7 +5,7 @@ Cylindrical
5 5 3 # number of parameters
6 6 1.0000E-04 # parameter 1: conductor radius
7 7 1.0000E-04 # parameter 2: dielectric radius
8   - 0.0000E+00 # parameter 3: conductivity
  8 + 4.461E+07 # parameter 3: conductivity
9 9 1 # number of frequency dependent parameters
10 10 # Dielectric relative permittivity model follows
11 11 1.0000000000000000 # w normalisation constant
... ...
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/TWO_WIRE_FASTHENRY/single_wire.cable_spec
  Diff comments   View file @ca8ab9e
... ... @@ -5,7 +5,7 @@ Cylindrical
5 5 3 # number of parameters
6 6 1.0000E-04 # parameter 1: conductor radius
7 7 1.0000E-04 # parameter 2: dielectric radius
8   - 0.0000E+00 # parameter 3: conductivity
  8 + 4.461E+07 # parameter 3: conductivity
9 9 1 # number of frequency dependent parameters
10 10 # Dielectric relative permittivity model follows
11 11 1.0000000000000000 # w normalisation constant
... ...
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/TWO_WIRE_FASTHENRY/two_wire.bundle_spec
  Diff comments   View file @ca8ab9e
... ... @@ -10,7 +10,7 @@ single_wire
10 10 no_ground_plane
11 11 -10 # order for vector fit model
12 12 log # frequency scale (log or lin)
13   -1e3 1e9 60 # fmin fmax number_of_frequencies
  13 +1e2 1e8 60 # fmin fmax number_of_frequencies
14 14 verbose
15 15 use_laplace
16 16 use_fasthenry
... ...
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/TWO_WIRE_FASTHENRY/two_wire_ac.spice_model_spec
  Diff comments   View file @ca8ab9e
... ... @@ -31,3 +31,8 @@ log # frequency scale (log or lin)
31 31 # Output conductor number and end number
32 32 1 1
33 33 lin # output type (lin or dB)
  34 +-10 # order for vector fit model
  35 +log # frequency scale (log or lin)
  36 +1e2 1e8 60 # fmin fmax number_of_frequencies
  37 +verbose
  38 +plot_propagation_correction_filter_fit_data
... ...
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/TWO_WIRE_LAPLACE/single_wire.cable_spec
  Diff comments   View file @ca8ab9e
... ... @@ -5,7 +5,7 @@ Cylindrical
5 5 3 # number of parameters
6 6 1.0000E-04 # parameter 1: conductor radius
7 7 1.0000E-04 # parameter 2: dielectric radius
8   - 0.0000E+00 # parameter 3: conductivity
  8 + 4.461E+07 # parameter 3: conductivity
9 9 1 # number of frequency dependent parameters
10 10 # Dielectric relative permittivity model follows
11 11 1.0000000000000000 # w normalisation constant
... ...
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/plot_comparison.plt
  Diff comments   View file @ca8ab9e
... ... @@ -5,6 +5,7 @@ set xlabel 'Frequency(Hz)'
5 5 set ylabel 'V(f)'
6 6 set logscale x
7 7 plot './TWO_WIRE/RUN_DIRECTORY/analytic_solution.dat' u 1:2 title 'Analytic solution' w p lc 3,\
  8 + './TWO_WIRE_FASTHENRY/RUN_DIRECTORY/analytic_solution.dat' u 1:2 title 'Analytic solution2' w p lc 3,\
8 9 './TWO_WIRE/RUN_DIRECTORY/spice_solution.dat' u 2:3 title 'TWO_WIRE' w l lc 1,\
9 10 './TWO_WIRE_LAPLACE/RUN_DIRECTORY/spice_solution.dat' u 2:3 title 'TWO_WIRE_LAPLACE' w l lc 2,\
10 11 './TWO_WIRE_FASTHENRY/RUN_DIRECTORY/spice_solution.dat' u 2:3 title 'TWO_WIRE_FASTHENRY' w l lc 4
... ...
PROXIMITY_EFFECT_TEST_CASES/TWO_WIRE/status
  Diff comments   View file @ca8ab9e
1   -generate_spice_cable_bundle_model clean
  1 +generate_spice_cable_bundle_model run
2 2  
3   -TWO_WIRE: Finished correctly
4   -TWO_WIRE_LAPLACE: Finished correctly
5   -TWO_WIRE_FASTHENRY: Finished correctly
  3 +TWO_WIRE_FASTHENRY: Finished correctly Result comparison: 0.00000000
... ...
PROXIMITY_EFFECT_TEST_CASES/WIRE_OVER_GP/WIRE_OVER_GROUND_PLANE_FASTHENRY/single_wire.cable_spec
  Diff comments   View file @ca8ab9e
... ... @@ -5,7 +5,7 @@ Cylindrical
5 5 3 # number of parameters
6 6 1.0000E-04 # parameter 1: conductor radius
7 7 1.0000E-04 # parameter 2: dielectric radius
8   - 0.0000E+00 # parameter 3: conductivity
  8 + 4.461E+07 # parameter 3: conductivity
9 9 1 # number of frequency dependent parameters
10 10 # Dielectric relative permittivity model follows
11 11 1.0000000000000000 # w normalisation constant
... ...
PROXIMITY_EFFECT_TEST_CASES/WIRE_OVER_GP/WIRE_OVER_GROUND_PLANE_FASTHENRY/wire_over_ground.bundle_spec
  Diff comments   View file @ca8ab9e
... ... @@ -5,11 +5,10 @@
5 5 1 # Number of cables in bundle, cable list follows: name then x,y of cable
6 6 single_wire
7 7 0.0 4.e-3 ! x and y coordinates of the cable centre
8   -ground_plane
  8 +ground_plane 4.461E+07 25e-3 0.1e-3 10 10 1 ! sigma w h nx nz nh
9 9 -10 # order for vector fit model
10 10 log # frequency scale (log or lin)
11   -1e3 1e9 60 # fmin fmax number_of_frequencies
  11 +1e2 1e8 60 # fmin fmax number_of_frequencies
12 12 verbose
13 13 use_laplace
14   -use_fasthenry
15   -
  14 +use_fasthenry 4 3 3 2.0 2.0 ! condcutor meshing parameters: nlayers_radius nw nh rw rh
... ...
PROXIMITY_EFFECT_TEST_CASES/WIRE_OVER_GP/WIRE_OVER_GROUND_PLANE_FASTHENRY/wire_over_ground_ac.spice_model_spec
  Diff comments   View file @ca8ab9e
... ... @@ -27,7 +27,12 @@ wire_over_ground
27 27 # Type of analysis
28 28 AC
29 29 log # frequency scale (log or lin)
30   -1e3 1e8 1000 # fmin fmax number_of_frequencies
  30 +1e3 1e8 1000 # fmin fmax number_of_frequencies 1e3 1e8 1000 # fmin fmax number_of_frequencies
31 31 # Output conductor number and end number
32 32 1 1
33 33 lin # output type (lin or dB)
  34 +-10 # order for vector fit model
  35 +log # frequency scale (log or lin)
  36 +1e2 1e8 60 # fmin fmax number_of_frequencies
  37 +verbose
  38 +plot_propagation_correction_filter_fit_data
... ...
PROXIMITY_EFFECT_TEST_CASES/WIRE_OVER_GP/status
  Diff comments   View file @ca8ab9e
1   -generate_spice_cable_bundle_model clean
  1 +generate_spice_cable_bundle_model plot
2 2  
3   -WIRE_OVER_GROUND_PLANE: Finished correctly
4   -WIRE_OVER_GROUND_PLANE_LAPLACE: Finished correctly
5   -WIRE_OVER_GROUND_PLANE_FASTHENRY: Finished correctly
  3 +WIRE_OVER_GROUND_PLANE_FASTHENRY/: Finished correctly
... ...
SRC/BUNDLE_DOMAIN_CREATION/create_global_domain_structure.F90
  Diff comments   View file @ca8ab9e
... ... @@ -1035,6 +1035,8 @@ USE maths
1035 1035 PUL%y(conductor)=bundle%cable_y_offset(cable)
1036 1036 PUL%rtheta(conductor)=bundle%cable_angle(cable)
1037 1037  
  1038 + PUL%sigma(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_sigma
  1039 +
1038 1040 PUL%ox(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_ox
1039 1041 PUL%oy(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_oy
1040 1042 PUL%r(conductor)=bundle%cable(cable)%external_model(local_conductor)%conductor_radius
... ... @@ -1064,12 +1066,19 @@ USE maths
1064 1066  
1065 1067 overshield=overshield+1
1066 1068  
1067   - if (verbose) write(*,*)'PUL parameter calculation for oversheild domain'
  1069 + if (verbose) write(*,*)'PUL parameter calculation for overshield domain'
1068 1070 ! no ground plane
1069 1071 PUL%ground_plane_present=.FALSE.
1070 1072 PUL%ground_plane_angle =0d0
1071 1073 PUL%ground_plane_offset =0d0
1072   -
  1074 + PUL%ground_plane_sigma =0d0
  1075 + PUL%ground_plane_w =0d0
  1076 + PUL%ground_plane_h =0d0
  1077 + PUL%ground_plane_Rdc =0d0
  1078 + PUL%ground_plane_nsegx =0
  1079 + PUL%ground_plane_nsegz =0
  1080 + PUL%ground_plane_nh =0
  1081 +
1073 1082 ! add overshield information
1074 1083 if (verbose) write(*,*)'Add overshield information'
1075 1084 is_overshield_domain=.TRUE.
... ... @@ -1080,7 +1089,7 @@ USE maths
1080 1089 PUL%overshield_y = overshield_y(overshield)
1081 1090 PUL%overshield_r = overshield_r(overshield)
1082 1091 PUL%overshield_w = overshield_w(overshield)
1083   - PUL%overshield_w2 = overshield_w2(overshield)
  1092 + PUL%overshield_w2= overshield_w2(overshield)
1084 1093 PUL%overshield_h = overshield_h(overshield)
1085 1094  
1086 1095 PUL%epsr_background = 1d0 ! background permittivity =1.0 within an overshield i.e. cables are in air
... ... @@ -1109,14 +1118,21 @@ USE maths
1109 1118 PUL%ground_plane_present=bundle%ground_plane_present
1110 1119 PUL%ground_plane_angle =bundle%ground_plane_angle
1111 1120 PUL%ground_plane_offset =bundle%ground_plane_offset
1112   -
  1121 + PUL%ground_plane_sigma =bundle%ground_plane_sigma ! ground plane conductivity
  1122 + PUL%ground_plane_w =bundle%ground_plane_w ! ground plane width
  1123 + PUL%ground_plane_h =bundle%ground_plane_h ! ground plane height
  1124 + PUL%ground_plane_Rdc =bundle%ground_plane_Rdc ! ground plane dc resistance
  1125 + PUL%ground_plane_nsegx =bundle%ground_plane_nsegx ! ground plane x discretisation
  1126 + PUL%ground_plane_nsegz =bundle%ground_plane_nsegz ! ground plane z discretisation
  1127 + PUL%ground_plane_nh =bundle%ground_plane_nh ! ground plane h discretisation
  1128 +
1113 1129 ! No overshield information
1114 1130 is_overshield_domain=.FALSE.
1115 1131 PUL%overshield_present=.FALSE.
1116 1132 PUL%overshield_shape=0
1117 1133 PUL%overshield_r= 0d0
1118 1134 PUL%overshield_w= 0d0
1119   - PUL%overshield_w2= 0d0
  1135 + PUL%overshield_w2=0d0
1120 1136 PUL%overshield_h= 0d0
1121 1137  
1122 1138 PUL%epsr_background = 1d0 ! background permittivity =1.0 i.e. cables are in air
... ... @@ -1134,6 +1150,10 @@ USE maths
1134 1150 if (use_FastHenry) then
1135 1151  
1136 1152 CALL PUL_RL_FastHenry2(PUL,bundle%bundle_name,bundle%Y_fit_model_order,bundle%Y_fit_freq_spec,domain)
  1153 +
  1154 +!! Change the conductor model type as we now let FastHenry2 deal with this.
  1155 +! bundle%cable(cable)%conductor_impedance(local_conductor)%impedance_model_type=impedance_model_type_FH2
  1156 +! bundle%cable(cable)%conductor_impedance(local_conductor)%Rdc,
1137 1157  
1138 1158 end if
1139 1159  
... ... @@ -1278,11 +1298,12 @@ USE maths
1278 1298  
1279 1299 conductor=conductor+1
1280 1300 ! copy the conductor impedance model for this cable conductor to the bundle structure
  1301 +
  1302 + write(*,*)'cable=',cable,' conductor=',conductor,' local_conductor=',local_conductor
1281 1303  
1282 1304 bundle%conductor_impedance(conductor)%impedance_model_type= &
1283 1305 bundle%cable(cable)%conductor_impedance(local_conductor)%impedance_model_type
1284 1306  
1285   -
1286 1307 bundle%conductor_impedance(conductor)%radius= &
1287 1308 bundle%cable(cable)%conductor_impedance(local_conductor)%radius
1288 1309  
... ... @@ -1300,6 +1321,9 @@ USE maths
1300 1321  
1301 1322 bundle%conductor_impedance(conductor)%Resistance_multiplication_factor= &
1302 1323 bundle%cable(cable)%conductor_impedance(local_conductor)%Resistance_multiplication_factor
  1324 +
  1325 + bundle%conductor_impedance(conductor)%Rdc= &
  1326 + bundle%cable(cable)%conductor_impedance(local_conductor)%Rdc
1303 1327  
1304 1328 if((bundle%conductor_impedance(conductor)%impedance_model_type.EQ.impedance_model_type_filter).OR. &
1305 1329 (bundle%conductor_impedance(conductor)%impedance_model_type.EQ.impedance_model_type_cylindrical_shield)) then
... ...
SRC/CABLE_BUNDLE_MODULES/cable_bundle_module.F90
  Diff comments   View file @ca8ab9e
... ... @@ -101,6 +101,14 @@ TYPE::bundle_specification_type
101 101 real(dp) :: ground_plane_angle
102 102 real(dp) :: ground_plane_offset
103 103  
  104 + real(dp) :: ground_plane_sigma ! ground plane conductivity for FastHenry2
  105 + real(dp) :: ground_plane_w ! ground plane width for FastHenry2
  106 + real(dp) :: ground_plane_h ! ground plane height for FastHenry2
  107 + real(dp) :: ground_plane_Rdc ! ground plane dc resistance for FastHenry2
  108 + integer :: ground_plane_nsegx ! ground plane number of segments in x for FastHenry2
  109 + integer :: ground_plane_nsegz ! ground plane number of segments in z for FastHenry2
  110 + integer :: ground_plane_nh ! ground plane number of layers in h for FastHenry2
  111 +
104 112 real(dp) :: ground_plane_x,ground_plane_y,ground_plane_theta
105 113 real(dp) :: ground_plane_nx,ground_plane_ny
106 114  
... ... @@ -270,6 +278,20 @@ CONTAINS
270 278 ! calculate offset
271 279 bundle%ground_plane_offset=-bundle%ground_plane_x*sin(bundle%ground_plane_angle)+ &
272 280 bundle%ground_plane_y*cos(bundle%ground_plane_angle)
  281 +
  282 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_sigma
  283 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_w
  284 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_h
  285 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_Rdc
  286 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_nsegx
  287 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_nsegz
  288 + read(file_unit,*,IOSTAT=ierr)bundle%ground_plane_nh
  289 +
  290 + if (ierr.NE.0) then
  291 + run_status='ERROR reading ground plane sigma, w h and Rdc'
  292 + CALL write_program_status()
  293 + STOP 1
  294 + end if
273 295  
274 296 ! set the geometric data for the last cable in the list i.e. the ground plane
275 297  
... ... @@ -508,6 +530,15 @@ CONTAINS
508 530 ' x y coordinates and angle of ground plane '
509 531 write(file_unit,*)bundle%ground_plane_nx,bundle%ground_plane_ny,' ground plane normal direction'
510 532 write(file_unit,*)bundle%ground_plane_cable_side,' orientation of cables wrt ground plane'
  533 +
  534 + write(file_unit,*)bundle%ground_plane_sigma,' ground plane conductivity'
  535 + write(file_unit,*)bundle%ground_plane_w,' ground plane width '
  536 + write(file_unit,*)bundle%ground_plane_h,' ground plane height (thickness) '
  537 + write(file_unit,*)bundle%ground_plane_Rdc,' ground plane Rdc '
  538 + write(file_unit,*)bundle%ground_plane_nsegx,' ground plane nsegx '
  539 + write(file_unit,*)bundle%ground_plane_nsegz,' ground plane nsegz '
  540 + write(file_unit,*)bundle%ground_plane_nh,' ground plane nh '
  541 +
511 542 else
512 543 write(file_unit,'(A)')'no_ground_plane'
513 544 end if
... ...
SRC/CABLE_MODULES/cable_module.F90
  Diff comments   View file @ca8ab9e
... ... @@ -126,6 +126,7 @@
126 126 ! put the external condcutor model information into its own structure 6/10/2016 CJS
127 127 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
128 128 ! 16/3/2018 CJS Add ML_flex_cable
  129 +! 24/10/2023 CJS Add impedance_model_type_FH2
129 130 !
130 131 MODULE cable_module
131 132  
... ... @@ -146,6 +147,7 @@ TYPE:: conductor_impedance_model
146 147 ! impedance_model_type_cylidrical_shell_with_conductivity
147 148 ! impedance_model_type_cylindrical_shield
148 149 ! impedance_model_type_rectangular_with_conductivity
  150 +! impedance_model_type_FH2
149 151  
150 152 integer :: impedance_model_type
151 153  
... ... @@ -173,6 +175,7 @@ TYPE:: external_conductor_model
173 175  
174 176 integer :: conductor_type
175 177 real(dp) :: conductor_radius
  178 + real(dp) :: conductor_sigma
176 179 real(dp) :: conductor_width
177 180 real(dp) :: conductor_width2
178 181 real(dp) :: conductor_height
... ... @@ -277,6 +280,7 @@ integer,parameter :: impedance_model_type_filter
277 280 integer,parameter :: impedance_model_type_cylidrical_shell_with_conductivity =3
278 281 integer,parameter :: impedance_model_type_cylindrical_shield =4
279 282 integer,parameter :: impedance_model_type_rectangular_with_conductivity =5
  283 +integer,parameter :: impedance_model_type_FH2 =6
280 284  
281 285 CONTAINS
282 286  
... ... @@ -335,6 +339,7 @@ include 'conductor_impedance_model.F90'
335 339  
336 340 ext_model%conductor_type=0d0
337 341 ext_model%conductor_radius=0d0
  342 + ext_model%conductor_sigma=0d0
338 343 ext_model%conductor_width=0d0
339 344 ext_model%conductor_width2=0d0
340 345 ext_model%conductor_height=0d0
... ... @@ -512,6 +517,7 @@ END SUBROUTINE reset_external_conductor_model
512 517 do i=1,cable%n_external_conductors
513 518 read(file_unit,*) cable%external_model(i)%conductor_type
514 519 read(file_unit,*) cable%external_model(i)%conductor_radius
  520 + read(file_unit,*) cable%external_model(i)%conductor_sigma
515 521 read(file_unit,*) cable%external_model(i)%conductor_width
516 522 read(file_unit,*) cable%external_model(i)%conductor_width2
517 523 read(file_unit,*) cable%external_model(i)%conductor_height
... ... @@ -703,6 +709,7 @@ END SUBROUTINE reset_external_conductor_model
703 709 do i=1,cable%n_external_conductors
704 710 write(file_unit,*) cable%external_model(i)%conductor_type,' conductor type'
705 711 write(file_unit,*) cable%external_model(i)%conductor_radius ,' conductor_radius '
  712 + write(file_unit,*) cable%external_model(i)%conductor_sigma ,' conductor_sigma '
706 713 write(file_unit,*) cable%external_model(i)%conductor_width ,' conductor_width '
707 714 write(file_unit,*) cable%external_model(i)%conductor_width2 ,' conductor_width2 '
708 715 write(file_unit,*) cable%external_model(i)%conductor_height ,' conductor_height '
... ...
SRC/CABLE_MODULES/coax.F90
  Diff comments   View file @ca8ab9e
... ... @@ -245,6 +245,7 @@ IMPLICIT NONE
245 245 CALL reset_external_conductor_model(cable%external_model(1))
246 246 cable%external_model(1)%conductor_type=circle
247 247 cable%external_model(1)%conductor_radius=rs
  248 + cable%external_model(1)%conductor_sigma=sigma_s
248 249 cable%external_model(1)%dielectric_radius=rd
249 250 cable%external_model(1)%dielectric_epsr=epsr2
250 251  
... ...
SRC/CABLE_MODULES/conductor_impedance_model.F90
  Diff comments   View file @ca8ab9e
... ... @@ -39,6 +39,7 @@
39 39 ! impedance_model_type_cylidrical_shell_with_conductivity
40 40 ! impedance_model_type_cylindrical_shield
41 41 ! impedance_model_type_rectangular_with_conductivity
  42 +! impedance_model_type_FH2
42 43  
43 44 ! File Contents:
44 45 ! SUBROUTINE read_conductor_impedance_model
... ... @@ -133,6 +134,10 @@ IMPLICIT NONE
133 134 read(unit,*,ERR=9000)conductor_impedance%height
134 135 read(unit,*,ERR=9000)conductor_impedance%conductivity
135 136 read(unit,*,ERR=9000)conductor_impedance%Resistance_multiplication_factor
  137 +
  138 + else if (conductor_impedance%impedance_model_type.EQ.impedance_model_type_FH2) then
  139 +
  140 + read(unit,*,ERR=9000)conductor_impedance%Rdc
136 141  
137 142 else
138 143  
... ... @@ -224,6 +229,10 @@ IMPLICIT NONE
224 229 write(unit,*)conductor_impedance%height,' # conductor height'
225 230 write(unit,*)conductor_impedance%conductivity,' # conductivity'
226 231 write(unit,*)conductor_impedance%Resistance_multiplication_factor,' # Resistance_multiplication_factor'
  232 +
  233 + else if (conductor_impedance%impedance_model_type.EQ.impedance_model_type_FH2) then
  234 +
  235 + write(unit,*)conductor_impedance%Rdc,' # conductor dc resistance'
227 236  
228 237 end if
229 238  
... ... @@ -344,6 +353,13 @@ IMPLICIT NONE
344 353 t=conductor_impedance%height
345 354  
346 355 CALL calculate_internal_impedance_rectangular(sigma,w,t,f,Z_c,Rdc_c)
  356 +
  357 + else if (conductor_impedance%impedance_model_type.EQ.impedance_model_type_FH2) then
  358 +
  359 + Z_c=conductor_impedance%Rdc
  360 + Rdc_c=conductor_impedance%Rdc
  361 + Z_t=(0d0,0d0)
  362 + Rdc_t=0d0
347 363  
348 364 end if
349 365  
... ...
SRC/CABLE_MODULES/cylindrical.F90
  Diff comments   View file @ca8ab9e
... ... @@ -174,6 +174,7 @@ IMPLICIT NONE
174 174 CALL reset_external_conductor_model(cable%external_model(1))
175 175 cable%external_model(1)%conductor_type=circle
176 176 cable%external_model(1)%conductor_radius=r
  177 + cable%external_model(1)%conductor_sigma=sigma
177 178 cable%external_model(1)%dielectric_radius=rd
178 179 cable%external_model(1)%dielectric_epsr=epsr
179 180  
... ...
SRC/CREATE_SPICE_CIRCUIT_MODEL/create_spice_subcircuit_model.F90
  Diff comments   View file @ca8ab9e
... ... @@ -57,7 +57,7 @@
57 57 !
58 58 ! STAGE_9, generate the information required for and then write the transfer impedance coupling model(s) as required
59 59 ! STAGE_10, generate the information required for and then write the incident field excitation model as required
60   -! STAGE 11: Dallocate the domain based information
  60 +! STAGE 11: Deallocate the domain based information
61 61 !
62 62 ! COMMENTS
63 63 ! 1. The notation needs to be organised a bit better.
... ...
SRC/GENERAL_MODULES/frequency_spec.F90
  Diff comments   View file @ca8ab9e
... ... @@ -69,6 +69,7 @@ real(dp) :: fmin ! minimum frequency
69 69 real(dp) :: fmax ! maximum frequency
70 70 integer :: n_frequencies ! number of frequencies
71 71 real(dp),allocatable ::freq_list(:)! list of frequencies
  72 +real(dp) :: ndec ! number of frequencies per decade: used in FastHenry2
72 73  
73 74 END TYPE frequency_specification
74 75  
... ... @@ -247,12 +248,16 @@ integer :: ierr
247 248 log_fstep=(log_fmax-log_fmin)/dble(freq_data%n_frequencies-1)
248 249 end if
249 250  
  251 + freq_data%ndec=dble(freq_data%n_frequencies-1)/log10(freq_data%fmax/freq_data%fmin)
  252 +
250 253 else if (freq_data%freq_range_type.EQ.'lin') then
251 254  
252 255 fstep=0d0 ! this is the value used if freq_data%n_frequencies=1
253 256 if (freq_data%n_frequencies.ne.1) then
254 257 fstep=(freq_data%fmax-freq_data%fmin)/dble(freq_data%n_frequencies-1)
255 258 end if
  259 +
  260 + freq_data%ndec=0d0
256 261  
257 262 else
258 263  
... ...
SRC/GENERAL_MODULES/general_module.F90
  Diff comments   View file @ca8ab9e
... ... @@ -267,6 +267,14 @@ integer,parameter :: local_file_unit=90
267 267  
268 268 integer,parameter :: temp_file_unit=99
269 269  
  270 +! FastHenry2 default conductor meshing parameters
  271 +
  272 +integer :: FH2_nlayers_radius=4
  273 +integer :: FH2_nw=3
  274 +integer :: FH2_nh=3
  275 +real(dp):: FH2_rw=2.0
  276 +real(dp):: FH2_rh=2.0
  277 +
270 278 CONTAINS
271 279  
272 280 include 'add_integer_to_string.F90'
... ...
SRC/MTL_ANALYTIC_SOLUTION/frequency_domain_analysis.F90
  Diff comments   View file @ca8ab9e
... ... @@ -278,7 +278,7 @@ integer :: ierr ! error code for matrix inverse calls
278 278 end do ! next col
279 279 end do ! next row
280 280  
281   -! calculate the contribution to the matrices from the conductor based impedance models. Initailly set to zero
  281 +! calculate the contribution to the matrices from the conductor based impedance models. Initially set to zero
282 282 ! See Theory_Manual_Section 2.2.3
283 283  
284 284 Z_domain_conductor_impedance_correction(1:dim,1:dim)=(0d0,0d0)
... ... @@ -479,7 +479,7 @@ integer :: ierr ! error code for matrix inverse calls
479 479  
480 480 ! Add the conductor impedance contributions to the domain based impedance matrix
481 481 Z_domain(:,:)=Z_domain(:,:)+Z_domain_conductor_impedance_correction(:,:)
482   -
  482 +
483 483 if (verbose) then
484 484  
485 485 write(*,*)'[R_domain]=Re[Z_domain]'
... ...
SRC/MTL_ANALYTIC_SOLUTION/propagation_correction_filters.F90
  Diff comments   View file @ca8ab9e
... ... @@ -173,7 +173,7 @@ integer :: ierr
173 173 ALLOCATE( Correction(1:dim,1:freq_spec%n_frequencies) )
174 174 ALLOCATE( Hp(1:freq_spec%n_frequencies) )
175 175  
176   -! if (plot_propagation_correction_filter_fit_data) then
  176 + if (plot_propagation_correction_filter_fit_data) then
177 177  
178 178 ! open files for plotting the propagation correction functions
179 179  
... ... @@ -206,7 +206,7 @@ integer :: ierr
206 206  
207 207 close(unit=80)
208 208  
209   -! end if ! plot_propagation_correction_filter_fit_data
  209 + end if ! plot_propagation_correction_filter_fit_data
210 210  
211 211 ! loop over frequency working out the correction required for each mode at each frequency
212 212 ! Note we work downwards in frequency as we use high frequency values of L and C to define the
... ... @@ -243,7 +243,7 @@ integer :: ierr
243 243  
244 244 end do ! next row
245 245  
246   -! Use the pre_calulcated delay (input to the subroutine) to obtain GAMMA_C_hf
  246 +! Use the pre_calculated delay (input to the subroutine) to obtain GAMMA_C_hf
247 247 ! Theory_Manual_Eqns 3.81, 3.82, 3.83
248 248  
249 249 GAMMA_C_hf(:)=j*w*delay(:)/length
... ... @@ -422,9 +422,9 @@ integer :: ierr
422 422  
423 423 if (plot_propagation_correction_filter_fit_data) then
424 424 ! write propagation correction data for plotting
425   -! write(80+row,8000)f,real(Correction(row,frequency_loop)), &
426   -! aimag(Correction(row,frequency_loop)),abs(Correction(row,frequency_loop))
427   - write(80+row,8000)f,real(GAMMA_C(local_mode)),aimag(GAMMA_C(local_mode)),real(GAMMA_C_hf(row)),aimag(GAMMA_C_hf(row))
  425 + write(80+row,8000)f,real(Correction(row,frequency_loop)), &
  426 + aimag(Correction(row,frequency_loop)),abs(Correction(row,frequency_loop))
  427 +! write(80+row,8000)f,real(GAMMA_C(local_mode)),aimag(GAMMA_C(local_mode)),real(GAMMA_C_hf(row)),aimag(GAMMA_C_hf(row))
428 428 end if
429 429 8000 format(5E16.6)
430 430  
... ... @@ -452,6 +452,7 @@ integer :: ierr
452 452  
453 453 ! Call the filter fitting process with this mode propagation correction data
454 454 ! with border=aorder and fit_type=1 i.e. Hfilter(f=0)=1 is imposed
  455 +
455 456 CALL Calculate_Sfilter(Hp,freq_spec%freq_list,freq_spec%n_frequencies,Hfilter(i),model_order,0,1)
456 457  
457 458 if (plot_propagation_correction_filter_fit_data) then
... ... @@ -459,7 +460,10 @@ integer :: ierr
459 460 open(unit=80,file=trim(filename(i))//'_fit')
460 461  
461 462 do frequency_loop=1,freq_spec%n_frequencies
462   -
  463 +
  464 + f=freq_spec%freq_list(frequency_loop)
  465 +! shift the frequency from d.c. as jwL, jwC are zero at d.c. and this messes up the process
  466 + if (f.EQ.0d0) f=1d0
463 467 write(80,8010)f,evaluate_Sfilter_frequency_response(Hfilter(i),f)
464 468 8010 format(3E16.6)
465 469  
... ...
SRC/Makefile
  Diff comments   View file @ca8ab9e
... ... @@ -199,7 +199,8 @@ cable_bundle_model_builder \
199 199 spice_cable_bundle_model_builder \
200 200 shield_conductor_and_transfer_impedance_model_builder \
201 201 rational_function_fit \
202   -compare_results
  202 +compare_results \
  203 +write_FH_input_file
203 204  
204 205 MAKE_COMPILATION_DATE:
205 206 echo "SPICE_CABLE_MODEL_BUILDER_compilation_date='$(COMPILATION_DATE)' " > compilation_date.inc
... ... @@ -264,6 +265,11 @@ rational_function_fit: rational_function_fit.F90 $(MODS)
264 265 compare_results: compare_results.F90 $(TYPE_SPEC_MODULE)
265 266 $(FC) $(FLAGS) -o $(EXECUTABLE_DIR)/compare_results compare_results.F90 $(OBJS) $(LIBS)
266 267  
  268 +write_FH_input_file: write_FH_input_file.F90 WRITE_FH2_IPFILE/create_grid.F90 \
  269 + WRITE_FH2_IPFILE/get_grid_type.F90 \
  270 + WRITE_FH2_IPFILE/set_segments_from_grid.F90
  271 + $(FC) $(FLAGS) -o $(EXECUTABLE_DIR)/write_FH_input_file write_FH_input_file.F90 $(TYPE_SPEC_OBJS)
  272 +
267 273 clean:
268 274 ( rm -f $(EXECUTABLE_DIR)/cable_model_builder* )
269 275 ( rm -f $(EXECUTABLE_DIR)/cable_bundle_model_builder* )
... ... @@ -271,6 +277,7 @@ clean:
271 277 ( rm -f $(EXECUTABLE_DIR)/shield_conductor_and_transfer_impedance_model_builder* )
272 278 ( rm -f $(EXECUTABLE_DIR)/rational_function_fit* )
273 279 ( rm -f $(EXECUTABLE_DIR)/compare_results* )
  280 + ( rm -f $(EXECUTABLE_DIR)/write_FH_input_file* )
274 281 ( rm -f *.o )
275 282 ( rm -f $(OBJ_MOD_DIR)/*.mod )
276 283 ( rm -f $(OBJ_MOD_DIR)/*.o )
... ...
SRC/PUL_PARAMETER_CALCULATION/PUL_LC_Laplace.F90
  Diff comments   View file @ca8ab9e
... ... @@ -1237,10 +1237,9 @@ IMPLICIT NONE
1237 1237  
1238 1238 else
1239 1239  
1240   -! There are frequency dependent dielectrics or proximity effects present
1241   -! Secondly we calculate the capacitance matrix at a number of frequencies before fitting filter functions
  1240 +! There are frequency dependent dielectrics present
  1241 +! We calculate the capacitance matrix at a number of frequencies before fitting filter functions
1242 1242 ! to each of the frequency dependent admittance matrix entries.
1243   -! 23/10/2023: Call FastHenry2 for proximity effects if required
1244 1243  
1245 1244 ! allocate the frequency dependent matrices
1246 1245 ALLOCATE( C_freq(1:freq_spec%n_frequencies) )
... ... @@ -1305,7 +1304,6 @@ IMPLICIT NONE
1305 1304 ! make the matrix symmetrical
1306 1305 PUL%Yfilter%sfilter_mat(col,row)=PUL%Yfilter%sfilter_mat(row,col)
1307 1306 PUL%Zfilter%sfilter_mat(col,row)=PUL%Zfilter%sfilter_mat(row,col)
1308   -
1309 1307 end if
1310 1308  
1311 1309 end do ! next col
... ... @@ -1341,7 +1339,6 @@ IMPLICIT NONE
1341 1339 CALL dwrite_matrix(PUL%C%mat,matrix_dimension,matrix_dimension,matrix_dimension,0)
1342 1340 write(*,*)'Conductance matrix, G'
1343 1341 CALL dwrite_matrix(PUL%G%mat,matrix_dimension,matrix_dimension,matrix_dimension,0)
1344   -
1345 1342 end if
1346 1343  
1347 1344 if (allocated( dielectric_region_epsr )) DEALLOCATE( dielectric_region_epsr )
... ...
SRC/PUL_PARAMETER_CALCULATION/PUL_RL_FastHenry2.F90
  Diff comments   View file @ca8ab9e
... ... @@ -75,8 +75,6 @@ IMPLICIT NONE
75 75 integer,parameter :: outside=2
76 76  
77 77 ! local variables
78   -
79   - integer :: ndec
80 78  
81 79 integer :: first_conductor,last_conductor,conductor
82 80  
... ... @@ -85,6 +83,13 @@ IMPLICIT NONE
85 83  
86 84 ! Process_Zc variables:
87 85  
  86 + integer :: matrix_dimension
  87 +
  88 + complex(dp),allocatable :: function_to_fit(:) ! complex function to be fitted using Sfilter_fit
  89 +
  90 + real(dp) :: ferr
  91 +
  92 + real(dp) :: gp_half_width
88 93  
89 94 character(LEN=256) :: line
90 95 character(LEN=256) :: freq_and_dim_string
... ... @@ -96,11 +101,13 @@ integer :: i
96 101 integer :: n_freq_in
97 102  
98 103 real(dp) :: freq,w
99   -integer :: nrows,ncols,r,c
  104 +integer :: nrows,ncols,r,c,row,col
100 105  
101 106 complex(dp),allocatable :: Zc_in(:,:,:)
102 107 real(dp),allocatable :: freq_in(:)
103 108  
  109 +real(dp),allocatable :: Rdc_domain(:,:)
  110 +
104 111 real(dp),allocatable :: values(:),re,im
105 112  
106 113 logical :: subtract_dc_resistance
... ... @@ -111,16 +118,25 @@ integer :: ierr
111 118  
112 119  
113 120 ! START
114   - if (verbose) write(*,*)'CALLED: PUL_LC_Laplace'
  121 + if (verbose) write(*,*)'CALLED: PUL_RL_FastHenry2'
115 122  
116   -! 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)
  123 +! work out the local frequency sampling: FastHenry uses a specific form based on log frequency
  124 +! and number of samples per decade
117 125  
118 126 write(*,*)'Filter fit order=',fit_order
119 127 write(*,*)'fmin=',freq_spec%fmin
120 128 write(*,*)'fmax=',freq_spec%fmax
121   - write(*,*)'n_frequencies=',freq_spec%n_frequencies
  129 + write(*,*)'n_frequencies=',freq_spec%n_frequencies
  130 + write(*,*)'ndec=',freq_spec%ndec
122 131  
123   - ndec=NINT(real(freq_spec%n_frequencies)/log10(freq_spec%fmax/freq_spec%fmin))
  132 + if (freq_spec%freq_range_type.EQ.'lin') then
  133 + write(run_status,*)'ERROR in PUL_RL_FastHenry2: We must have a logarithmic frequency range specified'
  134 + CALL write_program_status()
  135 + STOP 1
  136 +
  137 + end if
  138 +
  139 +! 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)
124 140  
125 141 ! write the file which is used to generate to FastHenry2 input file
126 142 OPEN(unit=fh2_input_file_unit,file='fh2.txt')
... ... @@ -136,21 +152,42 @@ integer :: ierr
136 152  
137 153 write(fh2_input_file_unit,'(A)')'ground_plane'
138 154  
139   -! ********* HARD WIRED GROUND PLANE SPEC: TO BE SORTED OUT ************
140   - write(fh2_input_file_unit,'(A)')'-25e-3 0.0e-3 0.0e-3 ! x y z of ground plane point 1 '
141   - write(fh2_input_file_unit,'(A)')' 25e-3 0.0e-3 0.0e-3 ! x y z of ground plane point 2 '
142   - write(fh2_input_file_unit,'(A)')' 25e-3 0.0e-3 1000.0e-3 ! x y z of ground plane point 3 '
143   - write(fh2_input_file_unit,'(A)')'0.01e-3 ! thickness '
144   - write(fh2_input_file_unit,'(A)')'10 10 ! discretisation in p1-p2 and p2=p3 directions'
145   - write(fh2_input_file_unit,'(A)')'4.461E+07 ! conductivity, sigma '
146   - write(fh2_input_file_unit,'(A)')'1 ! gp discretisation in thickness, nhinc '
  155 +! ********* STILL SOME HARD WIRED GROUND PLANE SPEC: TO BE SORTED OUT ************
  156 +
  157 +! ALSO NEED TO CHECK THAT EVERYTHING WE NEED IS SET...
  158 +
  159 + write(*,*)'Ground plane parameters:'
  160 + write(*,*)'PUL%ground_plane_w=',PUL%ground_plane_w
  161 + write(*,*)'PUL%ground_plane_h=',PUL%ground_plane_h
  162 + write(*,*)'PUL%ground_plane_sigma=',PUL%ground_plane_sigma
  163 + write(*,*)'PUL%ground_plane_nsegx=',PUL%ground_plane_nsegx
  164 + write(*,*)'PUL%ground_plane_nsegz=',PUL%ground_plane_nsegz
  165 + write(*,*)'PUL%ground_plane_nh=',PUL%ground_plane_nh
  166 +
  167 + if ( (PUL%ground_plane_w.EQ.0d0).OR.(PUL%ground_plane_h.EQ.0d0).OR.(PUL%ground_plane_sigma.EQ.0d0) &
  168 + .OR.(PUL%ground_plane_nsegx.EQ.0).OR.(PUL%ground_plane_nsegz.EQ.0).OR.(PUL%ground_plane_nh.EQ.0) )then
  169 + write(run_status,*)'ERROR in PUL_RL_FastHenry2: ground plane parameters not defined'
  170 + CALL write_program_status()
  171 + STOP 1
  172 + end if
  173 +
  174 + gp_half_width=PUL%ground_plane_w/2.0
  175 +
  176 + write(fh2_input_file_unit,'(ES12.4,A)')-gp_half_width,' 0.0e-3 0.0e-3 ! x y z of ground plane point 1'
  177 + write(fh2_input_file_unit,'(ES12.4,A)') gp_half_width,' 0.0e-3 0.0e-3 ! x y z of ground plane point 2'
  178 + write(fh2_input_file_unit,'(ES12.4,A)') gp_half_width,' 0.0e-3 1000.0e-3 ! x y z of ground plane point 3'
  179 + write(fh2_input_file_unit,'(ES12.4,A)')PUL%ground_plane_h,' ! thickness '
  180 + write(fh2_input_file_unit,'(2I6,A)')PUL%ground_plane_nsegx,PUL%ground_plane_nsegz, &
  181 + ' ! discretisation in p1-p2 and p2=p3 directions'
  182 + write(fh2_input_file_unit,'(ES12.4,A)')PUL%ground_plane_sigma,' ! conductivity, sigma '
  183 + write(fh2_input_file_unit,'(I4,A)')PUL%ground_plane_nh,' ! gp discretisation in thickness, nhinc '
147 184 write(fh2_input_file_unit,'(A)')'2.0 ! gp discretisation in thickness ratio, rh '
148 185 write(fh2_input_file_unit,'(A)')'0e-3 0.0e-3 0.0e-3 ! x y z of ground plane node at end 1 '
149 186 write(fh2_input_file_unit,'(A)')'0e-3 0.0e-3 1000.0e-3 ! x y z of ground plane node at end 2 '
150   -! ********* HARD WIRED GROUND PLANE SPEC: TO BE SORTED OUT ************
  187 +! ********* STILL SOME HARD WIRED GROUND PLANE SPEC: TO BE SORTED OUT ************
151 188  
152 189 else if ((.NOT.PUL%overshield_present).AND.(.NOT.PUL%ground_plane_present)) then
153   -
  190 +
154 191 first_conductor=1
155 192 last_conductor=PUL%n_conductors
156 193  
... ... @@ -174,10 +211,10 @@ integer :: ierr
174 211 write(fh2_input_file_unit,'(A)')'cylindrical ! conductor 1 shape (cylinder, rectangle, annulus)'
175 212 write(fh2_input_file_unit,'(2ES12.4,A)')PUL%x(conductor),PUL%y(conductor),' ! centre xc yc'
176 213 write(fh2_input_file_unit,'(ES12.4,A)')PUL%r(conductor),' ! radius rc'
177   - write(fh2_input_file_unit,'(ES12.4,A)')PUL%r(conductor)/8,' ! cylindrical conductor discretisation size, dl'
178   - write(fh2_input_file_unit,'(A)')'4.461E+07 ! conductivity, sigma '
179   - write(fh2_input_file_unit,'(A)')'3 3 ! segment discretisation in x and y, nwinc nhinc '
180   - write(fh2_input_file_unit,'(A)')'2.0 2.0 ! segment discretisation ratio in x and y, rw rh '
  214 + write(fh2_input_file_unit,'(ES12.4,A)')PUL%r(conductor)/FH2_nlayers_radius,' ! cylindrical conductor discretisation size, dl'
  215 + write(fh2_input_file_unit,'(ES12.4,A)')PUL%sigma(conductor),' ! conductivity, sigma '
  216 + write(fh2_input_file_unit,'(2I4,A)')FH2_nw,FH2_nh,' ! segment discretisation in x and y, nwinc nhinc '
  217 + write(fh2_input_file_unit,'(2ES12.4,A)')FH2_rw,FH2_rh,' ! segment discretisation ratio in x and y, rw rh '
181 218  
182 219 else if (PUL%shape(conductor).EQ.rectangle) then
183 220  
... ... @@ -195,12 +232,12 @@ integer :: ierr
195 232  
196 233 write(fh2_input_file_unit,'(ES12.4,A)')freq_spec%fmin,' ! Minimum frequency, fmin'
197 234 write(fh2_input_file_unit,'(ES12.4,A)')freq_spec%fmax,' ! Maximum frequency, fmax'
198   - write(fh2_input_file_unit,'(I8,A)')ndec,' ! Number of points per decade, ndec'
  235 + write(fh2_input_file_unit,'(ES12.4,A)')freq_spec%ndec,' ! Number of points per decade, ndec'
199 236  
200 237 CLOSE(unit=fh2_input_file_unit)
201 238  
202 239 write(*,*)'CALLING FastHenry2'
203   - command='/home/chris/SACAMOS_FASTHENRY2/FASTHENRY2_WRITE_INPUT_FILE/bin/write_FH_input_file < fh2.txt'
  240 + command='write_FH_input_file < fh2.txt'
204 241 CALL execute_command_line(command,EXITSTAT=exit_stat)
205 242  
206 243 ! Check that the FastHenry2 input file generated correctly
... ... @@ -306,6 +343,7 @@ integer :: ierr
306 343 if (verbose) write(*,*)'Number of frequencies=',n_freq_in
307 344 ALLOCATE( freq_in(n_freq_in) )
308 345 ALLOCATE( Zc_in(n_freq_in,nrows,ncols) )
  346 + ALLOCATE( Rdc_domain(nrows,ncols) )
309 347 ALLOCATE( values(2*ncols) )
310 348 rewind(unit=fh2_output_file_unit)
311 349 end if
... ... @@ -313,24 +351,102 @@ integer :: ierr
313 351 end do ! next file read loop
314 352  
315 353 CLOSE(unit=fh2_output_file_unit)
  354 +
  355 + matrix_dimension=PUL%n_conductors-1
  356 +
  357 + if (matrix_dimension.NE.nrows) then
  358 + write(run_status,*)'ERROR in PUL_RL_FastHenry2 matrix dimension',matrix_dimension,nrows
  359 + CALL write_program_status()
  360 + STOP 1
  361 + end if
316 362  
317   -! For now use the inductance from the highest frequency calculated
  363 +! For the modal decomposition, use the inductance from the highest frequency calculated
318 364 do r=1,nrows
319 365 do c=1,ncols
320 366  
321 367 freq=freq_in(n_freq_in)
322 368 w=2.0*pi*freq
323 369  
324   - PUL%L%mat(r,c)=real(Zc_in(n_freq_in,r,c)/(j*w))
325   - PUL%Zfilter%sfilter_mat(r,c)=jwA_filter( PUL%L%mat(r,c) )
  370 + PUL%L%mat(r,c)=real(Zc_in(n_freq_in,r,c)/(j*w))
326 371  
327   - write(*,*)r,c,PUL%L%mat(r,c)
  372 + end do
  373 + end do
  374 +
  375 +! Save the resistance matrix from the lowest frequency calculated
  376 + do r=1,nrows
  377 + do c=1,ncols
  378 +
  379 + Rdc_domain(r,c)=real(Zc_in(1,r,c))
328 380  
329 381 end do
330 382 end do
  383 +
  384 +! We calculate the inductance and resistance matrix at a number of frequencies before fitting filter functions
  385 +! to each of the frequency dependent impedance matrix entries.
  386 +
  387 + write(*,*)'**************************'
  388 + write(*,*)'Process FastHenry2 results'
  389 + write(*,*)'**************************'
  390 + write(*,*)'Number of frequencies (freq_spec) =',freq_spec%n_frequencies
  391 + write(*,*)'Number of frequencies (FastHenry2)=',n_freq_in
  392 +
  393 +! Frequency check
  394 + if (n_freq_in.NE.freq_spec%n_frequencies) then
  395 + write(run_status,*)'ERROR in PUL_RL_FastHenry2 n_frequencies specification',n_freq_in,freq_spec%n_frequencies
  396 + CALL write_program_status()
  397 + STOP 1
  398 + end if
  399 +
  400 + do floop=1,n_freq_in
  401 + ferr=abs(freq_spec%freq_list(floop)-freq_in(floop))/(freq_spec%freq_list(floop)+freq_in(floop))
  402 + if (ferr.GT.0.001) then
  403 + write(run_status,*)'ERROR in PUL_RL_FastHenry2 frequency samples, floop=',floop, &
  404 + ' freq_spec=',freq_spec%freq_list(floop),' freq_FH2=',freq_in(floop)
  405 + CALL write_program_status()
  406 + STOP 1
  407 + end if
  408 + end do
  409 +
  410 +! loop over frequency
  411 + if (verbose) then
  412 + do floop=1,n_freq_in
  413 + write(*,*)freq_spec%freq_list(floop),freq_in(floop)
  414 + end do
  415 + end if
  416 +
  417 +! we have frequency domain impedance matrix, Zc
  418 +
  419 +! loop over the elements of Zc and the Zfilter matrix by filter fitting
  420 + ALLOCATE( function_to_fit(1:freq_spec%n_frequencies) )
  421 +
  422 + do row=1,matrix_dimension
  423 + do col=row,matrix_dimension
  424 +
  425 +! get the function values for this matrix element function_to_fit=R-Rdc+jwL
  426 + do floop=1,freq_spec%n_frequencies
  427 + function_to_fit(floop)=Zc_in(floop,row,col)-Rdc_domain(row,col)
  428 + end do
  429 +
  430 +! calculate the Zfilter matrix using the filter fitting process
  431 +! note aorder=border and no restrictions are put on the function
  432 +
  433 + CALL Calculate_Sfilter(function_to_fit,freq_spec%freq_list,freq_spec%n_frequencies, &
  434 + PUL%Zfilter%sfilter_mat(row,col),fit_order+1,-1,2) ! note type 2 filter fit=> a0=0.0
  435 +
  436 + if (col.NE.row) then
  437 +! make the matrix symmetrical
  438 + PUL%Zfilter%sfilter_mat(col,row)=PUL%Zfilter%sfilter_mat(row,col)
  439 + end if
  440 +
  441 + end do ! next col
  442 +
  443 + end do ! next row
  444 +
  445 + DEALLOCATE( function_to_fit )
331 446  
332 447 DEALLOCATE( freq_in )
333 448 DEALLOCATE( Zc_in )
  449 + DEALLOCATE( Rdc_domain )
334 450 DEALLOCATE( values )
335 451  
336 452 if (verbose) then
... ...
SRC/PUL_PARAMETER_CALCULATION/PUL_parameter_module.F90
  Diff comments   View file @ca8ab9e
... ... @@ -85,6 +85,7 @@ TYPE::PUL_type
85 85  
86 86 ! conductor based arrays:
87 87 integer,allocatable :: shape(:) ! holds a nuber which indicates the shape of the conductor
  88 + real(dp),allocatable :: sigma(:) ! electrical conductivity of a conductor
88 89 real(dp),allocatable :: r(:) ! radius of a circular conductor
89 90 real(dp),allocatable :: x(:) ! x coordinate of the centre of the cable to which this conductor belongs
90 91 real(dp),allocatable :: y(:) ! y coordinate of the centre of the cable to which this conductor belongs
... ... @@ -104,7 +105,14 @@ TYPE::PUL_type
104 105 logical :: ground_plane_present ! flag to indicate the presence of a ground plane
105 106 real(dp) :: ground_plane_angle ! angle of ground plane normal from the x axis
106 107 real(dp) :: ground_plane_offset ! ground plane offset
107   -
  108 + real(dp) :: ground_plane_sigma ! ground plane conductivity
  109 + real(dp) :: ground_plane_w ! ground plane width
  110 + real(dp) :: ground_plane_h ! ground plane height
  111 + real(dp) :: ground_plane_Rdc ! ground plane dc resistance
  112 + integer :: ground_plane_nsegx ! ground plane number of segments in x
  113 + integer :: ground_plane_nsegz ! ground plane number of segments in z
  114 + integer :: ground_plane_nh ! ground plane number of layers in h
  115 +
108 116 logical :: overshield_present ! flag to indicate the presence of an overshield
109 117 integer :: overshield_shape ! holds a nuber which indicates the shape of the opvershield
110 118 real(dp) :: overshield_x ! x coordinate of the centre of the overshield
... ... @@ -184,6 +192,7 @@ include &quot;CG_solve.F90&quot;
184 192 ! allocate memory for PUL structure
185 193 PUL%n_conductors=n_conductors
186 194 ALLOCATE( PUL%shape( PUL%n_conductors) )
  195 + ALLOCATE( PUL%sigma( PUL%n_conductors) )
187 196 ALLOCATE( PUL%x( PUL%n_conductors) )
188 197 ALLOCATE( PUL%y( PUL%n_conductors) )
189 198 ALLOCATE( PUL%r( PUL%n_conductors) )
... ... @@ -204,6 +213,7 @@ include &quot;CG_solve.F90&quot;
204 213 do i=1,PUL%n_conductors
205 214  
206 215 PUL%shape(i)=0
  216 + PUL%sigma(i)=0d0
207 217 PUL%x(i)=0d0
208 218 PUL%y(i)=0d0
209 219 PUL%r(i)=0d0
... ... @@ -225,7 +235,14 @@ include &quot;CG_solve.F90&quot;
225 235 PUL%ground_plane_present=.FALSE.
226 236 PUL%ground_plane_angle=0d0
227 237 PUL%ground_plane_offset=0d0
228   -
  238 + PUL%ground_plane_sigma=0d0
  239 + PUL%ground_plane_w=0d0
  240 + PUL%ground_plane_h=0d0
  241 + PUL%ground_plane_Rdc=0d0
  242 + PUL%ground_plane_nsegx=0
  243 + PUL%ground_plane_nsegz=0
  244 + PUL%ground_plane_nh=1
  245 +
229 246 PUL%overshield_present=.FALSE.
230 247 PUL%overshield_shape=circle ! circle by default
231 248 PUL%overshield_x=0d0
... ... @@ -272,6 +289,7 @@ include &quot;CG_solve.F90&quot;
272 289 ! START
273 290  
274 291 if (allocated(PUL%shape ) ) DEALLOCATE( PUL%shape )
  292 + if (allocated(PUL%sigma ) ) DEALLOCATE( PUL%sigma )
275 293 if (allocated(PUL%x ) ) DEALLOCATE( PUL%x )
276 294 if (allocated(PUL%y ) ) DEALLOCATE( PUL%y )
277 295 if (allocated(PUL%r ) ) DEALLOCATE( PUL%r )
... ...
SRC/SFILTER_FIT/Calculate_Sfilter.F90
  Diff comments   View file @ca8ab9e
... ... @@ -39,9 +39,11 @@
39 39 ! If the model order is negative on input then the 'optimium' model is returned
40 40 ! between model order 0 and abs(model_order)
41 41 !
42   -! Two types of model are considered - s general model in which no constraints are placed on the filter function
43   -! and a model for the propagation correction in which the constraint that the value of the filter function at
  42 +! Three types of model are considered -
  43 +! 1: a general model in which no constraints are placed on the filter function
  44 +! 2: a model for the propagation correction in which the constraint that the value of the filter function at
44 45 ! zero frequency is equal to 1.0
  46 +! 3: a model for the Z-Rdc matrices where the value of the filter function at zero frequency is equal to 0.0
45 47 !
46 48 ! COMMENTS
47 49 ! The stopping criterion for calculation of the optimum model is an inflection in the function log_error(model_order)
... ... @@ -53,6 +55,7 @@
53 55 ! return the order model specified.
54 56 ! 14/10/2017 CJS include a check for unstable filters and add an absolute convergence check
55 57 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
  58 +! 25/10/2023 CJS Add a mode fit type where a0=0.0 for fitting to Z-Rdc matrices
56 59 !
57 60 !
58 61 SUBROUTINE Calculate_Sfilter(Hp,f,n_frequencies,Hfilter,model_order,relative_border,fit_type)
... ... @@ -75,6 +78,7 @@ integer,intent(IN) :: model_order ! Numerator model
75 78 integer,intent(IN) :: relative_border ! Denominator model order to calculate relative to numerator order, border=aorder+relative_border
76 79 integer,intent(IN) :: fit_type ! Type of model fit. fit_type=0 has no restrictions on f=0 value
77 80 ! fit_type=1 imposes Hfilter(f=0)=1.0
  81 + ! fit_type=2 imposes Hfilter(f=0)=0.0
78 82 ! local variables
79 83  
80 84 integer :: order
... ...
SRC/SFILTER_FIT/Weiner_Hopf.F90
  Diff comments   View file @ca8ab9e
... ... @@ -38,9 +38,11 @@
38 38 ! as described in Dawson paper [**** REFERENCE REQUIRED ****]
39 39 !
40 40 ! COMMENTS
  41 +! If fit_type=0 then we fit directly to the given function values.
41 42 ! If fit_type=1 then we impose Hfilter(f=0)=1.0. In this case we fit to a finction Hp-1 to
42 43 ! calculate a filter function with a(0)=0, then add 1 to this filter to give the result.
43   -! If fit_type=0 then we fit directly to the given function values.
  44 +! If fit_type=2 then we impose Hfilter(f=0)=0.0. In this case we fit to a finction Hp to
  45 +! calculate a filter function with a(0)=0.
44 46 !
45 47 ! HISTORY
46 48 !
... ... @@ -121,6 +123,12 @@ integer,intent(IN) :: fit_type ! Type of model fi
121 123 Hfilter%a%coeff(0)=1d0
122 124  
123 125 RETURN
  126 +
  127 + else if (fit_type.EQ.2) then ! this type has the requirement that Hfilter(f=0)=1.0 so return Hfilter=1
  128 +
  129 + Hfilter%a%coeff(0)=0d0
  130 +
  131 + RETURN
124 132  
125 133 else
126 134 ! Hfilter is effectively a real constant and can be calculated as the average of the real part of the input function values
... ... @@ -146,10 +154,17 @@ integer,intent(IN) :: fit_type ! Type of model fi
146 154 coeff_dim=aorder+1+border
147 155 first_a=0
148 156 N_a=aorder+1
149   - else ! Hfilter(f=0)=1.0 thus a(0)=1.0 and b(0)=1.0
  157 + else if (fit_type.EQ.1) then ! Hfilter(f=0)=1.0 thus a(0)=1.0 and b(0)=1.0
150 158 coeff_dim=aorder+border
151 159 first_a=1
152 160 N_a=aorder
  161 + else if (fit_type.EQ.2) then ! Hfilter(f=0)=0.0 thus a(0)=0.0 and b(0)=1.0
  162 + coeff_dim=aorder+border
  163 + first_a=1
  164 + N_a=aorder
  165 + else
  166 + write(*,*)'ERROR in Weiner_Hopf: fit_type should be 0, 1 or 2, here fit_type=',fit_type
  167 + STOP 1
153 168 end if
154 169  
155 170 ! Allocate memory for the matrices and vectors used in the calculations
... ... @@ -255,6 +270,12 @@ integer,intent(IN) :: fit_type ! Type of model fi
255 270 row=i
256 271 Hfilter%a%coeff(i)=VC(row)+Hfilter%b%coeff(i)
257 272 end do
  273 + else if (fit_type.eq.2) then ! we have a fit to Hp(f) so calculate the coefficients of H=A(jomega)/B(jomega)
  274 + Hfilter%a%coeff(0)=0d0
  275 + do i=1,aorder
  276 + row=i
  277 + Hfilter%a%coeff(i)=VC(row)
  278 + end do
258 279 else
259 280 do i=0,aorder
260 281 row=i+1
... ...
SRC/WRITE_FH2_IPFILE/create_grid.F90 0 → 100644
  Diff comments   View file @ca8ab9e
... ... @@ -0,0 +1,22 @@
  1 + if (conductor_data(conductor)%auto_grid_density) then
  2 + required_dl=conductor_data(conductor)%skin_depth ! could add reduction factor here e.g. /2.0
  3 + conductor_data(conductor)%dl=required_dl
  4 + end if
  5 +
  6 + conductor_data(conductor)%nxmax=NINT(conductor_data(conductor)%grid_dim/conductor_data(conductor)%dl)+1
  7 + conductor_data(conductor)%nxmin=-conductor_data(conductor)%nxmax
  8 +
  9 + conductor_data(conductor)%nymax=conductor_data(conductor)%nxmax
  10 + conductor_data(conductor)%nymin=conductor_data(conductor)%nxmin
  11 +
  12 + nxmin=conductor_data(conductor)%nxmin
  13 + nxmax=conductor_data(conductor)%nxmax
  14 + nymin=conductor_data(conductor)%nymin
  15 + nymax=conductor_data(conductor)%nymax
  16 +
  17 + ALLOCATE( conductor_data(conductor)%grid(nxmin:nxmax,nymin:nymax) )
  18 + ALLOCATE( conductor_data(conductor)%depth(nxmin:nxmax,nymin:nymax) )
  19 +
  20 +! Reset the grid
  21 + conductor_data(conductor)%grid(nxmin:nxmax,nymin:nymax)=0
  22 + conductor_data(conductor)%depth(nxmin:nxmax,nymin:nymax)=0.0
... ...
SRC/WRITE_FH2_IPFILE/get_grid_type.F90 0 → 100644
  Diff comments   View file @ca8ab9e
... ... @@ -0,0 +1,16 @@
  1 + conductor_data(conductor)%mesh_type=mesh_type_layer ! default
  2 + conductor_data(conductor)%mesh_to_layer_type=1
  3 +
  4 + if ( INDEX(line_string,'auto').NE.0) conductor_data(conductor)%auto_grid_density=.TRUE.
  5 +
  6 + if ( INDEX(line_string,'grid_layer').NE.0) then
  7 +
  8 + conductor_data(conductor)%mesh_type=mesh_type_grid
  9 + conductor_data(conductor)%mesh_to_layer_type=2
  10 +
  11 + else if ( INDEX(line_string,'grid').NE.0) then
  12 +
  13 + conductor_data(conductor)%mesh_type=mesh_type_grid
  14 + conductor_data(conductor)%mesh_to_layer_type=1
  15 +
  16 + end if
... ...
SRC/WRITE_FH2_IPFILE/set_segments_from_grid.F90 0 → 100644
  Diff comments   View file @ca8ab9e
... ... @@ -0,0 +1,90 @@
  1 +
  2 + nxmin=conductor_data(conductor)%nxmin
  3 + nxmax=conductor_data(conductor)%nxmax
  4 + nymin=conductor_data(conductor)%nymin
  5 + nymax=conductor_data(conductor)%nymax
  6 +
  7 + layer_number=0
  8 +
  9 + if (conductor_data(conductor)%mesh_to_layer_type.EQ.1) then
  10 +! each marked cell in the grid becomes a layer and hence a segment
  11 +
  12 + do ix=nxmin,nxmax
  13 + do iy=nymin,nymax
  14 + if ( conductor_data(conductor)%grid(ix,iy).EQ.1 ) then
  15 +
  16 + layer_number=layer_number+1
  17 +
  18 + apx=conductor_data(conductor)%xc+real(ix)*conductor_data(conductor)%dl
  19 + apy=conductor_data(conductor)%yc+real(iy)*conductor_data(conductor)%dl
  20 +
  21 + conductor_data(conductor)%x(layer_number)=apx
  22 + conductor_data(conductor)%y(layer_number)=apy
  23 + conductor_data(conductor)%w(layer_number)=conductor_data(conductor)%dl
  24 + conductor_data(conductor)%h(layer_number)=conductor_data(conductor)%dl
  25 +
  26 + conductor_data(conductor)%d(layer_number)=0.0
  27 + conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
  28 + conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
  29 +
  30 + end if
  31 + end do
  32 + end do
  33 +
  34 + else if (conductor_data(conductor)%mesh_to_layer_type.EQ.2) then
  35 +
  36 +! each row of cells in the grid becomes a segment
  37 + do iy=nymin,nymax
  38 +
  39 + in_conductor=.FALSE.
  40 + cx1=0
  41 + cx2=0
  42 +
  43 + do ix=nxmin,nxmax
  44 +
  45 + if ( (.NOT.in_conductor).AND.(conductor_data(conductor)%grid(ix,iy).EQ.1) ) then
  46 +
  47 +! we have moved from air to conductor so save this x cell number
  48 + cx1=ix
  49 + in_conductor=.TRUE.
  50 +
  51 + else if ( (in_conductor).AND.(conductor_data(conductor)%grid(ix,iy).EQ.0) ) then
  52 +! we have moved from air to conductor so save this x cell number
  53 +
  54 + cx2=ix-1
  55 + in_conductor=.FALSE.
  56 +
  57 + layer_number=layer_number+1
  58 +
  59 + cw=real(cx2-cx1+1)*conductor_data(conductor)%dl
  60 + ch=conductor_data(conductor)%dl
  61 +
  62 + apx=conductor_data(conductor)%xc+real(cx2+cx1)/2.0
  63 + apy=conductor_data(conductor)%yc+real(iy)*conductor_data(conductor)%dl
  64 +
  65 + conductor_data(conductor)%x(layer_number)=apx
  66 + conductor_data(conductor)%y(layer_number)=apy
  67 + conductor_data(conductor)%w(layer_number)=cw
  68 + conductor_data(conductor)%h(layer_number)=ch
  69 +
  70 + conductor_data(conductor)%d(layer_number)=0.0
  71 + conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
  72 + conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
  73 +
  74 + cx1=0
  75 + cx2=0
  76 +
  77 + end if
  78 +
  79 + end do ! next col
  80 +
  81 + end do ! next row
  82 +
  83 + else
  84 + write(*,*)'Unknown mesh_to_layer_type:',conductor_data(conductor)%mesh_to_layer_type, &
  85 + 'in conductor',conductor
  86 + STOP 1
  87 + end if
  88 +
  89 +! the number of layers may have changed if we have combined grid cells
  90 + conductor_data(conductor)%tot_n_layers=layer_number
... ...
SRC/cable_bundle_model_builder.F90
  Diff comments   View file @ca8ab9e
... ... @@ -111,6 +111,7 @@ type(bundle_specification_type) ::bundle_spec
111 111 logical :: file_exists
112 112  
113 113 character(len=line_length) :: line
  114 +character(len=line_length) :: stripped_line
114 115  
115 116 integer :: ierr,ierr2 ! integers to return error codes from file reads
116 117  
... ... @@ -246,7 +247,8 @@ logical :: must_use_laplace
246 247  
247 248 bundle_spec%n_cables_without_ground_plane=bundle_spec%n_cables
248 249  
249   - if (line.eq.'ground_plane') then
  250 +! if (line.eq.'ground_plane') then
  251 + if (index(line,'ground_plane').EQ.1) then
250 252  
251 253 bundle_spec%ground_plane_present=.TRUE.
252 254  
... ... @@ -272,13 +274,49 @@ logical :: must_use_laplace
272 274 bundle_spec%cable_x_offset(cable)=bundle_spec%ground_plane_x
273 275 bundle_spec%cable_y_offset(cable)=bundle_spec%ground_plane_y
274 276 bundle_spec%cable_angle(cable)=bundle_spec%ground_plane_theta
  277 +
  278 +! Attempt to read additional parameters for FastHenry2 calculation, sigma, width, thickness
  279 + stripped_line=line(13:line_length)
  280 + read(stripped_line,*,ERR=100,END=100)bundle_spec%ground_plane_sigma &
  281 + ,bundle_spec%ground_plane_w &
  282 + ,bundle_spec%ground_plane_h &
  283 + ,bundle_spec%ground_plane_nsegx &
  284 + ,bundle_spec%ground_plane_nsegz &
  285 + ,bundle_spec%ground_plane_nh
  286 +
  287 + bundle_spec%ground_plane_Rdc=1d0/(bundle_spec%ground_plane_sigma*bundle_spec%ground_plane_w*bundle_spec%ground_plane_h)
275 288  
276 289 ! create conductor impedance model for the new cable
277 290 ALLOCATE(bundle_spec%cable(cable)%conductor_impedance(1:1))
  291 + bundle_spec%cable(cable)%conductor_impedance(1)%impedance_model_type=impedance_model_type_FH2
  292 + bundle_spec%cable(cable)%conductor_impedance(1)%Resistance_multiplication_factor=1d0
  293 + bundle_spec%cable(cable)%conductor_impedance(1)%radius=0d0
  294 + bundle_spec%cable(cable)%conductor_impedance(1)%conductivity=bundle_spec%ground_plane_sigma
  295 + bundle_spec%cable(cable)%conductor_impedance(1)%width=bundle_spec%ground_plane_w
  296 + bundle_spec%cable(cable)%conductor_impedance(1)%height=bundle_spec%ground_plane_h
  297 + bundle_spec%cable(cable)%conductor_impedance(1)%Rdc=bundle_spec%ground_plane_Rdc
  298 +
  299 + GOTO 200
  300 +
  301 +100 CONTINUE ! jump here if we have failed to read FastHenry2 parameters
  302 +! create conductor impedance model for the new cable
  303 + ALLOCATE(bundle_spec%cable(cable)%conductor_impedance(1:1))
278 304 bundle_spec%cable(cable)%conductor_impedance(1)%impedance_model_type=impedance_model_type_PEC
279 305 bundle_spec%cable(cable)%conductor_impedance(1)%Resistance_multiplication_factor=1d0
280 306 bundle_spec%cable(cable)%conductor_impedance(1)%radius=0d0
281 307 bundle_spec%cable(cable)%conductor_impedance(1)%conductivity=0d0
  308 + bundle_spec%cable(cable)%conductor_impedance(1)%width=0d0
  309 + bundle_spec%cable(cable)%conductor_impedance(1)%height=0d0
  310 + bundle_spec%cable(cable)%conductor_impedance(1)%Rdc=0d0
  311 + bundle_spec%ground_plane_sigma=0d0
  312 + bundle_spec%ground_plane_w=0d0
  313 + bundle_spec%ground_plane_h=0d0
  314 + bundle_spec%ground_plane_Rdc=0d0
  315 + bundle_spec%ground_plane_nsegx=0
  316 + bundle_spec%ground_plane_nsegz=0
  317 + bundle_spec%ground_plane_nh=0
  318 +
  319 +200 CONTINUE ! jump here if we do have FastHenry2 parameters
282 320  
283 321 else if (line.eq.'no_ground_plane') then
284 322  
... ... @@ -311,14 +349,14 @@ logical :: must_use_laplace
311 349 if (ierr.NE.0) then
312 350 ! Assume there is no filter fit information specified so move on to the next stage
313 351 backspace(bundle_spec_file_unit)
314   - goto 100
  352 + goto 300
315 353 end if
316 354  
317 355 write(*,*)'Reading the filter fit frequency range'
318 356  
319 357 CALL read_and_set_up_frequency_specification(bundle_spec%Y_fit_freq_spec,bundle_spec_file_unit)
320 358  
321   -100 continue
  359 +300 continue
322 360  
323 361 ! the file can contain flags to control the running of the software and the output
324 362 rewind(bundle_spec_file_unit)
... ... @@ -326,7 +364,7 @@ logical :: must_use_laplace
326 364 write(*,*)'Processing flags'
327 365  
328 366 do
329   - read(bundle_spec_file_unit,*,END=110,ERR=110)line
  367 + read(bundle_spec_file_unit,'(A)',END=310,ERR=310)line
330 368 CALL convert_to_lower_case(line,line_length)
331 369  
332 370 ! Set flags according to the information at the end of the .spice_model_spec file
... ... @@ -336,8 +374,7 @@ logical :: must_use_laplace
336 374 if (INDEX(line,'no_s_xfer').NE.0) use_s_xfer=.FALSE.
337 375 if (INDEX(line,'use_laplace').NE.0) use_Laplace=.TRUE.
338 376 if (INDEX(line,'no_laplace').NE.0) use_Laplace=.FALSE.
339   - if (INDEX(line,'use_fasthenry').NE.0) use_FastHenry=.TRUE.
340   - if (INDEX(line,'no_fasthenry').NE.0) use_FastHenry=.FALSE.
  377 +
341 378 if (INDEX(line,'plot_potential').NE.0) plot_potential=.TRUE.
342 379 if (INDEX(line,'no_plot_potential').NE.0) plot_potential=.FALSE.
343 380 if (INDEX(line,'plot_mesh').NE.0) plot_mesh=.TRUE.
... ... @@ -376,10 +413,24 @@ logical :: must_use_laplace
376 413 if (INDEX(line,'cg_tol').NE.0) then
377 414 read(bundle_spec_file_unit,*,END=9000,ERR=9000)cg_tol
378 415 end if
  416 +
  417 + if (INDEX(line,'no_fasthenry').NE.0) use_FastHenry=.FALSE.
  418 +
  419 + if (INDEX(line,'use_fasthenry').EQ.1) then
  420 + use_FastHenry=.TRUE.
  421 +
  422 + stripped_line=line(14:line_length)
  423 + read(stripped_line,*,ERR=305,END=305)FH2_nlayers_radius,FH2_nw,FH2_nh,FH2_rw,FH2_rh
  424 +
  425 + write(*,*)'use_FastHenry=.TRUE.'
  426 + write(*,*)'Parameters:',FH2_nlayers_radius,FH2_nw,FH2_nh,FH2_rw,FH2_rh
  427 +305 CONTINUE
379 428  
  429 + end if
  430 +
380 431 end do ! continue until all flags are read - indicated by an end of file.
381 432  
382   -110 CONTINUE
  433 +310 CONTINUE
383 434  
384 435 ! close the bundle_spec file
385 436  
... ...
SRC/spice_cable_bundle_model_builder.F90
  Diff comments   View file @ca8ab9e
... ... @@ -88,7 +88,7 @@
88 88 ! 24/2/2017 CJS Allow the input name to include a path i.e. the _spec file does not need to be local.
89 89 ! 28/2/2017 CJS Make the validation test circuit model optional
90 90 ! 16/11/2017 CJS Include network synthesis process to replace s-domain transfer functions
91   -!
  91 +! 24/11/2023 CJS Start to embed FastHenry2 frequency dependent impedance matrix
92 92 !
93 93 PROGRAM spice_cable_bundle_model_builder
94 94  
... ... @@ -574,6 +574,8 @@ integer :: i
574 574  
575 575 if (INDEX(line,'use_analytic_i').NE.0) run_validation_test_Vbased=.FALSE.
576 576 if (INDEX(line,'use_analytic_v').NE.0) run_validation_test_Vbased=.TRUE.
  577 +
  578 + if (INDEX(line,'plot_propagation_correction_filter_fit_data').NE.0) plot_propagation_correction_filter_fit_data=.TRUE.
577 579  
578 580 if (INDEX(line,'min_delay').NE.0) then
579 581  
... ...
SRC/write_FH_input_file.F90 0 → 100644
  Diff comments   View file @ca8ab9e
... ... @@ -0,0 +1,1020 @@
  1 +PROGRAM write_FH_input_file
  2 +
  3 +USE type_specifications
  4 +
  5 +IMPLICIT NONE
  6 +
  7 +integer :: n_conductors
  8 +
  9 +logical :: ground_plane
  10 +
  11 +integer :: mesh_type
  12 +
  13 +real(dp) :: gp_x(3),gp_y(3),gp_z(3)
  14 +
  15 +real(dp) :: gp_t,gp_sigma,gp_rh,gp_ex1,gp_ey1,gp_ez1,gp_ex2,gp_ey2,gp_ez2
  16 +real(dp) :: gp_skin_depth
  17 +integer :: gp_nhinc,gp_seg1,gp_seg2
  18 +
  19 +character(len=80),allocatable :: gp_node1
  20 +character(len=80),allocatable :: gp_node2
  21 +
  22 +character(len=80),allocatable :: gp_node1_external
  23 +character(len=80),allocatable :: gp_node2_external
  24 +
  25 +TYPE::conductor_type
  26 +
  27 + integer :: type
  28 + integer :: mesh_type
  29 + integer :: mesh_to_layer_type
  30 +
  31 + real(dp) :: rc
  32 + real(dp) :: rci
  33 + real(dp) :: rco
  34 + real(dp) :: xc
  35 + real(dp) :: yc
  36 + real(dp) :: width
  37 + real(dp) :: height
  38 + integer :: n_layers2
  39 + integer :: tot_n_layers
  40 +
  41 + real(dp),allocatable :: x(:)
  42 + real(dp),allocatable :: y(:)
  43 + real(dp),allocatable :: w(:)
  44 + real(dp),allocatable :: h(:)
  45 + real(dp),allocatable :: d(:)
  46 + integer,allocatable :: anwinc(:)
  47 + integer,allocatable :: anhinc(:)
  48 +
  49 + real(dp),allocatable :: wx(:)
  50 + real(dp),allocatable :: wy(:)
  51 + real(dp),allocatable :: wz(:)
  52 +
  53 + real(dp) :: sigma
  54 + real(dp) :: dl
  55 + integer :: nwinc
  56 + integer :: nhinc
  57 + real(dp) :: rw
  58 + real(dp) :: rh
  59 +
  60 + character(len=80),allocatable :: node1_list(:)
  61 + character(len=80),allocatable :: node2_list(:)
  62 +
  63 + real(dp) :: grid_dim
  64 + integer :: nxmin,nxmax,nymin,nymax
  65 + integer,allocatable :: grid(:,:)
  66 + real(dp),allocatable :: depth(:,:)
  67 +
  68 + real(dp) :: skin_depth
  69 + logical :: auto_grid_density
  70 +
  71 +END TYPE conductor_type
  72 +
  73 +integer,parameter :: type_cyl=1
  74 +integer,parameter :: type_rect=2
  75 +integer,parameter :: type_annulus=3
  76 +integer,parameter :: type_gnd=4
  77 +
  78 +integer,parameter :: mesh_type_layer=1
  79 +integer,parameter :: mesh_type_grid=2
  80 +
  81 +type(conductor_type),allocatable :: conductor_data(:)
  82 +
  83 +real(dp) :: fmin,fmax
  84 +real(dp) :: ndec
  85 +
  86 +real(dp) :: rh,rw
  87 +integer :: nhinc,nwinc
  88 +
  89 +real(dp) :: x,y,ymin,ymax,w,h,wx,hy
  90 +integer :: conductor,layer,layer_number,nc
  91 +
  92 +real(dp) :: angle
  93 +real(dp) :: lrc,lxc,lyc,lw,lh
  94 +real(dp) :: vx,vy
  95 +
  96 +real(dp) :: dout,din
  97 +
  98 +integer :: nxmin,nxmax,nymin,nymax,ix,iy
  99 +real(dp) :: dpt,apx,apy
  100 +
  101 +integer :: cx1,cx2
  102 +real(dp) :: cw,ch
  103 +logical :: in_conductor
  104 +
  105 +real(dp) :: required_dl,nsd
  106 +integer :: nfilaments
  107 +
  108 +character(LEN=6) :: conductor_string
  109 +character(LEN=6) :: layer_string
  110 +character(LEN=80) :: node_string
  111 +character(LEN=80) :: segment_string
  112 +character(LEN=80) :: loop_string
  113 +character(LEN=80) :: line_string
  114 +
  115 +character(LEN=12) :: x_string,y_string,z_string
  116 +
  117 +integer :: line
  118 +character(LEN=80) :: FH2_filename
  119 +character :: type_ch
  120 +
  121 +integer :: tot_n_segments,tot_n_filaments
  122 +integer :: gp_n_segments,gp_n_filaments
  123 +
  124 +real(dp),parameter :: pi=3.1415926535
  125 +
  126 +! START
  127 +
  128 +! READ THE PROBLEM SPECIFICATION
  129 +
  130 +line=1
  131 +write(*,*)'Enter the name of the FastHenry2 input file to write:'
  132 +read(*,'(A80)',ERR=9000)FH2_filename
  133 +
  134 +write(*,*)"Enter the number of conductors or 'ground_plane'"
  135 +line=line+1
  136 +read(*,'(A80)',ERR=9000)line_string
  137 +type_ch=line_string(1:1)
  138 +
  139 +if ( (type_ch.EQ.'g').OR.(type_ch.EQ.'G') ) then
  140 +
  141 + write(*,*)'Reading ground plane specification...'
  142 + ground_plane=.TRUE.
  143 +
  144 + write(*,*)'Enter the ground plane point 1 coordinates, x y z in metres'
  145 + line=line+1
  146 + read(*,*,ERR=9000)gp_x(1),gp_y(1),gp_z(1)
  147 + write(*,*)'Enter the ground plane point 2 coordinates, x y z in metres'
  148 + line=line+1
  149 + read(*,*,ERR=9000)gp_x(2),gp_y(2),gp_z(2)
  150 + write(*,*)'Enter the ground plane point 3 coordinates, x y z in metres'
  151 + line=line+1
  152 + read(*,*,ERR=9000)gp_x(3),gp_y(3),gp_z(3)
  153 +
  154 + write(*,*)'Enter the ground plane thickness in metres'
  155 + line=line+1
  156 + read(*,*,ERR=9000)gp_t
  157 +
  158 + write(*,*)'Enter the ground plane discretisation in p1-p2 and p2=p3 directions'
  159 + line=line+1
  160 + read(*,*,ERR=9000)gp_seg1,gp_seg2
  161 +
  162 + write(*,*)'Enter the ground conductivity in Siemens/metre'
  163 + line=line+1
  164 + read(*,*,ERR=9000)gp_sigma
  165 +
  166 + write(*,*)'Enter the ground plane discretisation in thickness, nhinc'
  167 + line=line+1
  168 + read(*,*,ERR=9000)gp_nhinc
  169 +
  170 + write(*,*)'Enter the ground plane discretisation in thickness ratio, rh'
  171 + line=line+1
  172 + read(*,*,ERR=9000)gp_rh
  173 +
  174 + write(*,*)'Enter the ground plane end 1 node coordinates, x y z in metres'
  175 + line=line+1
  176 + read(*,*,ERR=9000)gp_ex1,gp_ey1,gp_ez1
  177 + write(*,*)'Enter the ground plane end 2 node coordinates, x y z in metres'
  178 + line=line+1
  179 + read(*,*,ERR=9000)gp_ex2,gp_ey2,gp_ez2
  180 +
  181 + gp_node1='Ngp_e1'
  182 + gp_node2='Ngp_e2'
  183 +
  184 + gp_node1_external='Ngp_e1_ext'
  185 + gp_node2_external='Ngp_e2_ext'
  186 +
  187 + write(*,*)"Enter the number of conductors"
  188 + line=line+1
  189 + read(*,*,ERR=9000)n_conductors
  190 +
  191 +else
  192 +
  193 + write(*,*)'No ground plane'
  194 + ground_plane=.FALSE.
  195 + read(line_string,*,ERR=9000)n_conductors
  196 +
  197 +end if
  198 +
  199 +write(*,*)'Number of conductors (excluding ground plane)=',n_conductors
  200 +
  201 +ALLOCATE( conductor_data(n_conductors) )
  202 +
  203 +do conductor=1,n_conductors
  204 +
  205 + write(*,*)'Enter the conductor number'
  206 + line=line+1
  207 + read(*,*,ERR=9000)nc
  208 +
  209 + if (nc.NE.conductor) GOTO 9010
  210 +
  211 + write(*,*)'Enter the conductor type (cylindrical rectangular or annulus)'
  212 + line=line+1
  213 + read(*,'(A80)',ERR=9000)line_string
  214 + type_ch=line_string(1:1)
  215 +
  216 + conductor_data(conductor)%auto_grid_density=.FALSE.
  217 +
  218 + if ( (type_ch.EQ.'c').OR.(type_ch.EQ.'C') ) then
  219 + conductor_data(conductor)%type=type_cyl
  220 +
  221 +! work out the grid type
  222 +
  223 +INCLUDE "WRITE_FH2_IPFILE/get_grid_type.F90"
  224 +
  225 + write(*,*)Conductor,conductor,' mesh type=',conductor_data(conductor)%mesh_type
  226 +
  227 + write(*,*)'Enter the cylindrical conductor centre coordinates, xc yc in metres'
  228 + line=line+1
  229 + read(*,*,ERR=9000)conductor_data(conductor)%xc,conductor_data(conductor)%yc
  230 +
  231 + write(*,*)'Enter the cylindrical conductor radius, rc in metres'
  232 + line=line+1
  233 + read(*,*,ERR=9000)conductor_data(conductor)%rc
  234 +
  235 + write(*,*)'Enter the cylindrical conductor discretisation, dl in metres'
  236 + line=line+1
  237 + read(*,*,ERR=9000)conductor_data(conductor)%dl
  238 +
  239 + else if ( (type_ch.EQ.'r').OR.(type_ch.EQ.'R') ) then
  240 + conductor_data(conductor)%type=type_rect
  241 +
  242 + write(*,*)'Enter the rectangular conductor centre coordinates, xc yc in metres'
  243 + line=line+1
  244 + read(*,*,ERR=9000)conductor_data(conductor)%xc,conductor_data(conductor)%yc
  245 +
  246 + write(*,*)'Enter the rectangular conductor width (x dimension) height (y dimension) in metres'
  247 + line=line+1
  248 + read(*,*,ERR=9000)conductor_data(conductor)%width,conductor_data(conductor)%height
  249 +
  250 + conductor_data(conductor)%n_layers2=1
  251 + conductor_data(conductor)%tot_n_layers=1
  252 +
  253 + else if ( (type_ch.EQ.'a').OR.(type_ch.EQ.'A') ) then
  254 + conductor_data(conductor)%type=type_annulus
  255 +
  256 +INCLUDE "WRITE_FH2_IPFILE/get_grid_type.F90"
  257 +
  258 + write(*,*)Conductor,conductor,' mesh type=',conductor_data(conductor)%mesh_type
  259 +
  260 + write(*,*)'Enter the cylindrical conductor centre coordinates, xc yc in metres'
  261 + line=line+1
  262 + read(*,*,ERR=9000)conductor_data(conductor)%xc,conductor_data(conductor)%yc
  263 +
  264 + write(*,*)'Enter the cylindrical inner conductor radius, rci in metres'
  265 + line=line+1
  266 + read(*,*,ERR=9000)conductor_data(conductor)%rci
  267 +
  268 + write(*,*)'Enter the cylindrical outer conductor radius, rco in metres'
  269 + line=line+1
  270 + read(*,*,ERR=9000)conductor_data(conductor)%rco
  271 +
  272 + write(*,*)'Enter the cylindrical conductor discretisation, dl in metres'
  273 + line=line+1
  274 + read(*,*,ERR=9000)conductor_data(conductor)%dl
  275 +
  276 + else
  277 + GOTO 9020
  278 + end if ! Conductor type
  279 +
  280 + write(*,*)'Enter the conductor conductivity, sigma in Siemens/metre'
  281 + line=line+1
  282 + read(*,*,ERR=9000)conductor_data(conductor)%sigma
  283 +
  284 + write(*,*)'Enter the conductor discretisations, nwinc nhinc'
  285 + line=line+1
  286 + read(*,*,ERR=9000)conductor_data(conductor)%nwinc,conductor_data(conductor)%nhinc
  287 +
  288 + write(*,*)'Enter the conductor discretisation ratios, rw rh'
  289 + line=line+1
  290 + read(*,*,ERR=9000)conductor_data(conductor)%rw,conductor_data(conductor)%rh
  291 +
  292 + if (conductor_data(conductor)%auto_grid_density) then ! uniform grid in segments
  293 + conductor_data(conductor)%rw=1.0
  294 + conductor_data(conductor)%rh=1.0
  295 + end if
  296 +
  297 +end do ! read next conductor
  298 +
  299 +! Read the frequency range data
  300 +
  301 +write(*,*)'Enter the minimum frequency, fmin (Hz)'
  302 +line=line+1
  303 +read(*,*,ERR=9000)fmin
  304 +
  305 +write(*,*)'Enter the maximum frequency, fmax (Hz)'
  306 +line=line+1
  307 +read(*,*,ERR=9000)fmax
  308 +
  309 +write(*,*)'Enter the number of frequency samples per decade, ndec'
  310 +line=line+1
  311 +read(*,*,ERR=9000)ndec
  312 +
  313 +! END OF PROBLEM SPECIFICATION
  314 +
  315 +open(unit=20,file=trim(FH2_filename))
  316 +
  317 +open(unit=10,file='cross_section.dat')
  318 +open(unit=12,file='grid.dat')
  319 +
  320 +! write header
  321 +write(20,'(A)')'* conductors in free space'
  322 +write(20,'(A)')'*'
  323 +write(20,'(A)')'.units m'
  324 +write(20,'(A)')'*'
  325 +
  326 +! WORK OUT THE SKIN DEPTH IN EACH CONDUCTOR
  327 +
  328 +if (ground_plane) then
  329 + gp_skin_depth=sqrt(1.0/(pi*fmax*4.0*pi*1e-7*gp_sigma))
  330 + write(*,*)'Minimum ground plane skin depth =',gp_skin_depth
  331 +end if
  332 +
  333 +do conductor=1,n_conductors
  334 +
  335 + conductor_data(conductor)%skin_depth=sqrt(1.0/(pi*fmax*4.0*pi*1e-7*conductor_data(conductor)%sigma))
  336 + write(*,*)'Conductor',conductor,' Minimum skin depth =',conductor_data(conductor)%skin_depth
  337 +
  338 +end do ! next conductor
  339 +
  340 +! ALLOCATE GRIDS IN CONDUCTORS IF REQUIRED...
  341 +
  342 +do conductor=1,n_conductors
  343 +
  344 + if (conductor_data(conductor)%type.EQ.type_cyl) then
  345 +
  346 + if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then
  347 +
  348 + conductor_data(conductor)%n_layers2=NINT(conductor_data(conductor)%rc/conductor_data(conductor)%dl)
  349 + conductor_data(conductor)%tot_n_layers=2*conductor_data(conductor)%n_layers2
  350 +
  351 + else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
  352 +
  353 +! allocate grid for the circular geometry
  354 + conductor_data(conductor)%grid_dim=conductor_data(conductor)%rc
  355 +
  356 +INCLUDE "WRITE_FH2_IPFILE/create_grid.F90"
  357 +
  358 +! Loop over the grid and set segments within the conductor
  359 +
  360 + conductor_data(conductor)%tot_n_layers=0
  361 +
  362 + do ix=nxmin,nxmax
  363 + do iy=nymin,nymax
  364 + dpt=conductor_data(conductor)%dl*sqrt(real(ix)**2+real(iy)**2)
  365 + if ( dpt.LE.conductor_data(conductor)%rc ) then
  366 + conductor_data(conductor)%grid(ix,iy)=1
  367 + conductor_data(conductor)%depth(ix,iy)=conductor_data(conductor)%rc-dpt
  368 + conductor_data(conductor)%tot_n_layers=conductor_data(conductor)%tot_n_layers+1
  369 + end if
  370 + end do
  371 + end do
  372 +
  373 + conductor_data(conductor)%n_layers2=0
  374 +
  375 + else
  376 + write(*,*)'Unknown grid type'
  377 + STOP 1
  378 + end if
  379 +
  380 + else if (conductor_data(conductor)%type.EQ.type_annulus) then
  381 +
  382 +
  383 + if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then
  384 +
  385 + conductor_data(conductor)%n_layers2=0
  386 + conductor_data(conductor)%tot_n_layers=20 ! number of segments in the loop
  387 +
  388 + else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
  389 +
  390 +! allocate grid for the annular geometry
  391 +
  392 + conductor_data(conductor)%grid_dim=conductor_data(conductor)%rco
  393 +
  394 +INCLUDE "WRITE_FH2_IPFILE/create_grid.F90"
  395 +
  396 +! Loop over the grid and set segments within the annular conductor
  397 +
  398 + conductor_data(conductor)%tot_n_layers=0
  399 +
  400 + do ix=nxmin,nxmax
  401 + do iy=nymin,nymax
  402 + dpt=conductor_data(conductor)%dl*sqrt(real(ix)**2+real(iy)**2)
  403 + if ( (dpt.GE.conductor_data(conductor)%rci).AND.(dpt.LE.conductor_data(conductor)%rco) ) then
  404 + conductor_data(conductor)%grid(ix,iy)=1
  405 + dout=conductor_data(conductor)%rco-dpt
  406 + din=dpt-conductor_data(conductor)%rci
  407 + conductor_data(conductor)%depth(ix,iy)=min(dout,din)
  408 + conductor_data(conductor)%tot_n_layers=conductor_data(conductor)%tot_n_layers+1
  409 + end if
  410 + end do
  411 + end do
  412 +
  413 + conductor_data(conductor)%n_layers2=0
  414 +
  415 + else
  416 +
  417 + write(*,*)'We can only use the grid mesh type for an annulus'
  418 + STOP 1
  419 +
  420 + end if ! mesh type grid
  421 +
  422 + end if ! annular
  423 +
  424 +end do ! next conductor
  425 +
  426 +! WRITE GROUND PLANE INFORMATION IF REQUIRED
  427 +
  428 +gp_n_segments=0
  429 +gp_n_filaments=0
  430 +
  431 +if (ground_plane) then
  432 +
  433 + write(20,'(A)')'*'
  434 + write(20,'(A)')'* Ground plane'
  435 + write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'ground_plane x1=',gp_x(1),' y1=',gp_y(1),' z1=',gp_z(1)
  436 + write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'+ x2=',gp_x(2),' y2=',gp_y(2),' z2=',gp_z(2)
  437 + write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'+ x3=',gp_x(3),' y3=',gp_y(3),' z3=',gp_z(3)
  438 + write(20,'(A,ES12.4)')'+ thick=',gp_t
  439 + write(20,'(A,ES12.4)')'+ sigma=',gp_sigma
  440 + write(20,'(A,I4)')'+ nhinc=',gp_nhinc
  441 + write(20,'(A,ES12.4)')'+ rh=',gp_rh
  442 + write(20,'(A,I4,A,I4)')'+ seg1=',gp_seg1,' seg2=',gp_seg2
  443 +
  444 + gp_n_segments =(gp_seg1+1)*gp_seg2+(gp_seg2+1)*gp_seg1
  445 + gp_n_filaments=gp_nhinc*gp_n_segments
  446 +
  447 + write(x_string,'(ES12.4)')gp_ex1
  448 + write(y_string,'(ES12.4)')gp_ey1
  449 + write(z_string,'(ES12.4)')gp_ez1
  450 + write(20,'(9A)')'+ ',trim(gp_node1),' (',trim(adjustl(x_string)), &
  451 + ',',trim(adjustl(y_string)), &
  452 + ',',trim(adjustl(z_string)),')'
  453 +
  454 + write(x_string,'(ES12.4)')gp_ex2
  455 + write(y_string,'(ES12.4)')gp_ey2
  456 + write(z_string,'(ES12.4)')gp_ez2
  457 + write(20,'(9A)')'+ ',trim(gp_node2),' (',trim(adjustl(x_string)), &
  458 + ',',trim(adjustl(y_string)), &
  459 + ',',trim(adjustl(z_string)),')'
  460 +
  461 +end if
  462 +
  463 +! LOOP OVER THE CONDUCTORS AND DEFINE THEN WRITE THE NODES FOR EACH LAYER ON THE CONDUCTOR
  464 +
  465 +write(20,'(A)')'*'
  466 +write(20,'(A)')'* Specify the conductor nodes'
  467 +do conductor=1,n_conductors
  468 +
  469 + write(20,'(A)')'*'
  470 + write(20,'(A,I4)')'* Conductor',conductor
  471 +
  472 + write(conductor_string,'(I4)')conductor
  473 +
  474 + ALLOCATE( conductor_data(conductor)%x(1:conductor_data(conductor)%tot_n_layers) )
  475 + ALLOCATE( conductor_data(conductor)%y(1:conductor_data(conductor)%tot_n_layers) )
  476 + ALLOCATE( conductor_data(conductor)%w(1:conductor_data(conductor)%tot_n_layers) )
  477 + ALLOCATE( conductor_data(conductor)%h(1:conductor_data(conductor)%tot_n_layers) )
  478 + ALLOCATE( conductor_data(conductor)%d(1:conductor_data(conductor)%tot_n_layers) )
  479 + ALLOCATE( conductor_data(conductor)%anwinc(1:conductor_data(conductor)%tot_n_layers) )
  480 + ALLOCATE( conductor_data(conductor)%anhinc(1:conductor_data(conductor)%tot_n_layers) )
  481 +
  482 + ALLOCATE( conductor_data(conductor)%wx(1:conductor_data(conductor)%tot_n_layers) )
  483 + ALLOCATE( conductor_data(conductor)%wy(1:conductor_data(conductor)%tot_n_layers) )
  484 + ALLOCATE( conductor_data(conductor)%wz(1:conductor_data(conductor)%tot_n_layers) )
  485 +
  486 + conductor_data(conductor)%wx(1:conductor_data(conductor)%tot_n_layers)=1.0
  487 + conductor_data(conductor)%wy(1:conductor_data(conductor)%tot_n_layers)=0.0
  488 + conductor_data(conductor)%wz(1:conductor_data(conductor)%tot_n_layers)=0.0
  489 +
  490 + ALLOCATE( conductor_data(conductor)%node1_list(1:conductor_data(conductor)%tot_n_layers) )
  491 + ALLOCATE( conductor_data(conductor)%node2_list(1:conductor_data(conductor)%tot_n_layers) )
  492 +
  493 + if (conductor_data(conductor)%type.EQ.type_cyl) then
  494 +
  495 + if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then
  496 +
  497 + do layer=-conductor_data(conductor)%n_layers2+1,conductor_data(conductor)%n_layers2
  498 +
  499 + layer_number=conductor_data(conductor)%n_layers2+layer
  500 +
  501 + ymin=conductor_data(conductor)%dl*real(layer)
  502 + ymax=conductor_data(conductor)%dl*real(layer-1)
  503 + y=(ymin+ymax)/2.0
  504 + x=sqrt(conductor_data(conductor)%rc**2-y**2)
  505 +
  506 + conductor_data(conductor)%x(layer_number)=conductor_data(conductor)%xc
  507 + conductor_data(conductor)%y(layer_number)=conductor_data(conductor)%yc+y
  508 + conductor_data(conductor)%w(layer_number)=2.0*x
  509 + conductor_data(conductor)%h(layer_number)=conductor_data(conductor)%dl
  510 + conductor_data(conductor)%d(layer_number)=0.0
  511 + conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
  512 + conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
  513 +
  514 + end do ! next layer
  515 +
  516 + else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
  517 +
  518 +! Loop over the grid and set segments within the circular conductor
  519 +
  520 +INCLUDE "WRITE_FH2_IPFILE/set_segments_from_grid.F90"
  521 +
  522 + end if ! mesh_type_grid
  523 +
  524 + else if (conductor_data(conductor)%type.EQ.type_rect) then
  525 +
  526 + layer_number=1
  527 +
  528 + conductor_data(conductor)%x(layer_number)=conductor_data(conductor)%xc
  529 + conductor_data(conductor)%y(layer_number)=conductor_data(conductor)%yc
  530 + conductor_data(conductor)%w(layer_number)=conductor_data(conductor)%width
  531 + conductor_data(conductor)%h(layer_number)=conductor_data(conductor)%height
  532 + conductor_data(conductor)%d(layer_number)=0.0
  533 + conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
  534 + conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
  535 +
  536 + else if (conductor_data(conductor)%type.EQ.type_annulus) then
  537 +
  538 + if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then
  539 +
  540 + do layer_number=1,conductor_data(conductor)%tot_n_layers
  541 +
  542 + angle=real(layer_number)*2.0*pi/real(conductor_data(conductor)%tot_n_layers)
  543 + conductor_data(conductor)%wx(layer_number)=-sin(angle)
  544 + conductor_data(conductor)%wy(layer_number)=cos(angle)
  545 + conductor_data(conductor)%wz(layer_number)=0.0
  546 +
  547 + lrc=(conductor_data(conductor)%rco+conductor_data(conductor)%rci)/2.0
  548 + lh=(conductor_data(conductor)%rco-conductor_data(conductor)%rci)/2.0
  549 + lw=lrc*2.0*pi/real(conductor_data(conductor)%tot_n_layers)
  550 + lxc=lrc*cos(angle)
  551 + lyc=lrc*sin(angle)
  552 +
  553 + conductor_data(conductor)%x(layer_number)=conductor_data(conductor)%xc+lxc
  554 + conductor_data(conductor)%y(layer_number)=conductor_data(conductor)%yc+lyc
  555 + conductor_data(conductor)%w(layer_number)=lw
  556 + conductor_data(conductor)%h(layer_number)=lh
  557 + conductor_data(conductor)%d(layer_number)=0.0
  558 + conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
  559 + conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
  560 +
  561 + end do ! next layer
  562 +
  563 + else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
  564 +
  565 +! Loop over the grid and set segments within the circular conductor
  566 +
  567 +INCLUDE "WRITE_FH2_IPFILE/set_segments_from_grid.F90"
  568 +
  569 + end if ! mesh_type_grid
  570 +
  571 + else
  572 + write(*,*)'Cant deal with this conductor type yet:',conductor_data(conductor)%type
  573 + STOP 1
  574 + end if
  575 +
  576 +! WRITE_THE NODES TO THE INPUT FILE AND SAVE IN THE NODE LIST FOR THIS CONDUCTOR
  577 +
  578 + do layer_number=1,conductor_data(conductor)%tot_n_layers
  579 +
  580 + write(layer_string,'(I4)')layer_number
  581 +
  582 + node_string='n_c'//trim(adjustl(conductor_string))//'_e1_l'//trim(adjustl(layer_string))
  583 + write(20,'(A,A,ES12.4,A,ES12.4,A)')trim(node_string), &
  584 + ' x=',conductor_data(conductor)%x(layer_number), &
  585 + ' y=',conductor_data(conductor)%y(layer_number),' z=0.0'
  586 + conductor_data(conductor)%node1_list(layer_number)=node_string
  587 +
  588 + node_string='n_c'//trim(adjustl(conductor_string))//'_e2_l'//trim(adjustl(layer_string))
  589 + write(20,'(A,A,ES12.4,A,ES12.4,A)')trim(node_string), &
  590 + ' x=',conductor_data(conductor)%x(layer_number), &
  591 + ' y=',conductor_data(conductor)%y(layer_number),' z=1.0'
  592 + conductor_data(conductor)%node2_list(layer_number)=node_string
  593 +
  594 + wx=conductor_data(conductor)%w(layer_number)/2.0
  595 + hy=conductor_data(conductor)%h(layer_number)/2.0
  596 + rw=conductor_data(conductor)%rw
  597 + rh=conductor_data(conductor)%rh
  598 + nwinc=conductor_data(conductor)%anwinc(layer_number)
  599 + nhinc=conductor_data(conductor)%anhinc(layer_number)
  600 +
  601 + vx=conductor_data(conductor)%wx(layer_number)
  602 + vy=conductor_data(conductor)%wy(layer_number)
  603 +
  604 + CALL plot_layer(conductor_data(conductor)%x(layer_number),conductor_data(conductor)%y(layer_number), &
  605 + wx,hy,vx,vy,10)
  606 +
  607 + CALL plot_grid(conductor_data(conductor)%x(layer_number),conductor_data(conductor)%y(layer_number), &
  608 + wx,hy,vx,vy,rw,rh,nwinc,nhinc,12)
  609 +
  610 + end do ! next layer
  611 +
  612 +end do ! next conductor
  613 +
  614 +! LOOP OVER THE CONDUCTORS AND WRITE THE WIRE SEGMENTS FOR EACH LAYER ON THE CONDUCTOR
  615 +
  616 +tot_n_segments=0
  617 +tot_n_filaments=0
  618 +
  619 +write(20,'(A)')'*'
  620 +write(20,'(A)')'* conductor segments'
  621 +do conductor=1,n_conductors
  622 +
  623 + write(20,'(A)')'*'
  624 + write(20,'(A,I4)')'* Conductor',conductor
  625 +
  626 + write(conductor_string,'(I4)')conductor
  627 +
  628 + do layer_number=1,conductor_data(conductor)%tot_n_layers
  629 +
  630 + write(layer_string,'(I4)')layer_number
  631 +
  632 + segment_string='E_c'//trim(adjustl(conductor_string))//'_l'//trim(adjustl(layer_string))
  633 +
  634 + write(20,'(A,A,A,A,A,A,ES12.4,A,ES12.4,A,ES12.4,A,ES12.4,A,ES12.4,A,ES12.4,A,I4,A,I4,A,ES12.4,A,ES12.4)') &
  635 + trim(segment_string),' ', &
  636 + trim(conductor_data(conductor)%node1_list(layer_number)),' ', &
  637 + trim(conductor_data(conductor)%node2_list(layer_number)), &
  638 + ' h=',conductor_data(conductor)%h(layer_number), &
  639 + ' w=',conductor_data(conductor)%w(layer_number), &
  640 + ' sigma=',conductor_data(conductor)%sigma, &
  641 + ' wx=',conductor_data(conductor)%wx(layer_number), &
  642 + ' wy=',conductor_data(conductor)%wy(layer_number), &
  643 + ' wz=',conductor_data(conductor)%wz(layer_number), &
  644 + ' nhinc=',conductor_data(conductor)%anhinc(layer_number), &
  645 + ' nwinc=',conductor_data(conductor)%anwinc(layer_number), &
  646 + ' rh=',conductor_data(conductor)%rh, &
  647 + ' rw=',conductor_data(conductor)%rw
  648 +
  649 + tot_n_segments=tot_n_segments+1
  650 + tot_n_filaments=tot_n_filaments+conductor_data(conductor)%nhinc*conductor_data(conductor)%nwinc
  651 +
  652 + end do
  653 +
  654 +end do
  655 +
  656 +! EQUIVALENCE CONDUCTOR NODES AT NEAR END
  657 +
  658 +write(20,'(A)')'*'
  659 +write(20,'(A)')'* Near end equivalent nodes on conductors'
  660 +do conductor=1,n_conductors
  661 +
  662 + if (conductor_data(conductor)%tot_n_layers.GT.1) then
  663 +
  664 + write(20,'(A)')'*'
  665 + write(20,'(A,I4)')'* Conductor',conductor
  666 +
  667 + write(20,'(A)')'.equiv'
  668 + do layer_number=1,conductor_data(conductor)%tot_n_layers
  669 + write(20,'(A,A)')'+ ',trim(conductor_data(conductor)%node1_list(layer_number))
  670 + end do
  671 +
  672 + end if
  673 +
  674 +end do
  675 +
  676 +! EQUIVALENCE CONDUCTOR NODES AT FAR END
  677 +
  678 +write(20,'(A)')'*'
  679 +write(20,'(A)')'* Far end equivalent nodes on conductors'
  680 +do conductor=1,n_conductors
  681 +
  682 + if (conductor_data(conductor)%tot_n_layers.GT.1) then
  683 +
  684 + write(20,'(A)')'*'
  685 + write(20,'(A,I4)')'* Conductor',conductor
  686 +
  687 + write(20,'(A)')'.equiv'
  688 + do layer_number=1,conductor_data(conductor)%tot_n_layers
  689 + write(20,'(A,A)')'+ ',trim(conductor_data(conductor)%node2_list(layer_number))
  690 + end do
  691 +
  692 + end if
  693 +
  694 +end do
  695 +
  696 +! DEFINE LOOPS
  697 +
  698 +if (ground_plane) then
  699 +
  700 + write(20,'(A)')'*'
  701 + write(20,'(A)')'* Make loops from ground plane to all other conductors in turn'
  702 +
  703 + do conductor=1,n_conductors
  704 +
  705 + write(20,'(A)')'*'
  706 + write(20,'(A,I4)')'* Ground plane to conductor',conductor
  707 +
  708 + write(conductor_string,'(I4)')conductor
  709 + loop_string='loop_'//trim(adjustl(conductor_string))
  710 +
  711 + write(20,'(A,A,A,A,A,A)')'.external ',trim(gp_node1), &
  712 + ' ',trim(conductor_data(conductor)%node1_list(1)), &
  713 + ' ',trim(loop_string)
  714 + end do
  715 +
  716 +! JOIN ALL FAR END CONDUCTORS
  717 +
  718 + write(20,'(A)')'*'
  719 + write(20,'(A)')'* Join all Far end conductors'
  720 +
  721 + write(20,'(A)',ADVANCE='NO')'.equiv'
  722 + write(20,'(A,A)',ADVANCE='NO')' ',trim(gp_node2)
  723 + do conductor=1,n_conductors
  724 +
  725 + layer_number=1
  726 + write(20,'(A,A)',ADVANCE='NO')' ',trim(conductor_data(conductor)%node2_list(layer_number))
  727 +
  728 + end do
  729 +
  730 + write(20,*)
  731 +
  732 +else
  733 +! No ground plane
  734 +
  735 + write(20,'(A)')'*'
  736 + write(20,'(A)')'* Make loops from conductor 1 to all other conductors in turn'
  737 +
  738 + do conductor=2,n_conductors
  739 +
  740 + write(20,'(A)')'*'
  741 + write(20,'(A,I4)')'* Conductor 1 to conductor',conductor
  742 +
  743 + write(conductor_string,'(I4)')conductor-1
  744 + loop_string='loop_'//trim(adjustl(conductor_string))
  745 +
  746 + write(20,'(A,A,A,A,A,A)')'.external ',trim(conductor_data(1)%node1_list(1)), &
  747 + ' ',trim(conductor_data(conductor)%node1_list(1)), &
  748 + ' ',trim(loop_string)
  749 + end do
  750 +
  751 +! JOIN ALL FAR END CONDUCTORS
  752 +
  753 + write(20,'(A)')'*'
  754 + write(20,'(A)')'* Join all Far end conductors'
  755 +
  756 + write(20,'(A)',ADVANCE='NO')'.equiv'
  757 + do conductor=1,n_conductors
  758 +
  759 + layer_number=1
  760 + write(20,'(A,A)',ADVANCE='NO')' ',trim(conductor_data(conductor)%node2_list(layer_number))
  761 +
  762 + end do
  763 +
  764 + write(20,*)
  765 +
  766 +end if ! ground plane
  767 +
  768 +! WRITE THE FREQUENCY RANGE AND END
  769 +
  770 +write(20,'(A)')'*'
  771 +write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'.freq fmin=',fmin,' fmax=',fmax,' ndec=',ndec
  772 +write(20,'(A)')'*'
  773 +write(20,'(A)')'.end'
  774 +
  775 +! CLOSE FILES
  776 +
  777 +close(unit=10)
  778 +close(unit=12)
  779 +close(unit=20)
  780 +
  781 +! DEALLOCATE MEMORY
  782 +
  783 +do conductor=1,n_conductors
  784 +
  785 + if (ALLOCATED( conductor_data(conductor)%x )) DEALLOCATE( conductor_data(conductor)%x )
  786 + if (ALLOCATED( conductor_data(conductor)%y )) DEALLOCATE( conductor_data(conductor)%y )
  787 + if (ALLOCATED( conductor_data(conductor)%w )) DEALLOCATE( conductor_data(conductor)%w )
  788 + if (ALLOCATED( conductor_data(conductor)%h )) DEALLOCATE( conductor_data(conductor)%h )
  789 +
  790 + if (ALLOCATED( conductor_data(conductor)%wx )) DEALLOCATE( conductor_data(conductor)%wx )
  791 + if (ALLOCATED( conductor_data(conductor)%wy )) DEALLOCATE( conductor_data(conductor)%wy )
  792 + if (ALLOCATED( conductor_data(conductor)%wz )) DEALLOCATE( conductor_data(conductor)%wz )
  793 +
  794 + if (ALLOCATED( conductor_data(conductor)%d )) DEALLOCATE( conductor_data(conductor)%d )
  795 + if (ALLOCATED( conductor_data(conductor)%anwinc )) DEALLOCATE( conductor_data(conductor)%anwinc )
  796 + if (ALLOCATED( conductor_data(conductor)%anhinc )) DEALLOCATE( conductor_data(conductor)%anhinc )
  797 +
  798 + if (ALLOCATED( conductor_data(conductor)%node1_list )) DEALLOCATE( conductor_data(conductor)%node1_list )
  799 + if (ALLOCATED( conductor_data(conductor)%node2_list )) DEALLOCATE( conductor_data(conductor)%node2_list )
  800 +
  801 + if (ALLOCATED( conductor_data(conductor)%grid )) DEALLOCATE( conductor_data(conductor)%grid )
  802 + if (ALLOCATED( conductor_data(conductor)%depth )) DEALLOCATE( conductor_data(conductor)%depth )
  803 +
  804 +end do
  805 +
  806 +if ( ALLOCATED(conductor_data) ) DEALLOCATE( conductor_data )
  807 +
  808 +write(*,*)
  809 +write(*,*)'Total number of conductor segments =',tot_n_segments
  810 +write(*,*)'Total number of conductor filaments=',tot_n_filaments
  811 +write(*,*)
  812 +
  813 +if (ground_plane) then
  814 + write(*,*)'Total number of ground plane segments =',gp_n_segments
  815 + write(*,*)'Total number of ground plane filaments=',gp_n_filaments
  816 + write(*,*)
  817 +end if
  818 +
  819 +write(*,*)'Total number of segments =',gp_n_segments+tot_n_segments
  820 +write(*,*)'Total number of filaments=',gp_n_filaments+tot_n_filaments
  821 +write(*,*)
  822 +
  823 +STOP 0
  824 +
  825 +9000 write(*,*)'ERROR reading the Cross Section Specification data, line',line
  826 +STOP 1
  827 +
  828 +9010 write(*,*)'ERROR conductors should be numbered in order, line',line
  829 +STOP 1
  830 +
  831 +9020 write(*,*)'ERROR Unknown conductor type:',type_ch,', line',line
  832 +STOP 1
  833 +
  834 +
  835 +END PROGRAM write_FH_input_file
  836 +!
  837 +! ___________________________________________________
  838 +!
  839 +!
  840 +SUBROUTINE plot_layer(xc,yc,wx,wy,vxx,vxy,file_unit)
  841 +
  842 +USE type_specifications
  843 +
  844 +IMPLICIT NONE
  845 +
  846 +! variables passed to subroutine
  847 +
  848 +real(dp) :: xc,yc,wx,wy,vxx,vxy
  849 +integer :: file_unit
  850 +
  851 +! local variables
  852 +
  853 +real(dp) :: rotx,roty
  854 +
  855 +! START
  856 +
  857 + CALL rotate(-wx,+wy,vxx,vxy,rotx,roty)
  858 + write(file_unit,*)xc+rotx,yc+roty
  859 + CALL rotate(+wx,+wy,vxx,vxy,rotx,roty)
  860 + write(file_unit,*)xc+rotx,yc+roty
  861 + CALL rotate(+wx,-wy,vxx,vxy,rotx,roty)
  862 + write(file_unit,*)xc+rotx,yc+roty
  863 + CALL rotate(-wx,-wy,vxx,vxy,rotx,roty)
  864 + write(file_unit,*)xc+rotx,yc+roty
  865 + CALL rotate(-wx,+wy,vxx,vxy,rotx,roty)
  866 + write(file_unit,*)xc+rotx,yc+roty
  867 + write(file_unit,*)
  868 +
  869 +RETURN
  870 +
  871 +END SUBROUTINE plot_layer
  872 +!
  873 +! _______________________________________________________
  874 +!
  875 +!
  876 +SUBROUTINE plot_grid(xc,yc,wx,wy,vxx,vxy,rx,ry,nx,ny,file_unit)
  877 +
  878 +USE type_specifications
  879 +
  880 +IMPLICIT NONE
  881 +
  882 +! variables passed to subroutine
  883 +
  884 +real(dp) :: xc,yc,wx,wy,vxx,vxy,rx,ry
  885 +integer :: nx,ny,file_unit
  886 +
  887 +! local variables
  888 +
  889 +real(dp) :: dx,dy,den,ox,oy
  890 +integer :: nl2
  891 +integer :: i
  892 +logical :: odd
  893 +real(dp) :: rotx,roty
  894 +
  895 +! START
  896 +
  897 +! lines in the x direction
  898 +if ( mod(nx,2).EQ.0 ) then
  899 + odd=.FALSE.
  900 +else
  901 + odd=.TRUE.
  902 +end if
  903 +
  904 +if (odd) then
  905 + nl2=(nx-1)/2
  906 +else
  907 + nl2=nx/2
  908 +end if
  909 +
  910 +den=0.0
  911 +do i=1,nl2
  912 + den=den+2.0*rx**(i-1)
  913 +end do
  914 +if (odd) den=den+rx**(nl2)
  915 +
  916 +dx=wx*2.0/den
  917 +
  918 +!write(*,*)'xc=',xc
  919 +!write(*,*)'nx=',nx
  920 +!write(*,*)'odd=',odd
  921 +!write(*,*)'nl2=',nl2
  922 +!write(*,*)'wx=',wx
  923 +!write(*,*)'den=',den
  924 +!write(*,*)'dx=',dx
  925 +
  926 +ox=wx
  927 +do i=1,nl2
  928 + ox=ox-dx*(rx**(i-1))
  929 +! write(*,*)'i=',i,' ox=',ox
  930 + CALL rotate(-ox,+wy,vxx,vxy,rotx,roty)
  931 + write(file_unit,*)xc+rotx,yc+roty
  932 + CALL rotate(-ox,-wy,vxx,vxy,rotx,roty)
  933 + write(file_unit,*)xc+rotx,yc+roty
  934 + write(file_unit,*)
  935 + CALL rotate(+ox,+wy,vxx,vxy,rotx,roty)
  936 + write(file_unit,*)xc+rotx,yc+roty
  937 + CALL rotate(+ox,-wy,vxx,vxy,rotx,roty)
  938 + write(file_unit,*)xc+rotx,yc+roty
  939 + write(file_unit,*)
  940 +end do
  941 +
  942 +if (.NOT.odd) then ! write centre line
  943 + CALL rotate(0d0,+wy,vxx,vxy,rotx,roty)
  944 + write(file_unit,*)xc+rotx,yc+roty
  945 + CALL rotate(0d0,-wy,vxx,vxy,rotx,roty)
  946 + write(file_unit,*)xc+rotx,yc+roty
  947 + write(file_unit,*)
  948 +end if
  949 +
  950 +! lines in the y direction
  951 +if ( mod(ny,2).EQ.0 ) then
  952 + odd=.FALSE.
  953 +else
  954 + odd=.TRUE.
  955 +end if
  956 +
  957 +if (odd) then
  958 + nl2=(ny-1)/2
  959 +else
  960 + nl2=ny/2
  961 +end if
  962 +
  963 +den=0.0
  964 +do i=1,nl2
  965 + den=den+2.0*ry**(i-1)
  966 +end do
  967 +if (odd) den=den+ry**(nl2)
  968 +
  969 +dy=wy*2.0/den
  970 +
  971 +oy=wy
  972 +do i=1,nl2
  973 + oy=oy-dy*(ry**(i-1))
  974 + write(file_unit,*)xc+wx,yc-oy
  975 + write(file_unit,*)xc-wx,yc-oy
  976 + write(file_unit,*)
  977 + write(file_unit,*)xc+wx,yc+oy
  978 + write(file_unit,*)xc-wx,yc+oy
  979 + write(file_unit,*)
  980 +end do
  981 +
  982 +if (.NOT.odd) then ! write centre line
  983 + write(file_unit,*)xc+wx,yc
  984 + write(file_unit,*)xc-wx,yc
  985 + write(file_unit,*)
  986 +end if
  987 +
  988 +RETURN
  989 +
  990 +END SUBROUTINE plot_grid
  991 +!
  992 +! _______________________________________________________
  993 +!
  994 +!
  995 +SUBROUTINE rotate(x,y,vxx,vxy,rx,ry)
  996 +
  997 +USE type_specifications
  998 +
  999 +IMPLICIT NONE
  1000 +
  1001 +! variables passed to subroutine
  1002 +
  1003 +real(dp) :: x,y,vxx,vxy,rx,ry
  1004 +
  1005 +! local variables
  1006 +
  1007 +real(dp) :: vyx,vyy
  1008 +
  1009 +! START
  1010 +
  1011 +vyx=-vxy
  1012 +vyy=vxx
  1013 +
  1014 +rx=x*vxx+y*vyx
  1015 +ry=x*vxy+y*vyy
  1016 +
  1017 +RETURN
  1018 +
  1019 +END SUBROUTINE rotate
  1020 +
... ...