PROGRAM write_FH_input_file

USE type_specifications

IMPLICIT NONE

integer :: n_conductors

logical :: ground_plane

integer :: mesh_type

real(dp) :: gp_x(3),gp_y(3),gp_z(3)
  
real(dp)    :: gp_t,gp_sigma,gp_rh,gp_ex1,gp_ey1,gp_ez1,gp_ex2,gp_ey2,gp_ez2
real(dp)    :: gp_skin_depth
integer :: gp_nhinc,gp_seg1,gp_seg2

character(len=80),allocatable    :: gp_node1
character(len=80),allocatable    :: gp_node2

character(len=80),allocatable    :: gp_node1_external
character(len=80),allocatable    :: gp_node2_external

TYPE::conductor_type

  integer :: type
  integer :: mesh_type
  integer :: mesh_to_layer_type

  real(dp)    :: rc
  real(dp)    :: rci
  real(dp)    :: rco
  real(dp)    :: xc
  real(dp)    :: yc
  real(dp)    :: width
  real(dp)    :: height
  integer :: n_layers2
  integer :: tot_n_layers
  
  real(dp),allocatable    :: x(:)
  real(dp),allocatable    :: y(:)
  real(dp),allocatable    :: w(:)
  real(dp),allocatable    :: h(:)
  real(dp),allocatable    :: d(:)
  integer,allocatable :: anwinc(:)
  integer,allocatable :: anhinc(:)
  
  real(dp),allocatable    :: wx(:)
  real(dp),allocatable    :: wy(:)
  real(dp),allocatable    :: wz(:)
  
  real(dp)    :: sigma
  real(dp)    :: dl
  integer :: nwinc 
  integer :: nhinc 
  real(dp)    :: rw
  real(dp)    :: rh

  character(len=80),allocatable    :: node1_list(:)
  character(len=80),allocatable    :: node2_list(:)
  
  real(dp)    :: grid_dim
  integer :: nxmin,nxmax,nymin,nymax
  integer,allocatable :: grid(:,:)
  real(dp),allocatable    :: depth(:,:)
  
  real(dp)    :: skin_depth
  logical :: auto_grid_density

END TYPE conductor_type

integer,parameter :: type_cyl=1
integer,parameter :: type_rect=2
integer,parameter :: type_annulus=3
integer,parameter :: type_gnd=4

integer,parameter :: mesh_type_layer=1
integer,parameter :: mesh_type_grid=2

type(conductor_type),allocatable :: conductor_data(:)

real(dp)    :: fmin,fmax
real(dp)    :: ndec

real(dp)    :: rh,rw
integer :: nhinc,nwinc

real(dp) :: x,y,ymin,ymax,w,h,wx,hy
integer :: conductor,layer,layer_number,nc

real(dp) :: angle
real(dp) :: lrc,lxc,lyc,lw,lh
real(dp) :: vx,vy

real(dp) :: dout,din

integer :: nxmin,nxmax,nymin,nymax,ix,iy
real(dp)    :: dpt,apx,apy

integer :: cx1,cx2
real(dp)    :: cw,ch
logical :: in_conductor

real(dp)    :: required_dl,nsd
integer :: nfilaments

character(LEN=6) :: conductor_string
character(LEN=6) :: layer_string
character(LEN=80) :: node_string
character(LEN=80) :: segment_string
character(LEN=80) :: loop_string
character(LEN=80) :: line_string

character(LEN=12) :: x_string,y_string,z_string

integer :: line
character(LEN=80) :: FH2_filename
character :: type_ch

integer :: tot_n_segments,tot_n_filaments
integer :: gp_n_segments,gp_n_filaments

real(dp),parameter :: pi=3.1415926535

! START

! READ THE PROBLEM SPECIFICATION

line=1
write(*,*)'Enter the name of the FastHenry2 input file to write:'
read(*,'(A80)',ERR=9000)FH2_filename

write(*,*)"Enter the number of conductors or 'ground_plane'"
line=line+1
read(*,'(A80)',ERR=9000)line_string
type_ch=line_string(1:1)

if ( (type_ch.EQ.'g').OR.(type_ch.EQ.'G') ) then

  write(*,*)'Reading ground plane specification...'
  ground_plane=.TRUE.
  
  write(*,*)'Enter the ground plane point 1 coordinates, x y z in metres'
  line=line+1
  read(*,*,ERR=9000)gp_x(1),gp_y(1),gp_z(1)
  write(*,*)'Enter the ground plane point 2 coordinates, x y z in metres'
  line=line+1
  read(*,*,ERR=9000)gp_x(2),gp_y(2),gp_z(2)
  write(*,*)'Enter the ground plane point 3 coordinates, x y z in metres'
  line=line+1
  read(*,*,ERR=9000)gp_x(3),gp_y(3),gp_z(3)
  
  write(*,*)'Enter the ground plane thickness in metres'
  line=line+1
  read(*,*,ERR=9000)gp_t
  
  write(*,*)'Enter the ground plane discretisation in p1-p2 and p2=p3 directions'
  line=line+1
  read(*,*,ERR=9000)gp_seg1,gp_seg2
  
  write(*,*)'Enter the ground conductivity in Siemens/metre'
  line=line+1
  read(*,*,ERR=9000)gp_sigma
  
  write(*,*)'Enter the ground plane discretisation in thickness,  nhinc'
  line=line+1
  read(*,*,ERR=9000)gp_nhinc
  
  write(*,*)'Enter the ground plane discretisation in thickness ratio,  rh'
  line=line+1
  read(*,*,ERR=9000)gp_rh

  write(*,*)'Enter the ground plane end 1 node coordinates, x y z in metres'
  line=line+1
  read(*,*,ERR=9000)gp_ex1,gp_ey1,gp_ez1
  write(*,*)'Enter the ground plane end 2 node coordinates, x y z in metres'
  line=line+1
  read(*,*,ERR=9000)gp_ex2,gp_ey2,gp_ez2
  
  gp_node1='Ngp_e1'
  gp_node2='Ngp_e2'
  
  gp_node1_external='Ngp_e1_ext'
  gp_node2_external='Ngp_e2_ext'

  write(*,*)"Enter the number of conductors"
  line=line+1
  read(*,*,ERR=9000)n_conductors

else

  write(*,*)'No ground plane'
  ground_plane=.FALSE.
  read(line_string,*,ERR=9000)n_conductors
  
end if

write(*,*)'Number of conductors (excluding ground plane)=',n_conductors

ALLOCATE( conductor_data(n_conductors) )

do conductor=1,n_conductors

  write(*,*)'Enter the conductor number'
  line=line+1
  read(*,*,ERR=9000)nc
  
  if (nc.NE.conductor) GOTO 9010

  write(*,*)'Enter the conductor type (cylindrical rectangular or annulus)'
  line=line+1
  read(*,'(A80)',ERR=9000)line_string
  type_ch=line_string(1:1)
  
  conductor_data(conductor)%auto_grid_density=.FALSE.
  
  if ( (type_ch.EQ.'c').OR.(type_ch.EQ.'C') ) then
    conductor_data(conductor)%type=type_cyl    

! work out the grid type    

INCLUDE "WRITE_FH2_IPFILE/get_grid_type.F90"

    write(*,*)Conductor,conductor,' mesh type=',conductor_data(conductor)%mesh_type

    write(*,*)'Enter the cylindrical conductor centre coordinates, xc yc in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%xc,conductor_data(conductor)%yc
    
    write(*,*)'Enter the cylindrical conductor radius, rc in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%rc
    
    write(*,*)'Enter the cylindrical conductor discretisation, dl in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%dl
        
  else if ( (type_ch.EQ.'r').OR.(type_ch.EQ.'R') ) then
    conductor_data(conductor)%type=type_rect

    write(*,*)'Enter the rectangular conductor centre coordinates, xc yc in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%xc,conductor_data(conductor)%yc
    
    write(*,*)'Enter the rectangular conductor width (x dimension) height (y dimension) in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%width,conductor_data(conductor)%height
 
    conductor_data(conductor)%n_layers2=1
    conductor_data(conductor)%tot_n_layers=1
  
  else if ( (type_ch.EQ.'a').OR.(type_ch.EQ.'A') ) then
    conductor_data(conductor)%type=type_annulus
    
INCLUDE "WRITE_FH2_IPFILE/get_grid_type.F90"

    write(*,*)Conductor,conductor,' mesh type=',conductor_data(conductor)%mesh_type
     
    write(*,*)'Enter the cylindrical conductor centre coordinates, xc yc in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%xc,conductor_data(conductor)%yc
    
    write(*,*)'Enter the cylindrical inner conductor radius, rci in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%rci
    
    write(*,*)'Enter the cylindrical outer conductor radius, rco in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%rco
    
    write(*,*)'Enter the cylindrical conductor discretisation, dl in metres'
    line=line+1
    read(*,*,ERR=9000)conductor_data(conductor)%dl

  else
    GOTO 9020
  end if   ! Conductor type
      
  write(*,*)'Enter the conductor conductivity, sigma in Siemens/metre'
  line=line+1
  read(*,*,ERR=9000)conductor_data(conductor)%sigma
            
  write(*,*)'Enter the conductor discretisations, nwinc nhinc'
  line=line+1
  read(*,*,ERR=9000)conductor_data(conductor)%nwinc,conductor_data(conductor)%nhinc
            
  write(*,*)'Enter the conductor discretisation ratios, rw rh'
  line=line+1
  read(*,*,ERR=9000)conductor_data(conductor)%rw,conductor_data(conductor)%rh
  
  if (conductor_data(conductor)%auto_grid_density) then ! uniform grid in segments
    conductor_data(conductor)%rw=1.0
    conductor_data(conductor)%rh=1.0
  end if

end do ! read next conductor

! Read the frequency range data
     
write(*,*)'Enter the minimum frequency, fmin (Hz)'
line=line+1
read(*,*,ERR=9000)fmin
     
write(*,*)'Enter the maximum frequency, fmax (Hz)'
line=line+1
read(*,*,ERR=9000)fmax
     
write(*,*)'Enter the number of frequency samples per decade, ndec'
line=line+1
read(*,*,ERR=9000)ndec

! END OF PROBLEM SPECIFICATION

open(unit=20,file=trim(FH2_filename))

open(unit=10,file='cross_section.dat')
open(unit=12,file='grid.dat')

! write header
write(20,'(A)')'* conductors in free space'
write(20,'(A)')'*'
write(20,'(A)')'.units m'
write(20,'(A)')'*'

! WORK OUT THE SKIN DEPTH IN EACH CONDUCTOR

if (ground_plane) then
  gp_skin_depth=sqrt(1.0/(pi*fmax*4.0*pi*1e-7*gp_sigma))
  write(*,*)'Minimum ground plane skin depth =',gp_skin_depth
end if

do conductor=1,n_conductors
  
  conductor_data(conductor)%skin_depth=sqrt(1.0/(pi*fmax*4.0*pi*1e-7*conductor_data(conductor)%sigma))
  write(*,*)'Conductor',conductor,' Minimum skin depth =',conductor_data(conductor)%skin_depth

end do ! next conductor

! ALLOCATE GRIDS IN CONDUCTORS IF REQUIRED...

do conductor=1,n_conductors

  if (conductor_data(conductor)%type.EQ.type_cyl) then
  
     if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then
    
      conductor_data(conductor)%n_layers2=NINT(conductor_data(conductor)%rc/conductor_data(conductor)%dl)
      conductor_data(conductor)%tot_n_layers=2*conductor_data(conductor)%n_layers2
    
    else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
    
! allocate grid for the circular geometry
      conductor_data(conductor)%grid_dim=conductor_data(conductor)%rc
     
INCLUDE "WRITE_FH2_IPFILE/create_grid.F90"
         
! Loop over the grid and set segments within the conductor
    
      conductor_data(conductor)%tot_n_layers=0
    
      do ix=nxmin,nxmax
        do iy=nymin,nymax
          dpt=conductor_data(conductor)%dl*sqrt(real(ix)**2+real(iy)**2)
      if ( dpt.LE.conductor_data(conductor)%rc ) then
        conductor_data(conductor)%grid(ix,iy)=1
        conductor_data(conductor)%depth(ix,iy)=conductor_data(conductor)%rc-dpt
        conductor_data(conductor)%tot_n_layers=conductor_data(conductor)%tot_n_layers+1
      end if
        end do
      end do
    
      conductor_data(conductor)%n_layers2=0

    else
      write(*,*)'Unknown grid type'
      STOP 1
    end if
 
  else if (conductor_data(conductor)%type.EQ.type_annulus) then
      
      
    if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then
    
      conductor_data(conductor)%n_layers2=0
      conductor_data(conductor)%tot_n_layers=20  ! number of segments in the loop
    
    else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
    
! allocate grid for the annular geometry

      conductor_data(conductor)%grid_dim=conductor_data(conductor)%rco
    
INCLUDE "WRITE_FH2_IPFILE/create_grid.F90"
    
! Loop over the grid and set segments within the annular conductor
    
      conductor_data(conductor)%tot_n_layers=0
    
      do ix=nxmin,nxmax
        do iy=nymin,nymax
          dpt=conductor_data(conductor)%dl*sqrt(real(ix)**2+real(iy)**2)
      if ( (dpt.GE.conductor_data(conductor)%rci).AND.(dpt.LE.conductor_data(conductor)%rco) ) then
        conductor_data(conductor)%grid(ix,iy)=1
        dout=conductor_data(conductor)%rco-dpt
        din=dpt-conductor_data(conductor)%rci
        conductor_data(conductor)%depth(ix,iy)=min(dout,din)
        conductor_data(conductor)%tot_n_layers=conductor_data(conductor)%tot_n_layers+1
      end if
        end do
      end do
    
      conductor_data(conductor)%n_layers2=0

    else
      
      write(*,*)'We can only use the grid mesh type for an annulus'
      STOP 1
      
    end if ! mesh type grid

  end if  ! annular
  
end do ! next conductor

! WRITE GROUND PLANE INFORMATION IF REQUIRED

gp_n_segments=0
gp_n_filaments=0

if (ground_plane) then

  write(20,'(A)')'*'
  write(20,'(A)')'* Ground plane'
  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)
  write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'+            x2=',gp_x(2),' y2=',gp_y(2),' z2=',gp_z(2)
  write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'+            x3=',gp_x(3),' y3=',gp_y(3),' z3=',gp_z(3)
  write(20,'(A,ES12.4)')'+  thick=',gp_t
  write(20,'(A,ES12.4)')'+  sigma=',gp_sigma
  write(20,'(A,I4)')'+  nhinc=',gp_nhinc
  write(20,'(A,ES12.4)')'+  rh=',gp_rh
  write(20,'(A,I4,A,I4)')'+  seg1=',gp_seg1,' seg2=',gp_seg2
 
  gp_n_segments =(gp_seg1+1)*gp_seg2+(gp_seg2+1)*gp_seg1
  gp_n_filaments=gp_nhinc*gp_n_segments
 
  write(x_string,'(ES12.4)')gp_ex1
  write(y_string,'(ES12.4)')gp_ey1
  write(z_string,'(ES12.4)')gp_ez1  
  write(20,'(9A)')'+ ',trim(gp_node1),' (',trim(adjustl(x_string)),  &
                                       ',',trim(adjustl(y_string)),  &
                       ',',trim(adjustl(z_string)),')'
  
  write(x_string,'(ES12.4)')gp_ex2
  write(y_string,'(ES12.4)')gp_ey2
  write(z_string,'(ES12.4)')gp_ez2  
  write(20,'(9A)')'+ ',trim(gp_node2),' (',trim(adjustl(x_string)),  &
                                       ',',trim(adjustl(y_string)),  &
                       ',',trim(adjustl(z_string)),')'
                       
end if

! LOOP OVER THE CONDUCTORS AND DEFINE THEN WRITE THE NODES FOR EACH LAYER ON THE CONDUCTOR

write(20,'(A)')'*'
write(20,'(A)')'* Specify the conductor nodes'
do conductor=1,n_conductors

  write(20,'(A)')'*'
  write(20,'(A,I4)')'* Conductor',conductor
  
  write(conductor_string,'(I4)')conductor
  
  ALLOCATE( conductor_data(conductor)%x(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%y(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%w(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%h(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%d(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%anwinc(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%anhinc(1:conductor_data(conductor)%tot_n_layers) )

  ALLOCATE( conductor_data(conductor)%wx(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%wy(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%wz(1:conductor_data(conductor)%tot_n_layers) )

  conductor_data(conductor)%wx(1:conductor_data(conductor)%tot_n_layers)=1.0
  conductor_data(conductor)%wy(1:conductor_data(conductor)%tot_n_layers)=0.0
  conductor_data(conductor)%wz(1:conductor_data(conductor)%tot_n_layers)=0.0  

  ALLOCATE( conductor_data(conductor)%node1_list(1:conductor_data(conductor)%tot_n_layers) )
  ALLOCATE( conductor_data(conductor)%node2_list(1:conductor_data(conductor)%tot_n_layers) )
  
  if (conductor_data(conductor)%type.EQ.type_cyl) then 
    
    if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then

      do layer=-conductor_data(conductor)%n_layers2+1,conductor_data(conductor)%n_layers2
  
        layer_number=conductor_data(conductor)%n_layers2+layer
    
        ymin=conductor_data(conductor)%dl*real(layer)
        ymax=conductor_data(conductor)%dl*real(layer-1)
        y=(ymin+ymax)/2.0
        x=sqrt(conductor_data(conductor)%rc**2-y**2)
    
        conductor_data(conductor)%x(layer_number)=conductor_data(conductor)%xc
        conductor_data(conductor)%y(layer_number)=conductor_data(conductor)%yc+y
        conductor_data(conductor)%w(layer_number)=2.0*x
        conductor_data(conductor)%h(layer_number)=conductor_data(conductor)%dl
        conductor_data(conductor)%d(layer_number)=0.0
        conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
        conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
   
      end do  ! next layer
        
    else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
    
! Loop over the grid and set segments within the circular conductor

INCLUDE "WRITE_FH2_IPFILE/set_segments_from_grid.F90"
     
    end if   ! mesh_type_grid
    
  else if (conductor_data(conductor)%type.EQ.type_rect) then 
  
    layer_number=1
        
    conductor_data(conductor)%x(layer_number)=conductor_data(conductor)%xc
    conductor_data(conductor)%y(layer_number)=conductor_data(conductor)%yc
    conductor_data(conductor)%w(layer_number)=conductor_data(conductor)%width
    conductor_data(conductor)%h(layer_number)=conductor_data(conductor)%height
    conductor_data(conductor)%d(layer_number)=0.0
    conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
    conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
     
  else if (conductor_data(conductor)%type.EQ.type_annulus) then 
  
    if (conductor_data(conductor)%mesh_type.EQ.mesh_type_layer) then

      do layer_number=1,conductor_data(conductor)%tot_n_layers
      
        angle=real(layer_number)*2.0*pi/real(conductor_data(conductor)%tot_n_layers)
        conductor_data(conductor)%wx(layer_number)=-sin(angle)
        conductor_data(conductor)%wy(layer_number)=cos(angle)
        conductor_data(conductor)%wz(layer_number)=0.0
    
    lrc=(conductor_data(conductor)%rco+conductor_data(conductor)%rci)/2.0
    lh=(conductor_data(conductor)%rco-conductor_data(conductor)%rci)/2.0
    lw=lrc*2.0*pi/real(conductor_data(conductor)%tot_n_layers)
    lxc=lrc*cos(angle)
    lyc=lrc*sin(angle)
          
        conductor_data(conductor)%x(layer_number)=conductor_data(conductor)%xc+lxc
        conductor_data(conductor)%y(layer_number)=conductor_data(conductor)%yc+lyc
        conductor_data(conductor)%w(layer_number)=lw
        conductor_data(conductor)%h(layer_number)=lh
        conductor_data(conductor)%d(layer_number)=0.0
        conductor_data(conductor)%anwinc(layer_number)=conductor_data(conductor)%nwinc
        conductor_data(conductor)%anhinc(layer_number)=conductor_data(conductor)%nwinc
   
      end do  ! next layer
        
    else if (conductor_data(conductor)%mesh_type.EQ.mesh_type_grid) then
    
! Loop over the grid and set segments within the circular conductor

INCLUDE "WRITE_FH2_IPFILE/set_segments_from_grid.F90"
     
    end if   ! mesh_type_grid
    
  else
    write(*,*)'Cant deal with this conductor type yet:',conductor_data(conductor)%type
    STOP 1
  end if

! WRITE_THE NODES TO THE INPUT FILE AND SAVE IN THE NODE LIST FOR THIS CONDUCTOR

  do layer_number=1,conductor_data(conductor)%tot_n_layers
  
    write(layer_string,'(I4)')layer_number
    
    node_string='n_c'//trim(adjustl(conductor_string))//'_e1_l'//trim(adjustl(layer_string))   
    write(20,'(A,A,ES12.4,A,ES12.4,A)')trim(node_string),                      &
                         ' x=',conductor_data(conductor)%x(layer_number),          &
                         ' y=',conductor_data(conductor)%y(layer_number),' z=0.0'
    conductor_data(conductor)%node1_list(layer_number)=node_string
    
    node_string='n_c'//trim(adjustl(conductor_string))//'_e2_l'//trim(adjustl(layer_string))   
    write(20,'(A,A,ES12.4,A,ES12.4,A)')trim(node_string),                      &
                         ' x=',conductor_data(conductor)%x(layer_number),          &
                         ' y=',conductor_data(conductor)%y(layer_number),' z=1.0'
    conductor_data(conductor)%node2_list(layer_number)=node_string
    
    wx=conductor_data(conductor)%w(layer_number)/2.0
    hy=conductor_data(conductor)%h(layer_number)/2.0
    rw=conductor_data(conductor)%rw
    rh=conductor_data(conductor)%rh              
    nwinc=conductor_data(conductor)%anwinc(layer_number)
    nhinc=conductor_data(conductor)%anhinc(layer_number)
    
    vx=conductor_data(conductor)%wx(layer_number)
    vy=conductor_data(conductor)%wy(layer_number)
     
    CALL plot_layer(conductor_data(conductor)%x(layer_number),conductor_data(conductor)%y(layer_number), &
                    wx,hy,vx,vy,10)
    
    CALL plot_grid(conductor_data(conductor)%x(layer_number),conductor_data(conductor)%y(layer_number), &
                    wx,hy,vx,vy,rw,rh,nwinc,nhinc,12)
  
  end do  ! next layer

end do  ! next conductor

! LOOP OVER THE CONDUCTORS AND WRITE THE WIRE SEGMENTS FOR EACH LAYER ON THE CONDUCTOR

tot_n_segments=0
tot_n_filaments=0

write(20,'(A)')'*'
write(20,'(A)')'* conductor segments'
do conductor=1,n_conductors

  write(20,'(A)')'*'
  write(20,'(A,I4)')'* Conductor',conductor

  write(conductor_string,'(I4)')conductor
  
  do layer_number=1,conductor_data(conductor)%tot_n_layers
  
    write(layer_string,'(I4)')layer_number
    
    segment_string='E_c'//trim(adjustl(conductor_string))//'_l'//trim(adjustl(layer_string)) 
    
    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)')         &
                           trim(segment_string),' ',                                       &
                           trim(conductor_data(conductor)%node1_list(layer_number)),' ',   &
               trim(conductor_data(conductor)%node2_list(layer_number)),       &  
                           ' h=',conductor_data(conductor)%h(layer_number),                &
                           ' w=',conductor_data(conductor)%w(layer_number),                &
               ' sigma=',conductor_data(conductor)%sigma,                      &
                           ' wx=',conductor_data(conductor)%wx(layer_number),              &
                           ' wy=',conductor_data(conductor)%wy(layer_number),              &
                           ' wz=',conductor_data(conductor)%wz(layer_number),              &
               ' nhinc=',conductor_data(conductor)%anhinc(layer_number),                      &
               ' nwinc=',conductor_data(conductor)%anwinc(layer_number),                      &
               ' rh=',conductor_data(conductor)%rh,                            &
               ' rw=',conductor_data(conductor)%rw
               
    tot_n_segments=tot_n_segments+1
    tot_n_filaments=tot_n_filaments+conductor_data(conductor)%nhinc*conductor_data(conductor)%nwinc
    
  end do
  
end do

! EQUIVALENCE CONDUCTOR NODES AT NEAR END

write(20,'(A)')'*'
write(20,'(A)')'* Near end equivalent nodes on conductors'
do conductor=1,n_conductors

  if (conductor_data(conductor)%tot_n_layers.GT.1) then

    write(20,'(A)')'*'
    write(20,'(A,I4)')'* Conductor',conductor
  
    write(20,'(A)')'.equiv'  
    do layer_number=1,conductor_data(conductor)%tot_n_layers 
      write(20,'(A,A)')'+ ',trim(conductor_data(conductor)%node1_list(layer_number))  
    end do 
    
  end if
  
end do

! EQUIVALENCE CONDUCTOR NODES AT FAR END

write(20,'(A)')'*'
write(20,'(A)')'* Far end equivalent nodes on conductors'
do conductor=1,n_conductors

  if (conductor_data(conductor)%tot_n_layers.GT.1) then

    write(20,'(A)')'*'
    write(20,'(A,I4)')'* Conductor',conductor
  
    write(20,'(A)')'.equiv'  
    do layer_number=1,conductor_data(conductor)%tot_n_layers
      write(20,'(A,A)')'+ ',trim(conductor_data(conductor)%node2_list(layer_number))   
    end do
  
  end if
  
end do

! DEFINE LOOPS

if (ground_plane) then

  write(20,'(A)')'*'
  write(20,'(A)')'* Make loops from ground plane to all other conductors in turn'
  
  do conductor=1,n_conductors

    write(20,'(A)')'*'
    write(20,'(A,I4)')'* Ground plane to conductor',conductor
  
    write(conductor_string,'(I4)')conductor
    loop_string='loop_'//trim(adjustl(conductor_string))   
  
    write(20,'(A,A,A,A,A,A)')'.external ',trim(gp_node1),   &
                                      ' ',trim(conductor_data(conductor)%node1_list(1)), &
                        ' ',trim(loop_string)    
  end do

! JOIN ALL FAR END CONDUCTORS

  write(20,'(A)')'*'
  write(20,'(A)')'* Join all Far end conductors'
  
  write(20,'(A)',ADVANCE='NO')'.equiv'
  write(20,'(A,A)',ADVANCE='NO')' ',trim(gp_node2) 
  do conductor=1,n_conductors    

    layer_number=1  
    write(20,'(A,A)',ADVANCE='NO')' ',trim(conductor_data(conductor)%node2_list(layer_number)) 
  
  end do
    
  write(20,*)

else
! No ground plane 

  write(20,'(A)')'*'
  write(20,'(A)')'* Make loops from conductor 1 to all other conductors in turn'
  
  do conductor=2,n_conductors

    write(20,'(A)')'*'
    write(20,'(A,I4)')'* Conductor 1 to conductor',conductor
  
    write(conductor_string,'(I4)')conductor-1
    loop_string='loop_'//trim(adjustl(conductor_string))   
  
    write(20,'(A,A,A,A,A,A)')'.external ',trim(conductor_data(1)%node1_list(1)),   &
                                      ' ',trim(conductor_data(conductor)%node1_list(1)), &
                        ' ',trim(loop_string)    
  end do

! JOIN ALL FAR END CONDUCTORS

  write(20,'(A)')'*'
  write(20,'(A)')'* Join all Far end conductors'
  
  write(20,'(A)',ADVANCE='NO')'.equiv'
  do conductor=1,n_conductors    

    layer_number=1  
    write(20,'(A,A)',ADVANCE='NO')' ',trim(conductor_data(conductor)%node2_list(layer_number)) 
  
  end do
    
  write(20,*)
  
end if ! ground plane

! WRITE THE FREQUENCY RANGE AND END

write(20,'(A)')'*'
write(20,'(A,ES12.4,A,ES12.4,A,ES12.4)')'.freq fmin=',fmin,' fmax=',fmax,' ndec=',ndec
write(20,'(A)')'*'
write(20,'(A)')'.end'

! CLOSE FILES

close(unit=10)
close(unit=12)
close(unit=20)

! DEALLOCATE MEMORY

do conductor=1,n_conductors

  if (ALLOCATED( conductor_data(conductor)%x )) DEALLOCATE( conductor_data(conductor)%x )
  if (ALLOCATED( conductor_data(conductor)%y )) DEALLOCATE( conductor_data(conductor)%y )
  if (ALLOCATED( conductor_data(conductor)%w )) DEALLOCATE( conductor_data(conductor)%w )
  if (ALLOCATED( conductor_data(conductor)%h )) DEALLOCATE( conductor_data(conductor)%h )

  if (ALLOCATED( conductor_data(conductor)%wx )) DEALLOCATE( conductor_data(conductor)%wx )
  if (ALLOCATED( conductor_data(conductor)%wy )) DEALLOCATE( conductor_data(conductor)%wy )
  if (ALLOCATED( conductor_data(conductor)%wz )) DEALLOCATE( conductor_data(conductor)%wz )

  if (ALLOCATED( conductor_data(conductor)%d )) DEALLOCATE( conductor_data(conductor)%d )
  if (ALLOCATED( conductor_data(conductor)%anwinc )) DEALLOCATE( conductor_data(conductor)%anwinc )
  if (ALLOCATED( conductor_data(conductor)%anhinc )) DEALLOCATE( conductor_data(conductor)%anhinc )

  if (ALLOCATED( conductor_data(conductor)%node1_list )) DEALLOCATE( conductor_data(conductor)%node1_list )
  if (ALLOCATED( conductor_data(conductor)%node2_list )) DEALLOCATE( conductor_data(conductor)%node2_list )

  if (ALLOCATED( conductor_data(conductor)%grid )) DEALLOCATE( conductor_data(conductor)%grid )
  if (ALLOCATED( conductor_data(conductor)%depth )) DEALLOCATE( conductor_data(conductor)%depth )
  
end do

if ( ALLOCATED(conductor_data) ) DEALLOCATE( conductor_data )

write(*,*)
write(*,*)'Total number of conductor segments =',tot_n_segments
write(*,*)'Total number of conductor filaments=',tot_n_filaments
write(*,*)

if (ground_plane) then
  write(*,*)'Total number of ground plane segments =',gp_n_segments
  write(*,*)'Total number of ground plane filaments=',gp_n_filaments
  write(*,*)
end if

write(*,*)'Total number of segments =',gp_n_segments+tot_n_segments
write(*,*)'Total number of filaments=',gp_n_filaments+tot_n_filaments
write(*,*)

STOP 0

9000 write(*,*)'ERROR reading the Cross Section Specification data, line',line
STOP 1

9010 write(*,*)'ERROR conductors should be numbered in order, line',line
STOP 1

9020 write(*,*)'ERROR Unknown conductor type:',type_ch,', line',line
STOP 1


END PROGRAM write_FH_input_file
!
! ___________________________________________________
!
!
SUBROUTINE plot_layer(xc,yc,wx,wy,vxx,vxy,file_unit)

USE type_specifications

IMPLICIT NONE

! variables passed to subroutine

real(dp)    :: xc,yc,wx,wy,vxx,vxy
integer :: file_unit

! local variables

real(dp) :: rotx,roty

! START

 CALL rotate(-wx,+wy,vxx,vxy,rotx,roty)
 write(file_unit,*)xc+rotx,yc+roty
 CALL rotate(+wx,+wy,vxx,vxy,rotx,roty)
 write(file_unit,*)xc+rotx,yc+roty
 CALL rotate(+wx,-wy,vxx,vxy,rotx,roty)
 write(file_unit,*)xc+rotx,yc+roty
 CALL rotate(-wx,-wy,vxx,vxy,rotx,roty)
 write(file_unit,*)xc+rotx,yc+roty
 CALL rotate(-wx,+wy,vxx,vxy,rotx,roty)
 write(file_unit,*)xc+rotx,yc+roty
 write(file_unit,*)

RETURN

END SUBROUTINE plot_layer
!
! _______________________________________________________
!
!
SUBROUTINE plot_grid(xc,yc,wx,wy,vxx,vxy,rx,ry,nx,ny,file_unit)

USE type_specifications

IMPLICIT NONE

! variables passed to subroutine

real(dp)    :: xc,yc,wx,wy,vxx,vxy,rx,ry
integer :: nx,ny,file_unit

! local variables

real(dp)    :: dx,dy,den,ox,oy
integer :: nl2
integer :: i
logical :: odd
real(dp) :: rotx,roty

! START

! lines in the x direction
if ( mod(nx,2).EQ.0 ) then
  odd=.FALSE.
else
  odd=.TRUE.
end if

if (odd) then
  nl2=(nx-1)/2
else
  nl2=nx/2 
end if

den=0.0
do i=1,nl2
  den=den+2.0*rx**(i-1)
end do
if (odd) den=den+rx**(nl2)

dx=wx*2.0/den

!write(*,*)'xc=',xc
!write(*,*)'nx=',nx
!write(*,*)'odd=',odd
!write(*,*)'nl2=',nl2
!write(*,*)'wx=',wx
!write(*,*)'den=',den
!write(*,*)'dx=',dx

ox=wx
do i=1,nl2
  ox=ox-dx*(rx**(i-1))
!  write(*,*)'i=',i,' ox=',ox
  CALL rotate(-ox,+wy,vxx,vxy,rotx,roty)
  write(file_unit,*)xc+rotx,yc+roty
  CALL rotate(-ox,-wy,vxx,vxy,rotx,roty)
  write(file_unit,*)xc+rotx,yc+roty
  write(file_unit,*)
  CALL rotate(+ox,+wy,vxx,vxy,rotx,roty)
  write(file_unit,*)xc+rotx,yc+roty
  CALL rotate(+ox,-wy,vxx,vxy,rotx,roty)
  write(file_unit,*)xc+rotx,yc+roty
  write(file_unit,*)
end do

if (.NOT.odd) then  ! write centre line
  CALL rotate(0d0,+wy,vxx,vxy,rotx,roty)
  write(file_unit,*)xc+rotx,yc+roty
  CALL rotate(0d0,-wy,vxx,vxy,rotx,roty)
  write(file_unit,*)xc+rotx,yc+roty
  write(file_unit,*)
end if

! lines in the y direction
if ( mod(ny,2).EQ.0 ) then
  odd=.FALSE.
else
  odd=.TRUE.
end if

if (odd) then
  nl2=(ny-1)/2
else
  nl2=ny/2 
end if

den=0.0
do i=1,nl2
  den=den+2.0*ry**(i-1)
end do
if (odd) den=den+ry**(nl2)

dy=wy*2.0/den

oy=wy
do i=1,nl2
  oy=oy-dy*(ry**(i-1))
  write(file_unit,*)xc+wx,yc-oy
  write(file_unit,*)xc-wx,yc-oy
  write(file_unit,*)
  write(file_unit,*)xc+wx,yc+oy
  write(file_unit,*)xc-wx,yc+oy
  write(file_unit,*)
end do

if (.NOT.odd) then  ! write centre line
  write(file_unit,*)xc+wx,yc
  write(file_unit,*)xc-wx,yc
  write(file_unit,*)
end if

RETURN

END SUBROUTINE plot_grid
!
! _______________________________________________________
!
!
SUBROUTINE rotate(x,y,vxx,vxy,rx,ry)

USE type_specifications

IMPLICIT NONE

! variables passed to subroutine

real(dp)    :: x,y,vxx,vxy,rx,ry

! local variables

real(dp)    :: vyx,vyy

! START

vyx=-vxy
vyy=vxx

rx=x*vxx+y*vyx
ry=x*vxy+y*vyy

RETURN

END SUBROUTINE rotate