From ad615b454a7d47d931a918a21309bf0da56671a5 Mon Sep 17 00:00:00 2001
From: chris.smartt <chris.smartt@nottingham.ac.uk>
Date: Fri, 13 Jul 2018 12:55:50 +0100
Subject: [PATCH] Add incident field pins to LTspice and Ngspice schematic symbols

---
 SOFTWARE_NOTES/work_log.txt                                       |   2 ++
 SRC/CREATE_SPICE_CIRCUIT_MODEL/create_spice_subcircuit_symbol.F90 | 295 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 2 files changed, 113 insertions(+), 184 deletions(-)

diff --git a/SOFTWARE_NOTES/work_log.txt b/SOFTWARE_NOTES/work_log.txt
index 0d6e55c..cae536c 100644
--- a/SOFTWARE_NOTES/work_log.txt
+++ b/SOFTWARE_NOTES/work_log.txt
@@ -12,3 +12,5 @@
 25th June   CJS    Add the nex flex cable test cases  EDGE_COUPLED_STRIPLINE and
                    SYMMETRIC_STRIPLINE to test the new flex cable model
 
+
+13th July CJS      fix error in creaating circuit symbols: incident field nodes were missing...
diff --git a/SRC/CREATE_SPICE_CIRCUIT_MODEL/create_spice_subcircuit_symbol.F90 b/SRC/CREATE_SPICE_CIRCUIT_MODEL/create_spice_subcircuit_symbol.F90
index ce06832..6914b16 100644
--- a/SRC/CREATE_SPICE_CIRCUIT_MODEL/create_spice_subcircuit_symbol.F90
+++ b/SRC/CREATE_SPICE_CIRCUIT_MODEL/create_spice_subcircuit_symbol.F90
@@ -29,7 +29,6 @@
 ! File Contents:
 ! SUBROUTINE create_spice_subcircuit_symbol_NGspice
 ! SUBROUTINE create_spice_subcircuit_symbol_LTspice
-! SUBROUTINE create_spice_subcircuit_symbol_Pspice
 !
 ! NAME
 !     create_spice_subcircuit_symbol_NGspice
@@ -118,6 +117,11 @@ character(len=line_length)    :: pinlabel_string
 
   ymax_symbol=ymin_offset+(n_conductors-1)*y_conductor_spacing+ymax_offset
 
+! add a space for the incident field nodes  
+  if (spice_bundle_model%include_incident_field) then
+    ymax_symbol=ymax_symbol+y_conductor_spacing
+  end if
+
 ! end 1 pin parameters # this could maybe go with parameters in the module...
   xpin1(1)=xmin_symbol-x_pin_length
   xpin2(1)=xmin_symbol
@@ -175,6 +179,59 @@ character(len=line_length)    :: pinlabel_string
     end do ! next conductor
     
   end do ! other cable end
+
+! add a space for the incident field nodes  
+  if (spice_bundle_model%include_incident_field) then
+    
+! put the first Einc pin on the LHS of the symbol    
+      end=1
+      pin=pin+1
+      ypin=ymax_symbol-ymax_offset-(n_conductors)*y_conductor_spacing
+      
+      string1='pinnumber='
+      CALL add_integer_to_string(string1,pin,pinnumber_string)
+      
+      string1='pinseq='
+      CALL add_integer_to_string(string1,pin,pinseq_string)
+
+      pinlabel_string='Einc1'
+      write(symbol_file_unit,'(A,4I6,A)')'P ',xpin1(end),ypin,xpin2(end),ypin,' 1 0 0'
+      write(symbol_file_unit,'(A)')'{'
+      write(symbol_file_unit,'(A)')'T 150 250   5 8 0 0 0 6 1'
+      write(symbol_file_unit,'(A)')trim(pinnumber_string)
+      write(symbol_file_unit,'(A)')'T 150 150   5 8 0 0 0 8 1'
+      write(symbol_file_unit,'(A)')trim(pinseq_string)
+      write(symbol_file_unit,'(A,2I6,A,I3,A)')'T ',xpin_label(end),ypin,' 9 6 1 1 0 ',align_label(end),' 1'
+      write(symbol_file_unit,'(A)')trim(pinlabel_string)
+      write(symbol_file_unit,'(A)')'T 200 200   5 8 0 0 0 2 1'
+      write(symbol_file_unit,'(A)')'pintype=pas'
+      write(symbol_file_unit,'(A)')'}'
+    
+! put the first Einc pin on the LHS of the symbol    
+      end=2
+      pin=pin+1
+      ypin=ymax_symbol-ymax_offset-(n_conductors)*y_conductor_spacing
+      
+      string1='pinnumber='
+      CALL add_integer_to_string(string1,pin,pinnumber_string)
+      
+      string1='pinseq='
+      CALL add_integer_to_string(string1,pin,pinseq_string)
+
+      pinlabel_string='Einc2'
+      write(symbol_file_unit,'(A,4I6,A)')'P ',xpin1(end),ypin,xpin2(end),ypin,' 1 0 0'
+      write(symbol_file_unit,'(A)')'{'
+      write(symbol_file_unit,'(A)')'T 150 250   5 8 0 0 0 6 1'
+      write(symbol_file_unit,'(A)')trim(pinnumber_string)
+      write(symbol_file_unit,'(A)')'T 150 150   5 8 0 0 0 8 1'
+      write(symbol_file_unit,'(A)')trim(pinseq_string)
+      write(symbol_file_unit,'(A,2I6,A,I3,A)')'T ',xpin_label(end),ypin,' 9 6 1 1 0 ',align_label(end),' 1'
+      write(symbol_file_unit,'(A)')trim(pinlabel_string)
+      write(symbol_file_unit,'(A)')'T 200 200   5 8 0 0 0 2 1'
+      write(symbol_file_unit,'(A)')'pintype=pas'
+      write(symbol_file_unit,'(A)')'}'
+    
+  end if
   
 !  spice_subcircuit_filename=trim(MOD_spice_bundle_lib_dir)//trim(spice_bundle_model%spice_model_name)//spice_model_file_extn
   spice_subcircuit_filename='PATH_TO_TRANSMISSION_LINE_SUB_CIRCUITS/'//  &
@@ -264,6 +321,7 @@ integer :: LT_ymax_symbol    ! maximum y extent of the symbol (depends on the nu
 
 integer :: LT_xpin1(2),LT_xpin2(2)  ! pin x coordinates for ends 1 and 2 of the transmission line symbol
 integer :: LT_ypin                  ! pin y coordinate
+integer :: Einc_y_offset
 
 integer :: xpin_label(2)      ! x coordinate for conductor labels at ends 1 and 2 of the transmission line symbol
 
@@ -299,6 +357,13 @@ character(len=line_length)    :: pinlabel_string
   n_conductors=spice_bundle_model%bundle%tot_n_conductors
 
   LT_ymax_symbol=LT_ymin_offset+(n_conductors-1)*LT_y_conductor_spacing+LT_ymax_offset
+  
+! add a space for the incident field nodes  
+  Einc_y_offset=0
+  if (spice_bundle_model%include_incident_field) then
+    Einc_y_offset=LT_y_conductor_spacing
+    LT_ymax_symbol=LT_ymax_symbol+Einc_y_offset
+  end if
 
 ! end 1 pin parameters # this could maybe go with parameters in the module...
   LT_xpin1(1)=LT_xmin_symbol-LT_x_pin_length
@@ -326,7 +391,7 @@ character(len=line_length)    :: pinlabel_string
     
       pin=pin+1
       
-      LT_ypin=LT_ymax_symbol-LT_ymax_offset-(n_conductors-conductor)*LT_y_conductor_spacing
+      LT_ypin=LT_ymax_symbol-LT_ymax_offset-(n_conductors-conductor)*LT_y_conductor_spacing-Einc_y_offset
       
       write(symbol_file_unit,'(A,4I6)')'LINE Normal ',LT_xpin1(end),LT_ypin,LT_xpin2(end),LT_ypin
    
@@ -334,6 +399,25 @@ character(len=line_length)    :: pinlabel_string
     
   end do ! other cable end
   
+! add pins for the incident field nodes  
+  if (spice_bundle_model%include_incident_field) then
+  
+    end=1
+    pin=pin+1
+      
+    LT_ypin=LT_ymax_symbol-LT_ymax_offset
+      
+    write(symbol_file_unit,'(A,4I6)')'LINE Normal ',LT_xpin1(end),LT_ypin,LT_xpin2(end),LT_ypin
+  
+    end=2
+    pin=pin+1
+      
+    LT_ypin=LT_ymax_symbol-LT_ymax_offset
+      
+    write(symbol_file_unit,'(A,4I6)')'LINE Normal ',LT_xpin1(end),LT_ypin,LT_xpin2(end),LT_ypin
+    
+  end if
+
 ! write general information
 
   write(symbol_file_unit,'(A,2I6,A)')'WINDOW 3 ',(LT_xmin_symbol+LT_xmax_symbol)/2,-LT_ymax_text_offset,' centre 0'
@@ -357,7 +441,7 @@ character(len=line_length)    :: pinlabel_string
     do conductor=1,n_conductors
     
       pin=pin+1
-      LT_ypin=LT_ymax_symbol-LT_ymax_offset-(n_conductors-conductor)*LT_y_conductor_spacing
+      LT_ypin=LT_ymax_symbol-LT_ymax_offset-(n_conductors-conductor)*LT_y_conductor_spacing-Einc_y_offset
       
       if (end.eq.1) then
         write(symbol_file_unit,'(A,2I6,A,I6)')'PIN ',LT_xpin1(end),LT_ypin,' LEFT ',LT_x_pin_length
@@ -379,6 +463,30 @@ character(len=line_length)    :: pinlabel_string
     
   end do ! other cable end
   
+  if (spice_bundle_model%include_incident_field) then
+   
+    end=1
+    pin=pin+1     
+    LT_ypin=LT_ymax_symbol-LT_ymax_offset
+    write(symbol_file_unit,'(A,2I6,A,I6)')'PIN ',LT_xpin1(end),LT_ypin,' LEFT ',LT_x_pin_length
+    pinlabel_string='PinName Einc1'
+    write(symbol_file_unit,'(A,A)')'PINATTR ',trim(pinlabel_string)
+    string1=''
+    CALL add_integer_to_string(string1,pin,pinnumber_string)
+    write(symbol_file_unit,'(A,A)')'PINATTR SpiceOrder ',trim(pinnumber_string)
+  
+    end=2
+    pin=pin+1      
+    write(symbol_file_unit,'(A,2I6,A,I6)')'PIN ',LT_xpin1(end),LT_ypin,' RIGHT ',LT_x_pin_length      
+    pinlabel_string='PinName Einc2'
+    write(symbol_file_unit,'(A,A)')'PINATTR ',trim(pinlabel_string)
+    string1=''
+    CALL add_integer_to_string(string1,pin,pinnumber_string)
+    write(symbol_file_unit,'(A,A)')'PINATTR SpiceOrder ',trim(pinnumber_string)
+
+  
+  end if
+  
   xpin_label(1)=LT_xmin_symbol
   xpin_label(2)=LT_xmax_symbol
   
@@ -391,184 +499,3 @@ character(len=line_length)    :: pinlabel_string
   RETURN
 
 END SUBROUTINE create_spice_subcircuit_symbol_LTspice
-!
-! NAME
-!     create_spice_subcircuit_symbol_Pspice
-!
-! AUTHORS
-!     Chris Smartt
-!
-! DESCRIPTION
-!     This subroutine creates a symbol for the Spice subcircuit model for the cable bundle
-!     to be used in schematic capture software
-!
-!     The file formats for Gschem can be found here: http://wiki.geda-project.org/geda:file_format_spec
-!     
-! COMMENTS
-!     
-!
-! HISTORY
-!
-!     started 15/12/2015 CJS: STAGE_1 developments
-!
-!
-SUBROUTINE create_spice_subcircuit_symbol_Pspice(spice_bundle_model)
-
-USE type_specifications
-USE general_module
-USE constants
-USE cable_module
-USE cable_bundle_module
-USE spice_cable_bundle_module
-USE circuit_symbol_module
-
-IMPLICIT NONE
-
-! variables passed to the subroutine
-
-TYPE(spice_model_specification_type),intent(IN) :: spice_bundle_model
-
-! local variables
-
-character(len=filename_length)    :: filename                    ! filename for the symbol file
-character(len=filename_length)    :: spice_subcircuit_filename   ! filename for the associated spice sub-circuit model
-
-integer :: n_conductors
-
-integer :: ymax_symbol    ! maximum y extent of the symbol (depends on the number of conductors)
-
-integer :: xpin1(2),xpin2(2)  ! pin x coordinates for ends 1 and 2 of the transmission line symbol
-integer :: ypin               ! pin y coordinate
-
-integer :: xpin_label(2)      ! x coordinate for conductor labels at ends 1 and 2 of the transmission line symbol
-integer :: align_label(2)     ! alignment type for symbols
-
-! loop variables
-integer :: pin                ! pin number
-integer :: end                ! end number
-integer :: conductor          ! conductor number
-
-! temporary strings
-character(len=line_length)    :: string1
-character(len=line_length)    :: string2
-
-! pin label strings
-character(len=line_length)    :: pinnumber_string
-character(len=line_length)    :: pinseq_string
-character(len=line_length)    :: pinlabel_string
-
-! START
-  
-! filename for the symbol. The directory for the symbol is read from the 
-! .spice_model_spec file (i.e. specified by the GUI)
-
-  filename=trim(spice_symbol_dir)//trim(spice_bundle_model%spice_model_name)//symbol_file_extn
-
-! open the symbol file
-  
-  OPEN(unit=symbol_file_unit,file=filename)
-
-  if (verbose) write(*,*)'Opened file:',trim(filename)
-
-! calculate the size of the symbol from the number of conductors and set all symbol dimensions
-
-  n_conductors=spice_bundle_model%bundle%tot_n_conductors
-
-  ymax_symbol=ymin_offset+(n_conductors-1)*y_conductor_spacing+ymax_offset
-
-! end 1 pin parameters # this could maybe go with parameters in the module...
-  xpin1(1)=xmin_symbol-x_pin_length
-  xpin2(1)=xmin_symbol
-  
-! end 2 pin parameters
-  xpin1(2)=xmax_symbol+x_pin_length
-  xpin2(2)=xmax_symbol
-  
- ! write the header
-  write(symbol_file_unit,'(A)')symbol_version
-
-! write the rectangular box
-  write(symbol_file_unit,'(A,4I6,A)')'L ',xmin_symbol,ymin_symbol,xmin_symbol,ymax_symbol,' 3 0 0 0 -1 -1'
-  write(symbol_file_unit,'(A,4I6,A)')'L ',xmin_symbol,ymax_symbol,xmax_symbol,ymax_symbol,' 3 0 0 0 -1 -1'
-  write(symbol_file_unit,'(A,4I6,A)')'L ',xmax_symbol,ymax_symbol,xmax_symbol,ymin_symbol,' 3 0 0 0 -1 -1'
-  write(symbol_file_unit,'(A,4I6,A)')'L ',xmax_symbol,ymin_symbol,xmin_symbol,ymin_symbol,' 3 0 0 0 -1 -1'
-
-! write the connection pins  
-  xpin_label(1)=xmin_symbol
-  xpin_label(2)=xmax_symbol
-  align_label(1)=1   ! left
-  align_label(2)=7   ! right
-  
-  pin=0
-  do end=1,2
-  
-    do conductor=1,n_conductors
-    
-      pin=pin+1
-      ypin=ymax_symbol-ymax_offset-(conductor-1)*y_conductor_spacing
-      
-      string1='pinnumber='
-      CALL add_integer_to_string(string1,pin,pinnumber_string)
-      
-      string1='pinseq='
-      CALL add_integer_to_string(string1,pin,pinseq_string)
-
-      string1='pinlabel=c_'      
-      CALL add_integer_to_string(string1,conductor,string2)
-      string1=trim(string2)//'_e_'
-      CALL add_integer_to_string(string1,end,pinlabel_string)
-      
-      write(symbol_file_unit,'(A,4I6,A)')'P ',xpin1(end),ypin,xpin2(end),ypin,' 1 0 0'
-      write(symbol_file_unit,'(A)')'{'
-      write(symbol_file_unit,'(A)')'T 150 250   5 8 0 0 0 6 1'
-      write(symbol_file_unit,'(A)')trim(pinnumber_string)
-      write(symbol_file_unit,'(A)')'T 150 150   5 8 0 0 0 8 1'
-      write(symbol_file_unit,'(A)')trim(pinseq_string)
-      write(symbol_file_unit,'(A,2I6,A,I3,A)')'T ',xpin_label(end),ypin,' 9 6 1 1 0 ',align_label(end),' 1'
-      write(symbol_file_unit,'(A)')trim(pinlabel_string)
-      write(symbol_file_unit,'(A)')'T 200 200   5 8 0 0 0 2 1'
-      write(symbol_file_unit,'(A)')'pintype=pas'
-      write(symbol_file_unit,'(A)')'}'
-    
-    end do ! next conductor
-    
-  end do ! other cable end
-  
-!  spice_subcircuit_filename=trim(MOD_spice_bundle_lib_dir)//trim(spice_bundle_model%spice_model_name)//spice_model_file_extn
-  spice_subcircuit_filename='PATH_TO_TRANSMISSION_LINE_SUB_CIRCUITS/'//  &
-                            trim(spice_bundle_model%spice_model_name)//spice_model_file_extn
-  
-! write the general circuit symbol information
-  write(symbol_file_unit,'(A,2I6,A)')'T ',(xmin_symbol+xmax_symbol)/2,ymax_symbol+2*ymax_text_offset,' 8 10 1 1 0 4 1'
-  string1='device='//trim(spice_bundle_model%spice_model_name)  
-  write(symbol_file_unit,'(A)')trim(string1)
-  
-  write(symbol_file_unit,'(A,2I6,A)')'T ',(xmin_symbol+xmax_symbol)/2,ymax_symbol+ymax_text_offset,' 5 10 1 0 0 4 1'
-  write(symbol_file_unit,'(A)')'refdes=X?'
-
-  write(symbol_file_unit,'(A,2I6,A)')'T ',xmin_symbol,ymin_symbol,' 8 10 0 0 0 4 1'
-  string1='description='//trim(spice_bundle_model%spice_model_name)  
-  write(symbol_file_unit,'(A)')trim(string1)
-
-  write(symbol_file_unit,'(A,2I6,A)')'T ',xmin_symbol,ymin_symbol,' 8 10 0 0 0 0 1'
-  string1='value='//trim(spice_bundle_model%spice_model_name)  
-  write(symbol_file_unit,'(A)')trim(string1)
-
-  write(symbol_file_unit,'(A,2I6,A)')'T ',xmin_symbol,ymin_symbol,' 8 10 0 0 0 0 1'
-  write(symbol_file_unit,'(A,A)')'file=',trim(spice_subcircuit_filename)
-
-  write(symbol_file_unit,'(A,2I6,A)')'T ',xmin_symbol,ymin_symbol,' 8 10 0 0 0 0 1'
-  write(symbol_file_unit,'(A)')'numslots=0'
-
-  write(symbol_file_unit,'(A,2I6,A)')'T ',xmin_symbol,ymin_symbol,' 8 10 0 0 0 0 1'
-  write(symbol_file_unit,'(A)')'symversion=0.1'
-  
-! close the symbol file
-
-  CLOSE(unit=symbol_file_unit)
-
-  if (verbose) write(*,*)'Closed file:',trim(filename)
-
-  RETURN
-
-END SUBROUTINE create_spice_subcircuit_symbol_Pspice
--
libgit2 0.21.2