[hamradio-commits] [nec2c] 02/08: Imported Upstream version 0.8
Dave Hibberd
hibby-guest at moszumanska.debian.org
Sun Feb 15 00:35:20 UTC 2015
This is an automated email from the git hooks/post-receive script.
hibby-guest pushed a commit to branch master
in repository nec2c.
commit d5f2f12473e7e52b9f9f45eac9cc2719dff79aa2
Author: Dave Hibberd <d at vehibberd.com>
Date: Sat Feb 14 22:55:15 2015 +0000
Imported Upstream version 0.8
---
AUTHORS | 2 +
COPYING | 1 +
Makefile | 26 +
NEC2-bug.txt | 114 +++
README | 168 ++++
calculations.c | 1536 ++++++++++++++++++++++++++++++++++++
fields.c | 1754 +++++++++++++++++++++++++++++++++++++++++
geometry.c | 2409 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ground.c | 346 ++++++++
input.c | 438 +++++++++++
main.c | 2027 +++++++++++++++++++++++++++++++++++++++++++++++
matrix.c | 1497 +++++++++++++++++++++++++++++++++++
misc.c | 214 +++++
nec2c.h | 548 +++++++++++++
network.c | 636 +++++++++++++++
radiation.c | 1043 ++++++++++++++++++++++++
somnec.c | 1026 ++++++++++++++++++++++++
17 files changed, 13785 insertions(+)
diff --git a/AUTHORS b/AUTHORS
new file mode 100644
index 0000000..9b094ff
--- /dev/null
+++ b/AUTHORS
@@ -0,0 +1,2 @@
+Neoklis Kyriazis
+Ham Radio Call: 5B4AZ
diff --git a/COPYING b/COPYING
new file mode 120000
index 0000000..0b6cbf8
--- /dev/null
+++ b/COPYING
@@ -0,0 +1 @@
+/usr/share/automake-1.10/COPYING
\ No newline at end of file
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..47b30c2
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,26 @@
+#Makefile for nec2c 21 Aug 2003
+
+SHELL = /bin/sh
+PROJECT = nec2c
+BINDIR = /usr/local/bin
+CC = gcc -Wall -O2 -march=native
+
+objects = calculations.o fields.o geometry.o ground.o input.o \
+ main.o matrix.o misc.o network.o radiation.o somnec.o
+
+$(PROJECT) : $(objects)
+ $(CC) -lm -o $(PROJECT) $(objects)
+
+$(objects) : nec2c.h
+
+nec2dx :
+ g77 -o nec2dx nec2dx.f
+ install -m 755 --strip nec2dx $(BINDIR)
+
+install : $(PROJECT)
+ install -m 755 $(PROJECT) $(BINDIR)
+
+.PHONY : distclean
+distclean :
+ -rm -f *.o *~ $(PROJECT) nec2dx
+
diff --git a/NEC2-bug.txt b/NEC2-bug.txt
new file mode 100644
index 0000000..ea2f857
--- /dev/null
+++ b/NEC2-bug.txt
@@ -0,0 +1,114 @@
+You are right, there is a bug in NEC-2 when the extended thin-wire
+kernel is used with wires connected to patches. This has escaped
+detection for over 20 years. I did not catch it yesterday, because I
+had MAXSEG=10000, and ICON1 and ICON2 are dimensioned to 2*MAXSEG, so
+10000 did not exceed the bound.
+
+The problem can be fixed as shown below. In addition to subroutine
+CMWW, where you encountered the problem, the same changes need to be
+made in subroutines NEFLD and QDSRC. With this change the extended
+kernel is not used at a wire end connected to a patch surface, but
+would be used on the rest of the wire if it is straight .
+
+The extended thin-wire kernel is only used on thick, straight wires,
+so is not very useful. The code turns it off at junctions, bends and
+changes in radius. Also, the connection of a wire to a patch surface
+is not good in NEC-2 or 4. It works fairly well for something like a
+monopole on a surface, but not for a half loop connected to the
+surface. A wire grid surface provides a better connection for a wire
+antenna.
+
+NEC-4 does not have the extended kernel, but instead puts the current
+on the wire surface with match points on the axis, and has an
+approximation for wire end caps that reduces the instability when the
+segment length to radius ratio is small. So NEC-4 would not have
+this problem.
+
+Thanks for finding this bug.
+
+Jerry Burke
+LLNL
+
+
+
+
+To fix the extended thin-wire kernel with patches in NEC-2:
+
+ SUBROUTINE CMWW (J,I1,I2,CM,NR,CW,NW,ITRP)
+ .
+ .
+C DECIDE WETHER EXT. T.W. APPROX. CAN BE USED
+ IPR=ICON1(J)
+ IF(IPR.GT.10000)GO TO 5 !<---NEW
+ IF (IPR) 1,6,2
+1 IPR=-IPR
+ IF (-ICON1(IPR).NE.J) GO TO 7
+ GO TO 4
+2 IF (IPR.NE.J) GO TO 3
+ IF (CABJ*CABJ+SABJ*SABJ.GT.1.D-8) GO TO 7
+ GO TO 5
+3 IF (ICON2(IPR).NE.J) GO TO 7
+4 XI=ABS(CABJ*CAB(IPR)+SABJ*SAB(IPR)+SALPJ*SALP(IPR))
+ IF (XI.LT.0.999999D+0) GO TO 7
+ IF (ABS(BI(IPR)/B-1.).GT.1.D-6) GO TO 7
+5 IND1=0
+ GO TO 8
+6 IND1=1
+ GO TO 8
+7 IND1=2
+8 IPR=ICON2(J)
+ IF(IPR.GT.10000)GO TO 15 !<---NEW
+ IF (IPR) 9,14,10
+
+
+ SUBROUTINE NEFLD (XOB,YOB,ZOB,EX,EY,EZ)
+ .
+ .
+ IPR=ICON1(I)
+ IF(IPR.GT.10000)GO TO 9 !<---NEW
+ IF (IPR) 3,8,4
+3 IPR=-IPR
+ IF (-ICON1(IPR).NE.I) GO TO 9
+ GO TO 6
+4 IF (IPR.NE.I) GO TO 5
+ IF (CABJ*CABJ+SABJ*SABJ.GT.1.D-8) GO TO 9
+ GO TO 7
+5 IF (ICON2(IPR).NE.I) GO TO 9
+6 XI=ABS(CABJ*CAB(IPR)+SABJ*SAB(IPR)+SALPJ*SALP(IPR))
+ IF (XI.LT.0.999999D+0) GO TO 9
+ IF (ABS(BI(IPR)/B-1.).GT.1.D-6) GO TO 9
+7 IND1=0
+ GO TO 10
+8 IND1=1
+ GO TO 10
+9 IND1=2
+10 IPR=ICON2(I)
+ IF(IPR.GT.10000)GO TO 17 !<---NEW
+ IF (IPR) 11,16,12
+
+
+ SUBROUTINE QDSRC (IS,V,E)
+ .
+ .
+ IPR=ICON1(J)
+ IF(IPR.GT.10000)GO TO 7 !<---NEW
+ IF (IPR) 1,6,2
+1 IPR=-IPR
+ IF (-ICON1(IPR).NE.J) GO TO 7
+ GO TO 4
+2 IF (IPR.NE.J) GO TO 3
+ IF (CABJ*CABJ+SABJ*SABJ.GT.1.D-8) GO TO 7
+ GO TO 5
+3 IF (ICON2(IPR).NE.J) GO TO 7
+4 XI=ABS(CABJ*CAB(IPR)+SABJ*SAB(IPR)+SALPJ*SALP(IPR))
+ IF (XI.LT.0.999999D+0) GO TO 7
+ IF (ABS(BI(IPR)/B-1.).GT.1.D-6) GO TO 7
+5 IND1=0
+ GO TO 8
+6 IND1=1
+ GO TO 8
+7 IND1=2
+8 IPR=ICON2(J)
+ IF(IPR.GT.10000)GO TO 15 !<---NEW
+ IF (IPR) 9,14,10
+
diff --git a/README b/README
new file mode 100755
index 0000000..0ac41e7
--- /dev/null
+++ b/README
@@ -0,0 +1,168 @@
+
+ README File for nec2c
+
+ 1. INTRODUCTION:
+ nec2c is a translation of the NEC2 FORTRAN source code to the C language.
+ The translation was performed mostly "by hand" and a lot of modifications
+ to the original program were introduced in order to modernize the NEC2
+ and to remove as many built-in limitations as possible. The attendant
+ SOMNEC program was also translated to C and incorporated in nec2c as a
+ function so that Sommerfeld ground solutions are a part of the program.
+
+ 2. CHANGES:
+ The following is a list of the more significant changes incorporated into
+ nec2c during translation from FORTRAN to C:
+
+ * All GO TO constructs have been removed (all 961 of them!) and "spaghetti"
+ code sections untangled as far as was possible to the author. Still, a lot
+ of the code is not as clean and straightforward as might have been.
+
+ * Obsolete memory-saving practices (such as "equivalences" of different
+ variables) have been eliminated and memory-sharing variables have been
+ separated so that they are independent.
+
+ * All fixed-size arrays used in calculations have been replaced with
+ buffer pointers which are allocated memory dynamically according to the
+ needs of the program and the complexity of each structure's geometry.
+ There is a two-fold advantage in this - there is virtually no limit to
+ the complexity of a structure (number of segments/patches etc), and there
+ is no wasted memory in fixed arrays. Additionally, there is no need for
+ data storage/swapping between memory and files and therefore functions
+ relating to this activity and also the NGF form of solution have been
+ removed from the program.
+
+ * When a Sommerfeld finite ground solution is requested, since the
+ SOMNEC program has been incorporated in nec2c there is no need to store
+ the ground grid data in a file and read it when running nec2c. Instead,
+ ground grid data are calculated as needed and for each new frequency if
+ frequency stepping is specified.
+
+ * The factr() and solve() functions have been modified to handle the
+ main matrix (cm) in untransposed form so that calculations are faster.
+
+ * The parser that reads the input file allows the two characters of the
+ mnemonic to be in lower case if preferred. It also allows comments to be
+ inserted anywhere in the input file in Unix style, e.g. all lines
+ beginning with a '#' are ignored.
+
+ * Operationally, nec2c differs from NEC2 in not being an interactive
+ application. Instead, nec2c is a non-interactive command-line application
+ which accepts an input file name and optionally an output file name.
+ If this is not specified, a name for the output file is made by stripping
+ any extensions from the input file name and adding a ".out" extension.
+ Furthermore, nec2c has the potential of being incorporated in another
+ application (like a GUI) after suitable modifications, allowing the
+ creation of a stand-alone program without the need for reading files
+ produced separately.
+
+ * My original motive for translating NEC2 into C was to make it easier
+ to modify and modernize and to change obsolete functions and usage. As
+ a result I have edited to some extend the format of the output file to
+ make it more "human readable" (e.g. provided a single space between
+ adjacent numbers to avoid a hard-to-read "chain" of numbers joined by
+ - signs) etc. In my humble opinion these changes make the output file
+ easier to read and possibly somewhat more presentable, although this is
+ likely to be a problem with applications that read the output file in a
+ rigid manner, based on the exact output format. I apologize for this
+ change if it causes such problems but my intention is to eventually
+ modify nec2c to be used as part of a graphical application, providing
+ results for graphical plots directly in its buffers.
+
+ 3. COMPILATION:
+ The nec2c package is very simple at this time and compilation basically
+ only requires a Linux platform with development tools installed (gcc,
+ make and optionally gdb and "valgrind" for debugging). To compile the
+ source code just type "make nec2c" in the nec2c directory and if all is
+ well an executable binary (nec2c) should be produced. If gdb is not
+ installed, remove the -g option from the line in Makefile the reads:
+ CC = gcc -Wall -O3 -g
+
+ These changes can also be made if debugging is not of interest, thereby
+ reducing the size of the binary and speeding it as well. If desired,
+ nec2c can be installed (to /usr/local/bin) with "make install".
+
+ There is a double precision FORTRAN source (nec2dx.f) in this package
+ and this can be compiled and installed by typing "make nec2dx" in the
+ nec2c directory. It can be run by typing nec2dx and supplying an input
+ and output file name and it may be used to check nec2c's results for
+ bugs etc.
+
+ 4. USAGE: nec2c is run as a non-interactive command-line application
+ and is invoked in the following manner:
+ nec2c -i<input-file-name> [-o<output-file-name>][-hv]
+ -h: print this usage information and exit.
+ -v: print nec2c version number and exit.
+
+ The -i option is always needed and it specifies the name of the input
+ file. The -o switch is optional and it specifies the output file name.
+ If not used, a name for the output file is made by stripping any
+ extensions from the input file name and adding a ".out" extension, e.g.
+ nec2c -i yagi.nec will cause nec2c to read yagi.nec as the input file
+ and produce yagi.out as the output file.
+
+ 5. BUGS!!
+ Translating such a complex and large program from FORTRAN to C and making
+ so many changes along the way is very prone to bugs in the new program.
+ I have fixed a lot of these by using various input files that hopefully
+ invoke most if not all of NEC2's functions but there must still be bugs
+ in nec2c that will surface with some specific combinations of "cards" in
+ some input file. The best way to check nec2c's results is to run nec2dx
+ with the same input file and compare results - there should be very close
+ agreement between them as nec2dx is also double-precision.
+
+ 6. Version history:
+ Version 0.1 beta: First release of the translated NEC2
+
+ Version 0.2: I used the "valgrind" (http://valgrind.kde.org)
+ tool to check nec2c and found two significant bugs in intrp() and
+ subph() which I (hopefully!) have fixed. I also fixed another bug
+ that was found by Tim Molteno in the netwk() routine.
+
+ If you intend to use valgrind (recommended!) to test nec2c for bugs
+ (mainly memory allocation/access errors) then do not use performance
+ enhancing C flags (e.g. do not use -Ox flags etc) otherwise you will get
+ false error reports.
+
+ Version 0.3: I have split nec2c.c into a number of smaller files to
+ make it easier to work on during bug-fixing or development.
+
+ Version 0.4: Fixed a bug in conect that caused segmentation faults
+ when only one wire segment exists in the structure. this is a case that
+ will probably never exist in practice but the seg fault had to be
+ fixed.
+
+ Version 0.5: Replaced the cmplx() function with a macro to speed up
+ calculations. Changed the fbar() and zint() functions from complex
+ long double to void type and returned the calculated values via a
+ pointer in the argument list. This was done to work around a bug I
+ could never trace, possibly due to gcc itself, were functions of the
+ complex long double type produce a NAN result on return.
+
+ Version 0.6: Fixed a bug inherited from the original NEC2 FORTRAN
+ code. Please see NEC2-bug.txt for details.
+
+ Version 0.7: After a bug report from Juha Vierinen regarding seg
+ faulting of xnec2c, my graphical adaptation of NEC2, I changed
+ all "sprintf" commands to "snprintf" to avoid buffer overruns.
+ Following on the above changes, I revised all similar situations
+ in nec2c source code and changed all "sprintf" commands to
+ "snprintf" just in case. While going through the nec2c source
+ code, I also fixed some minor bugs like typos and tidied error
+ messages.
+
+ Version 0.8: After a segmentation fault bug report, I fixed the
+ netwk() function in network.c to allow allocation of the ipnt buffer
+ when maximum admittance matrix asymmetry printing is requested in the
+ Ex card.
+
+ 7. License:
+ nec2c is Public Domain, same as the original FORTRAN source.
+ Please keep any software you write incorporating nec2c in Public Domain
+ or at least use an open license like GPL or BSD.
+
+ 8. AUTHOR:
+
+ Neoklis Kyriazis
+
+ January 27 2004
+
diff --git a/calculations.c b/calculations.c
new file mode 100644
index 0000000..6526ece
--- /dev/null
+++ b/calculations.c
@@ -0,0 +1,1536 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+ ******************************************************************/
+
+#include "nec2c.h"
+
+/* common /tmi/ */
+extern tmi_t tmi;
+
+/*common /ggrid/ */
+extern ggrid_t ggrid;
+
+/* common /data/ */
+extern data_t data;
+
+/* common /crnt/ */
+extern crnt_t crnt;
+
+/* common /vsorc/ */
+extern vsorc_t vsorc;
+
+/* common /segj/ */
+extern segj_t segj;
+
+/* common /yparm/ */
+extern yparm_t yparm;
+
+/* common /zload/ */
+extern zload_t zload;
+
+/* common /smat/ */
+extern smat_t smat;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/*-----------------------------------------------------------------------*/
+
+/* cabc computes coefficients of the constant (a), sine (b), and */
+/* cosine (c) terms in the current interpolation functions for the */
+/* current vector cur. */
+void cabc( complex long double *curx)
+{
+ int i, is, j, jx, jco1, jco2;
+ long double ar, ai, sh;
+ complex long double curd, cs1, cs2;
+
+ if( data.n != 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ crnt.air[i]=0.;
+ crnt.aii[i]=0.;
+ crnt.bir[i]=0.;
+ crnt.bii[i]=0.;
+ crnt.cir[i]=0.;
+ crnt.cii[i]=0.;
+ }
+
+ for( i = 0; i < data.n; i++ )
+ {
+ ar= creall( curx[i]);
+ ai= cimagl( curx[i]);
+ tbf( i+1, 1 );
+
+ for( jx = 0; jx < segj.jsno; jx++ )
+ {
+ j= segj.jco[jx]-1;
+ crnt.air[j] += segj.ax[jx]* ar;
+ crnt.aii[j] += segj.ax[jx]* ai;
+ crnt.bir[j] += segj.bx[jx]* ar;
+ crnt.bii[j] += segj.bx[jx]* ai;
+ crnt.cir[j] += segj.cx[jx]* ar;
+ crnt.cii[j] += segj.cx[jx]* ai;
+ }
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ if( vsorc.nqds != 0)
+ {
+ for( is = 0; is < vsorc.nqds; is++ )
+ {
+ i= vsorc.iqds[is]-1;
+ jx= data.icon1[i];
+ data.icon1[i]=0;
+ tbf(i+1,0);
+ data.icon1[i]= jx;
+ sh= data.si[i]*.5;
+ curd= CCJ* vsorc.vqds[is]/( (logl(2.* sh/ data.bi[i])-1.)*
+ (segj.bx[segj.jsno-1]* cosl(TP* sh)+ segj.cx[segj.jsno-1]*
+ sinl(TP* sh))* data.wlam );
+ ar= creall( curd);
+ ai= cimagl( curd);
+
+ for( jx = 0; jx < segj.jsno; jx++ )
+ {
+ j= segj.jco[jx]-1;
+ crnt.air[j]= crnt.air[j]+ segj.ax[jx]* ar;
+ crnt.aii[j]= crnt.aii[j]+ segj.ax[jx]* ai;
+ crnt.bir[j]= crnt.bir[j]+ segj.bx[jx]* ar;
+ crnt.bii[j]= crnt.bii[j]+ segj.bx[jx]* ai;
+ crnt.cir[j]= crnt.cir[j]+ segj.cx[jx]* ar;
+ crnt.cii[j]= crnt.cii[j]+ segj.cx[jx]* ai;
+ }
+
+ } /* for( is = 0; is < vsorc.nqds; is++ ) */
+
+ } /* if( vsorc.nqds != 0) */
+
+ for( i = 0; i < data.n; i++ )
+ curx[i]= cmplx( crnt.air[i]+crnt.cir[i], crnt.aii[i]+crnt.cii[i] );
+
+ } /* if( n != 0) */
+
+ if( data.m == 0)
+ return;
+
+ /* convert surface currents from */
+ /* t1,t2 components to x,y,z components */
+ jco1= data.np2m;
+ jco2= jco1+ data.m;
+ for( i = 1; i <= data.m; i++ )
+ {
+ jco1 -= 2;
+ jco2 -= 3;
+ cs1= curx[jco1];
+ cs2= curx[jco1+1];
+ curx[jco2] = cs1* data.t1x[data.m-i]+ cs2* data.t2x[data.m-i];
+ curx[jco2+1]= cs1* data.t1y[data.m-i]+ cs2* data.t2y[data.m-i];
+ curx[jco2+2]= cs1* data.t1z[data.m-i]+ cs2* data.t2z[data.m-i];
+ }
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* couple computes the maximum coupling between pairs of segments. */
+void couple( complex long double *cur, long double wlam )
+{
+ int j, j1, j2, l1, i, k, itt1, itt2, its1, its2, isg1, isg2, npm1;
+ long double dbc, c, gmax;
+ complex long double y11, y12, y22, yl, yin, zl, zin, rho;
+
+ if( (vsorc.nsant != 1) || (vsorc.nvqd != 0) )
+ return;
+
+ j= isegno( yparm.nctag[yparm.icoup], yparm.ncseg[yparm.icoup]);
+ if( j != vsorc.isant[0] )
+ return;
+
+ zin= vsorc.vsant[0];
+ yparm.icoup++;
+ mem_realloc( (void *)&yparm.y11a, yparm.icoup * sizeof( complex long double) );
+ yparm.y11a[yparm.icoup-1]= cur[j-1]*wlam/zin;
+
+ l1=(yparm.icoup-1)*(yparm.ncoup-1);
+ for( i = 0; i < yparm.ncoup; i++ )
+ {
+ if( (i+1) == yparm.icoup)
+ continue;
+
+ l1++;
+ mem_realloc( (void *)&yparm.y12a, l1 * sizeof( complex long double) );
+ k= isegno( yparm.nctag[i], yparm.ncseg[i]);
+ yparm.y12a[l1-1]= cur[k-1]* wlam/ zin;
+ }
+
+ if( yparm.icoup < yparm.ncoup)
+ return;
+
+ fprintf( output_fp, "\n\n\n"
+ " -----------"
+ " ISOLATION DATA -----------\n\n"
+ " ------- COUPLING BETWEEN ------ MAXIMUM "
+ " ---------- FOR MAXIMUM COUPLING ----------\n"
+ " SEG SEG COUPLING LOAD"
+ " IMPEDANCE (2ND SEG) INPUT IMPEDANCE \n"
+ " TAG SEG No: TAG SEG No: (DB) "
+ " REAL IMAGINARY REAL IMAGINARY" );
+
+ npm1= yparm.ncoup-1;
+
+ for( i = 0; i < npm1; i++ )
+ {
+ itt1= yparm.nctag[i];
+ its1= yparm.ncseg[i];
+ isg1= isegno( itt1, its1);
+ l1= i+1;
+
+ for( j = l1; j < yparm.ncoup; j++ )
+ {
+ itt2= yparm.nctag[j];
+ its2= yparm.ncseg[j];
+ isg2= isegno( itt2, its2);
+ j1= j+ i* npm1-1;
+ j2= i+ j* npm1;
+ y11= yparm.y11a[i];
+ y22= yparm.y11a[j];
+ y12=.5*( yparm.y12a[j1]+ yparm.y12a[j2]);
+ yin= y12* y12;
+ dbc= cabsl( yin);
+ c= dbc/(2.* creall( y11)* creall( y22)- creall( yin));
+
+ if( (c >= 0.0) && (c <= 1.0) )
+ {
+ if( c >= .01 )
+ gmax=(1.- sqrtl(1.- c*c))/c;
+ else
+ gmax=.5*( c+.25* c* c* c);
+
+ rho= gmax* conjl( yin)/ dbc;
+ yl=((1.- rho)/(1.+ rho)+1.)* creall( y22)- y22;
+ zl=1./ yl;
+ yin= y11- yin/( y22+ yl);
+ zin=1./ yin;
+ dbc= db10( gmax);
+
+ fprintf( output_fp, "\n"
+ " %4d %4d %5d %4d %4d %5d %9.3LF"
+ " %12.5LE %12.5LE %12.5LE %12.5LE",
+ itt1, its1, isg1, itt2, its2, isg2, dbc,
+ creall(zl), cimagl(zl), creall(zin), cimagl(zin) );
+
+ continue;
+
+ } /* if( (c >= 0.0) && (c <= 1.0) ) */
+
+ fprintf( output_fp, "\n"
+ " %4d %4d %5d %4d %4d %5d **ERROR** "
+ "COUPLING IS NOT BETWEEN 0 AND 1. (= %12.5LE)",
+ itt1, its1, isg1, itt2, its2, isg2, c );
+
+ } /* for( j = l1; j < yparm.ncoup; j++ ) */
+
+ } /* for( i = 0; i < npm1; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* load calculates the impedance of specified */
+/* segments for various types of loading */
+void load( int *ldtyp, int *ldtag, int *ldtagf, int *ldtagt,
+ long double *zlr, long double *zli, long double *zlc )
+{
+ int i, iwarn, istep, istepx, l1, l2, ldtags, jump, ichk;
+ complex long double zt=CPLX_00, tpcj;
+
+ tpcj = (0.0+1.883698955e+9fj);
+ fprintf( output_fp, "\n"
+ " LOCATION RESISTANCE INDUCTANCE CAPACITANCE "
+ " IMPEDANCE (OHMS) CONDUCTIVITY CIRCUIT\n"
+ " ITAG FROM THRU OHMS HENRYS FARADS "
+ " REAL IMAGINARY MHOS/METER TYPE" );
+
+ /* initialize d array, used for temporary */
+ /* storage of loading information. */
+ mem_realloc( (void *)&zload.zarray, data.npm * sizeof(complex long double) );
+ for( i = 0; i < data.n; i++ )
+ zload.zarray[i]=CPLX_00;
+
+ iwarn=FALSE;
+ istep=0;
+
+ /* cycle over loading cards */
+ while( TRUE )
+ {
+ istepx = istep;
+ istep++;
+
+ if( istep > zload.nload)
+ {
+ if( iwarn == TRUE )
+ fprintf( output_fp,
+ "\n NOTE, SOME OF THE ABOVE SEGMENTS "
+ "HAVE BEEN LOADED TWICE - IMPEDANCES ADDED" );
+
+ smat.nop = data.n/data.np;
+ if( smat.nop == 1)
+ return;
+
+ for( i = 0; i < data.np; i++ )
+ {
+ zt= zload.zarray[i];
+ l1= i;
+
+ for( l2 = 1; l2 < smat.nop; l2++ )
+ {
+ l1 += data.np;
+ zload.zarray[l1]= zt;
+ }
+ }
+ return;
+
+ } /* if( istep > zload.nload) */
+
+ if( ldtyp[istepx] > 5 )
+ {
+ fprintf( output_fp,
+ "\n IMPROPER LOAD TYPE CHOSEN,"
+ " REQUESTED TYPE IS %d", ldtyp[istepx] );
+ stop(-1);
+ }
+
+ /* search segments for proper itags */
+ ldtags= ldtag[istepx];
+ jump= ldtyp[istepx]+1;
+ ichk=0;
+ l1= 1;
+ l2= data.n;
+
+ if( ldtags == 0)
+ {
+ if( (ldtagf[istepx] != 0) || (ldtagt[istepx] != 0) )
+ {
+ l1= ldtagf[istepx];
+ l2= ldtagt[istepx];
+
+ } /* if( (ldtagf[istepx] != 0) || (ldtagt[istepx] != 0) ) */
+
+ } /* if( ldtags == 0) */
+
+ for( i = l1-1; i < l2; i++ )
+ {
+ if( ldtags != 0)
+ {
+ if( ldtags != data.itag[i])
+ continue;
+
+ if( ldtagf[istepx] != 0)
+ {
+ ichk++;
+ if( (ichk < ldtagf[istepx]) || (ichk > ldtagt[istepx]) )
+ continue;
+ }
+ else
+ ichk=1;
+
+ } /* if( ldtags != 0) */
+ else
+ ichk=1;
+
+ /* calculation of lamda*imped. per unit length, */
+ /* jump to appropriate section for loading type */
+ switch( jump )
+ {
+ case 1:
+ zt= zlr[istepx]/ data.si[i]+ tpcj* zli[istepx]/( data.si[i]* data.wlam);
+ if( fabsl( zlc[istepx]) > 1.0e-20)
+ zt += data.wlam/( tpcj* data.si[i]* zlc[istepx]);
+ break;
+
+ case 2:
+ zt= tpcj* data.si[i]* zlc[istepx]/ data.wlam;
+ if( fabsl( zli[istepx]) > 1.0e-20)
+ zt += data.si[i]* data.wlam/( tpcj* zli[istepx]);
+ if( fabsl( zlr[istepx]) > 1.0e-20)
+ zt += data.si[i]/ zlr[istepx];
+ zt=1./ zt;
+ break;
+
+ case 3:
+ zt= zlr[istepx]* data.wlam+ tpcj* zli[istepx];
+ if( fabsl( zlc[istepx]) > 1.0e-20)
+ zt += 1./( tpcj* data.si[i]* data.si[i]* zlc[istepx]);
+ break;
+
+ case 4:
+ zt= tpcj* data.si[i]* data.si[i]* zlc[istepx];
+ if( fabsl( zli[istepx]) > 1.0e-20)
+ zt += 1./( tpcj* zli[istepx]);
+ if( fabsl( zlr[istepx]) > 1.0e-20)
+ zt += 1./( zlr[istepx]* data.wlam);
+ zt=1./ zt;
+ break;
+
+ case 5:
+ zt= cmplx( zlr[istepx], zli[istepx])/ data.si[i];
+ break;
+
+ case 6:
+ zint( zlr[istepx]* data.wlam, data.bi[i], &zt );
+
+ } /* switch( jump ) */
+
+ if(( fabsl( creall( zload.zarray[i]))+ fabsl( cimagl( zload.zarray[i]))) > 1.0e-20)
+ iwarn=TRUE;
+ zload.zarray[i] += zt;
+
+ } /* for( i = l1-1; i < l2; i++ ) */
+
+ if( ichk == 0 )
+ {
+ fprintf( output_fp,
+ "\n LOADING DATA CARD ERROR,"
+ " NO SEGMENT HAS AN ITAG = %d", ldtags );
+ stop(-1);
+ }
+
+ /* printing the segment loading data, jump to proper print */
+ switch( jump )
+ {
+ case 1:
+ prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
+ zli[istepx], zlc[istepx],0.,0.,0.," SERIES ", 2);
+ break;
+
+ case 2:
+ prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
+ zli[istepx], zlc[istepx],0.,0.,0.,"PARALLEL",2);
+ break;
+
+ case 3:
+ prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
+ zli[istepx], zlc[istepx],0.,0.,0., "SERIES (PER METER)", 5);
+ break;
+
+ case 4:
+ prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
+ zli[istepx], zlc[istepx],0.,0.,0.,"PARALLEL (PER METER)",5);
+ break;
+
+ case 5:
+ prnt( ldtags, ldtagf[istepx], ldtagt[istepx],0.,0.,0.,
+ zlr[istepx], zli[istepx],0.,"FIXED IMPEDANCE ",4);
+ break;
+
+ case 6:
+ prnt( ldtags, ldtagf[istepx], ldtagt[istepx],
+ 0.,0.,0.,0.,0., zlr[istepx]," WIRE ",2);
+
+ } /* switch( jump ) */
+
+ } /* while( TRUE ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* gf computes the integrand exp(jkr)/(kr) for numerical integration. */
+void gf( long double zk, long double *co, long double *si )
+{
+ long double zdk, rk, rks;
+
+ zdk= zk- tmi.zpk;
+ rk= sqrtl( tmi.rkb2+ zdk* zdk);
+ *si= sinl( rk)/ rk;
+
+ if( tmi.ij != 0 )
+ {
+ *co= cosl( rk)/ rk;
+ return;
+ }
+
+ if( rk >= .2)
+ {
+ *co=( cosl( rk)-1.)/ rk;
+ return;
+ }
+
+ rks= rk* rk;
+ *co=((-1.38888889e-3* rks+4.16666667e-2)* rks-.5)* rk;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* function db10 returns db for magnitude (field) */
+long double db10( long double x )
+{
+ if( x < 1.e-20 )
+ return( -999.99 );
+
+ return( 10. * log10l(x) );
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* function db20 returns db for mag**2 (power) i */
+long double db20( long double x )
+{
+ if( x < 1.e-20 )
+ return( -999.99 );
+
+ return( 20. * log10l(x) );
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* intrp uses bivariate cubic interpolation to obtain */
+/* the values of 4 functions at the point (x,y). */
+void intrp( long double x, long double y, complex long double *f1,
+ complex long double *f2, complex long double *f3, complex long double *f4 )
+{
+ static int ix, iy, ixs=-10, iys=-10, igrs=-10, ixeg=0, iyeg=0;
+ static int nxm2, nym2, nxms, nyms, nd, ndp;
+ int nda[3]={11,17,9}, ndpa[3]={110,85,72};
+ int igr, iadd, iadz, i, k, jump;
+ static long double dx = 1., dy = 1., xs = 0., ys = 0., xz, yz;
+ long double xx, yy;
+ static complex long double a[4][4], b[4][4], c[4][4], d[4][4];
+ complex long double p1=CPLX_00, p2=CPLX_00, p3=CPLX_00, p4=CPLX_00;
+ complex long double fx1, fx2, fx3, fx4;
+
+ jump = FALSE;
+ if( (x < xs) || (y < ys) )
+ jump = TRUE;
+ else
+ {
+ ix= (int)(( x- xs)/ dx)+1;
+ iy= (int)(( y- ys)/ dy)+1;
+ }
+
+ /* if point lies in same 4 by 4 point region */
+ /* as previous point, old values are reused. */
+ if( (ix < ixeg) ||
+ (iy < iyeg) ||
+ (abs(ix- ixs) >= 2) ||
+ (abs(iy- iys) >= 2) ||
+ jump )
+ {
+ /* determine correct grid and grid region */
+ if( x <= ggrid.xsa[1])
+ igr=0;
+ else
+ {
+ if( y > ggrid.ysa[2])
+ igr=2;
+ else
+ igr=1;
+ }
+
+ if( igr != igrs)
+ {
+ igrs= igr;
+ dx= ggrid.dxa[igrs];
+ dy= ggrid.dya[igrs];
+ xs= ggrid.xsa[igrs];
+ ys= ggrid.ysa[igrs];
+ nxm2= ggrid.nxa[igrs]-2;
+ nym2= ggrid.nya[igrs]-2;
+ nxms=(( nxm2+1)/3)*3+1;
+ nyms=(( nym2+1)/3)*3+1;
+ nd= nda[igrs];
+ ndp= ndpa[igrs];
+ ix= (int)(( x- xs)/ dx)+1;
+ iy= (int)(( y- ys)/ dy)+1;
+
+ } /* if( igr != igrs) */
+
+ ixs=(( ix-1)/3)*3+2;
+ if( ixs < 2)
+ ixs=2;
+ ixeg=-10000;
+
+ if( ixs > nxm2)
+ {
+ ixs= nxm2;
+ ixeg= nxms;
+ }
+
+ iys=(( iy-1)/3)*3+2;
+ if( iys < 2)
+ iys=2;
+ iyeg=-10000;
+
+ if( iys > nym2)
+ {
+ iys= nym2;
+ iyeg= nyms;
+ }
+
+ /* compute coefficients of 4 cubic polynomials in x for */
+ /* the 4 grid values of y for each of the 4 functions */
+ iadz= ixs+( iys-3)* nd- ndp;
+ for( k = 0; k < 4; k++ )
+ {
+ iadz += ndp;
+ iadd = iadz;
+
+ for( i = 0; i < 4; i++ )
+ {
+ iadd += nd;
+
+ switch( igrs )
+ {
+ case 0:
+ p1= ggrid.ar1[iadd-2];
+ p2= ggrid.ar1[iadd-1];
+ p3= ggrid.ar1[iadd];
+ p4= ggrid.ar1[iadd+1];
+ break;
+
+ case 1:
+ p1= ggrid.ar2[iadd-2];
+ p2= ggrid.ar2[iadd-1];
+ p3= ggrid.ar2[iadd];
+ p4= ggrid.ar2[iadd+1];
+ break;
+
+ case 2:
+ p1= ggrid.ar3[iadd-2];
+ p2= ggrid.ar3[iadd-1];
+ p3= ggrid.ar3[iadd];
+ p4= ggrid.ar3[iadd+1];
+
+ } /* switch( igrs ) */
+
+ a[i][k]=( p4- p1+3.*( p2- p3))*.1666666667;
+ b[i][k]=( p1-2.* p2+ p3)*.5;
+ c[i][k]= p3-(2.* p1+3.* p2+ p4)*.1666666667;
+ d[i][k]= p2;
+
+ } /* for( i = 0; i < 4; i++ ) */
+
+ } /* for( k = 0; k < 4; k++ ) */
+
+ xz=( ixs-1)* dx+ xs;
+ yz=( iys-1)* dy+ ys;
+
+ } /* if( (abs(ix- ixs) >= 2) || */
+
+ /* evaluate polymomials in x and use cubic */
+ /* interpolation in y for each of the 4 functions. */
+ xx=( x- xz)/ dx;
+ yy=( y- yz)/ dy;
+ fx1=(( a[0][0]* xx+ b[0][0])* xx+ c[0][0])* xx+ d[0][0];
+ fx2=(( a[1][0]* xx+ b[1][0])* xx+ c[1][0])* xx+ d[1][0];
+ fx3=(( a[2][0]* xx+ b[2][0])* xx+ c[2][0])* xx+ d[2][0];
+ fx4=(( a[3][0]* xx+ b[3][0])* xx+ c[3][0])* xx+ d[3][0];
+ p1= fx4- fx1+3.*( fx2- fx3);
+ p2=3.*( fx1-2.* fx2+ fx3);
+ p3=6.* fx3-2.* fx1-3.* fx2- fx4;
+ *f1=(( p1* yy+ p2)* yy+ p3)* yy*.1666666667+ fx2;
+ fx1=(( a[0][1]* xx+ b[0][1])* xx+ c[0][1])* xx+ d[0][1];
+ fx2=(( a[1][1]* xx+ b[1][1])* xx+ c[1][1])* xx+ d[1][1];
+ fx3=(( a[2][1]* xx+ b[2][1])* xx+ c[2][1])* xx+ d[2][1];
+ fx4=(( a[3][1]* xx+ b[3][1])* xx+ c[3][1])* xx+ d[3][1];
+ p1= fx4- fx1+3.*( fx2- fx3);
+ p2=3.*( fx1-2.* fx2+ fx3);
+ p3=6.* fx3-2.* fx1-3.* fx2- fx4;
+ *f2=(( p1* yy+ p2)* yy+ p3)* yy*.1666666667+ fx2;
+ fx1=(( a[0][2]* xx+ b[0][2])* xx+ c[0][2])* xx+ d[0][2];
+ fx2=(( a[1][2]* xx+ b[1][2])* xx+ c[1][2])* xx+ d[1][2];
+ fx3=(( a[2][2]* xx+ b[2][2])* xx+ c[2][2])* xx+ d[2][2];
+ fx4=(( a[3][2]* xx+ b[3][2])* xx+ c[3][2])* xx+ d[3][2];
+ p1= fx4- fx1+3.*( fx2- fx3);
+ p2=3.*( fx1-2.* fx2+ fx3);
+ p3=6.* fx3-2.* fx1-3.* fx2- fx4;
+ *f3=(( p1* yy+ p2)* yy+ p3)* yy*.1666666667+ fx2;
+ fx1=(( a[0][3]* xx+ b[0][3])* xx+ c[0][3])* xx+ d[0][3];
+ fx2=(( a[1][3]* xx+ b[1][3])* xx+ c[1][3])* xx+ d[1][3];
+ fx3=(( a[2][3]* xx+ b[2][3])* xx+ c[2][3])* xx+ d[2][3];
+ fx4=(( a[3][3]* xx+ b[3][3])* xx+ c[3][3])* xx+ d[3][3];
+ p1= fx4- fx1+3.*( fx2- fx3);
+ p2=3.*( fx1-2.* fx2+ fx3);
+ p3=6.* fx3-2.* fx1-3.* fx2- fx4;
+ *f4=(( p1* yy+ p2)* yy+ p3)* yy*.16666666670+ fx2;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* intx performs numerical integration of exp(jkr)/r by the method of */
+/* variable interval width romberg integration. the integrand value */
+/* is supplied by subroutine gf. */
+void intx( long double el1, long double el2, long double b,
+ int ij, long double *sgr, long double *sgi)
+{
+ int ns, nt;
+ int nx = 1, nma = 65536, nts = 4;
+ int flag = TRUE;
+ long double z, s, ze, fnm, ep, zend, fns, dz=0., zp, dzot=0., t00r, g1r, g5r, t00i;
+ long double g1i, g5i, t01r, g3r, t01i, g3i, t10r, t10i, te1i, te1r, t02r;
+ long double g2r, g4r, t02i, g2i, g4i, t11r, t11i, t20r, t20i, te2i, te2r;
+ long double rx = 1.0e-4;
+
+ z= el1;
+ ze= el2;
+ if( ij == 0)
+ ze=0.;
+ s= ze- z;
+ fnm= nma;
+ ep= s/(10.* fnm);
+ zend= ze- ep;
+ *sgr=0.;
+ *sgi=0.;
+ ns= nx;
+ nt=0;
+ gf( z, &g1r, &g1i);
+
+ while( TRUE )
+ {
+ if( flag )
+ {
+ fns= ns;
+ dz= s/ fns;
+ zp= z+ dz;
+
+ if( zp > ze)
+ {
+ dz= ze- z;
+ if( fabsl(dz) <= ep)
+ {
+ /* add contribution of near singularity for diagonal term */
+ if(ij == 0)
+ {
+ *sgr=2.*( *sgr+ logl(( sqrtl( b* b+ s* s)+ s)/ b));
+ *sgi=2.* *sgi;
+ }
+ return;
+ }
+
+ } /* if( zp > ze) */
+
+ dzot= dz*.5;
+ zp= z+ dzot;
+ gf( zp, &g3r, &g3i);
+ zp= z+ dz;
+ gf( zp, &g5r, &g5i);
+
+ } /* if( flag ) */
+
+ t00r=( g1r+ g5r)* dzot;
+ t00i=( g1i+ g5i)* dzot;
+ t01r=( t00r+ dz* g3r)*0.5;
+ t01i=( t00i+ dz* g3i)*0.5;
+ t10r=(4.0* t01r- t00r)/3.0;
+ t10i=(4.0* t01i- t00i)/3.0;
+
+ /* test convergence of 3 point romberg result. */
+ test( t01r, t10r, &te1r, t01i, t10i, &te1i, 0.);
+ if( (te1i <= rx) && (te1r <= rx) )
+ {
+ *sgr= *sgr+ t10r;
+ *sgi= *sgi+ t10i;
+ nt += 2;
+
+ z += dz;
+ if( z >= zend)
+ {
+ /* add contribution of near singularity for diagonal term */
+ if(ij == 0)
+ {
+ *sgr=2.*( *sgr+ logl(( sqrtl( b* b+ s* s)+ s)/ b));
+ *sgi=2.* *sgi;
+ }
+ return;
+ }
+
+ g1r= g5r;
+ g1i= g5i;
+ if( nt >= nts)
+ if( ns > nx)
+ {
+ /* Double step size */
+ ns= ns/2;
+ nt=1;
+ }
+ flag = TRUE;
+ continue;
+
+ } /* if( (te1i <= rx) && (te1r <= rx) ) */
+
+ zp= z+ dz*0.25;
+ gf( zp, &g2r, &g2i);
+ zp= z+ dz*0.75;
+ gf( zp, &g4r, &g4i);
+ t02r=( t01r+ dzot*( g2r+ g4r))*0.5;
+ t02i=( t01i+ dzot*( g2i+ g4i))*0.5;
+ t11r=(4.0* t02r- t01r)/3.0;
+ t11i=(4.0* t02i- t01i)/3.0;
+ t20r=(16.0* t11r- t10r)/15.0;
+ t20i=(16.0* t11i- t10i)/15.0;
+
+ /* test convergence of 5 point romberg result. */
+ test( t11r, t20r, &te2r, t11i, t20i, &te2i, 0.);
+ if( (te2i > rx) || (te2r > rx) )
+ {
+ nt=0;
+ if( ns >= nma)
+ fprintf( output_fp, "\n STEP SIZE LIMITED AT Z= %10.5LF", z );
+ else
+ {
+ /* halve step size */
+ ns= ns*2;
+ fns= ns;
+ dz= s/ fns;
+ dzot= dz*0.5;
+ g5r= g3r;
+ g5i= g3i;
+ g3r= g2r;
+ g3i= g2i;
+
+ flag = FALSE;
+ continue;
+ }
+
+ } /* if( (te2i > rx) || (te2r > rx) ) */
+
+ *sgr= *sgr+ t20r;
+ *sgi= *sgi+ t20i;
+ nt++;
+
+ z += dz;
+ if( z >= zend)
+ {
+ /* add contribution of near singularity for diagonal term */
+ if(ij == 0)
+ {
+ *sgr=2.*( *sgr+ logl(( sqrtl( b* b+ s* s)+ s)/ b));
+ *sgi=2.* *sgi;
+ }
+ return;
+ }
+
+ g1r= g5r;
+ g1i= g5i;
+ if( nt >= nts)
+ if( ns > nx)
+ {
+ /* Double step size */
+ ns= ns/2;
+ nt=1;
+ }
+ flag = TRUE;
+
+ } /* while( TRUE ) */
+
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* returns smallest of two arguments */
+int min( int a, int b )
+{
+ if( a < b )
+ return(a);
+ else
+ return(b);
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* test for convergence in numerical integration */
+void test( long double f1r, long double f2r, long double *tr,
+ long double f1i, long double f2i, long double *ti, long double dmin )
+{
+ long double den;
+
+ den= fabsl( f2r);
+ *tr= fabsl( f2i);
+
+ if( den < *tr)
+ den= *tr;
+ if( den < dmin)
+ den= dmin;
+
+ if( den < 1.0e-37)
+ {
+ *tr=0.;
+ *ti=0.;
+ return;
+ }
+
+ *tr= fabsl(( f1r- f2r)/ den);
+ *ti= fabsl(( f1i- f2i)/ den);
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute component of basis function i on segment is. */
+void sbf( int i, int is, long double *aa, long double *bb, long double *cc )
+{
+ int ix, jsno, june, jcox, jcoxx, jend, iend, njun1=0, njun2;
+ long double d, sig, pp, sdh, cdh, sd, omc, aj, pm=0, cd, ap, qp, qm, xxi;
+
+ *aa=0.;
+ *bb=0.;
+ *cc=0.;
+ june=0;
+ jsno=0;
+ pp=0.;
+ ix=i-1;
+
+ jcox= data.icon1[ix];
+ if( jcox > PCHCON) jcox= i;
+ jcoxx = jcox-1;
+
+ jend=-1;
+ iend=-1;
+ sig=-1.;
+
+ do
+ {
+ if( jcox != 0 )
+ {
+ if( jcox < 0 )
+ jcox=- jcox;
+ else
+ {
+ sig=- sig;
+ jend=- jend;
+ }
+
+ jcoxx = jcox-1;
+ jsno++;
+ d= PI* data.si[jcoxx];
+ sdh= sinl( d);
+ cdh= cosl( d);
+ sd=2.* sdh* cdh;
+
+ if( d <= 0.015)
+ {
+ omc=4.* d* d;
+ omc=((1.3888889e-3* omc -4.1666666667e-2)* omc +.5)* omc;
+ }
+ else
+ omc=1.- cdh* cdh+ sdh* sdh;
+
+ aj=1./( logl(1./( PI* data.bi[jcoxx]))-.577215664);
+ pp -= omc/ sd* aj;
+
+ if( jcox == is)
+ {
+ *aa= aj/ sd* sig;
+ *bb= aj/(2.* cdh);
+ *cc=- aj/(2.* sdh)* sig;
+ june= iend;
+ }
+
+ if( jcox != i )
+ {
+ if( jend != 1)
+ jcox= data.icon1[jcoxx];
+ else
+ jcox= data.icon2[jcoxx];
+
+ if( abs(jcox) != i )
+ {
+ if( jcox == 0 )
+ {
+ fprintf( output_fp,
+ "\n SBF - SEGMENT CONNECTION ERROR FOR SEGMENT %d", i);
+ stop(-1);
+ }
+ else
+ continue;
+ }
+
+ } /* if( jcox != i ) */
+ else
+ if( jcox == is)
+ *bb=- *bb;
+
+ if( iend == 1)
+ break;
+
+ } /* if( jcox != 0 ) */
+
+ pm=- pp;
+ pp=0.;
+ njun1= jsno;
+
+ jcox= data.icon2[ix];
+ if( jcox > PCHCON) jcox= i;
+
+ jend=1;
+ iend=1;
+ sig=-1.;
+
+ } /* do */
+ while( jcox != 0 );
+
+ njun2= jsno- njun1;
+ d= PI* data.si[ix];
+ sdh= sinl( d);
+ cdh= cosl( d);
+ sd=2.* sdh* cdh;
+ cd= cdh* cdh- sdh* sdh;
+
+ if( d <= 0.015)
+ {
+ omc=4.* d* d;
+ omc=((1.3888889e-3* omc -4.1666666667e-2)* omc +.5)* omc;
+ }
+ else
+ omc=1.- cd;
+
+ ap=1./( logl(1./( PI* data.bi[ix])) -.577215664);
+ aj= ap;
+
+ if( njun1 == 0)
+ {
+ if( njun2 == 0)
+ {
+ *aa =-1.;
+ qp= PI* data.bi[ix];
+ xxi= qp* qp;
+ xxi= qp*(1.-.5* xxi)/(1.- xxi);
+ *cc=1./( cdh- xxi* sdh);
+ return;
+ }
+
+ qp= PI* data.bi[ix];
+ xxi= qp* qp;
+ xxi= qp*(1.-.5* xxi)/(1.- xxi);
+ qp=-( omc+ xxi* sd)/( sd*( ap+ xxi* pp)+ cd*( xxi* ap- pp));
+
+ if( june == 1)
+ {
+ *aa=- *aa* qp;
+ *bb= *bb* qp;
+ *cc=- *cc* qp;
+ if( i != is)
+ return;
+ }
+
+ *aa -= 1.;
+ d = cd - xxi * sd;
+ *bb += (sdh + ap * qp * (cdh - xxi * sdh)) / d;
+ *cc += (cdh + ap * qp * (sdh + xxi * cdh)) / d;
+ return;
+
+ } /* if( njun1 == 0) */
+
+ if( njun2 == 0)
+ {
+ qm= PI* data.bi[ix];
+ xxi= qm* qm;
+ xxi= qm*(1.-.5* xxi)/(1.- xxi);
+ qm=( omc+ xxi* sd)/( sd*( aj- xxi* pm)+ cd*( pm+ xxi* aj));
+
+ if( june == -1)
+ {
+ *aa= *aa* qm;
+ *bb= *bb* qm;
+ *cc= *cc* qm;
+ if( i != is)
+ return;
+ }
+
+ *aa -= 1.;
+ d= cd- xxi* sd;
+ *bb += ( aj* qm*( cdh- xxi* sdh)- sdh)/ d;
+ *cc += ( cdh- aj* qm*( sdh+ xxi* cdh))/ d;
+ return;
+
+ } /* if( njun2 == 0) */
+
+ qp= sd*( pm* pp+ aj* ap)+ cd*( pm* ap- pp* aj);
+ qm=( ap* omc- pp* sd)/ qp;
+ qp=-( aj* omc+ pm* sd)/ qp;
+
+ if( june != 0 )
+ {
+ if( june < 0 )
+ {
+ *aa= *aa* qm;
+ *bb= *bb* qm;
+ *cc= *cc* qm;
+ }
+ else
+ {
+ *aa=- *aa* qp;
+ *bb= *bb* qp;
+ *cc=- *cc* qp;
+ }
+
+ if( i != is)
+ return;
+
+ } /* if( june != 0 ) */
+
+ *aa -= 1.;
+ *bb += ( aj* qm+ ap* qp)* sdh/ sd;
+ *cc += ( aj* qm- ap* qp)* cdh/ sd;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute basis function i */
+void tbf( int i, int icap )
+{
+ int ix, jcox, jcoxx, jend, iend, njun1=0, njun2, jsnop, jsnox;
+ long double pp, sdh, cdh, sd, omc, aj, pm=0, cd, ap, qp, qm, xxi;
+ long double d, sig; /*** also global ***/
+
+ segj.jsno=0;
+ pp=0.;
+ ix = i-1;
+ jcox= data.icon1[ix];
+
+ if( jcox > PCHCON) jcox= i;
+
+ jend=-1;
+ iend=-1;
+ sig=-1.;
+
+ do
+ {
+ if( jcox != 0 )
+ {
+ if( jcox < 0 )
+ jcox=- jcox;
+ else
+ {
+ sig=- sig;
+ jend=- jend;
+ }
+
+ jcoxx = jcox-1;
+ segj.jsno++;
+ jsnox = segj.jsno-1;
+ segj.jco[jsnox]= jcox;
+ d= PI* data.si[jcoxx];
+ sdh= sinl( d);
+ cdh= cosl( d);
+ sd=2.* sdh* cdh;
+
+ if( d <= 0.015)
+ {
+ omc=4.* d* d;
+ omc=((1.3888889e-3* omc-4.1666666667e-2)* omc+.5)* omc;
+ }
+ else
+ omc=1.- cdh* cdh+ sdh* sdh;
+
+ aj=1./( logl(1./( PI* data.bi[jcoxx]))-.577215664);
+ pp= pp- omc/ sd* aj;
+ segj.ax[jsnox]= aj/ sd* sig;
+ segj.bx[jsnox]= aj/(2.* cdh);
+ segj.cx[jsnox]=- aj/(2.* sdh)* sig;
+
+ if( jcox != i)
+ {
+ if( jend == 1)
+ jcox= data.icon2[jcoxx];
+ else
+ jcox= data.icon1[jcoxx];
+
+ if( abs(jcox) != i )
+ {
+ if( jcox != 0 )
+ continue;
+ else
+ {
+ fprintf( output_fp,
+ "\n TBF - SEGMENT CONNECTION ERROR FOR SEGMENT %5d", i );
+ stop(-1);
+ }
+ }
+
+ } /* if( jcox != i) */
+ else
+ segj.bx[jsnox] =- segj.bx[jsnox];
+
+ if( iend == 1)
+ break;
+
+ } /* if( jcox != 0 ) */
+
+ pm=- pp;
+ pp=0.;
+ njun1= segj.jsno;
+
+ jcox= data.icon2[ix];
+ if( jcox > PCHCON) jcox= i;
+
+ jend=1;
+ iend=1;
+ sig=-1.;
+
+ } /* do */
+ while( jcox != 0 );
+
+ njun2= segj.jsno- njun1;
+ jsnop= segj.jsno;
+ segj.jco[jsnop]= i;
+ d= PI* data.si[ix];
+ sdh= sinl( d);
+ cdh= cosl( d);
+ sd=2.* sdh* cdh;
+ cd= cdh* cdh- sdh* sdh;
+
+ if( d <= 0.015)
+ {
+ omc=4.* d* d;
+ omc=((1.3888889e-3* omc-4.1666666667e-2)* omc+.5)* omc;
+ }
+ else
+ omc=1.- cd;
+
+ ap=1./( logl(1./( PI* data.bi[ix]))-.577215664);
+ aj= ap;
+
+ if( njun1 == 0)
+ {
+ if( njun2 == 0)
+ {
+ segj.bx[jsnop]=0.;
+
+ if( icap == 0)
+ xxi=0.;
+ else
+ {
+ qp= PI* data.bi[ix];
+ xxi= qp* qp;
+ xxi= qp*(1.-.5* xxi)/(1.- xxi);
+ }
+
+ segj.cx[jsnop]=1./( cdh- xxi* sdh);
+ segj.jsno= jsnop+1;
+ segj.ax[jsnop]=-1.;
+ return;
+
+ } /* if( njun2 == 0) */
+
+ if( icap == 0)
+ xxi=0.;
+ else
+ {
+ qp= PI* data.bi[ix];
+ xxi= qp* qp;
+ xxi= qp*(1.-.5* xxi)/(1.- xxi);
+ }
+
+ qp=-( omc+ xxi* sd)/( sd*( ap+ xxi* pp)+ cd*( xxi* ap- pp));
+ d= cd- xxi* sd;
+ segj.bx[jsnop]=( sdh+ ap* qp*( cdh- xxi* sdh))/ d;
+ segj.cx[jsnop]=( cdh+ ap* qp*( sdh+ xxi* cdh))/ d;
+
+ for( iend = 0; iend < njun2; iend++ )
+ {
+ segj.ax[iend]=- segj.ax[iend]* qp;
+ segj.bx[iend]= segj.bx[iend]* qp;
+ segj.cx[iend]=- segj.cx[iend]* qp;
+ }
+
+ segj.jsno= jsnop+1;
+ segj.ax[jsnop]=-1.;
+ return;
+
+ } /* if( njun1 == 0) */
+
+ if( njun2 == 0)
+ {
+ if( icap == 0)
+ xxi=0.;
+ else
+ {
+ qm= PI* data.bi[ix];
+ xxi= qm* qm;
+ xxi= qm*(1.-.5* xxi)/(1.- xxi);
+ }
+
+ qm=( omc+ xxi* sd)/( sd*( aj- xxi* pm)+ cd*( pm+ xxi* aj));
+ d= cd- xxi* sd;
+ segj.bx[jsnop]=( aj* qm*( cdh- xxi* sdh)- sdh)/ d;
+ segj.cx[jsnop]=( cdh- aj* qm*( sdh+ xxi* cdh))/ d;
+
+ for( iend = 0; iend < njun1; iend++ )
+ {
+ segj.ax[iend]= segj.ax[iend]* qm;
+ segj.bx[iend]= segj.bx[iend]* qm;
+ segj.cx[iend]= segj.cx[iend]* qm;
+ }
+
+ segj.jsno= jsnop+1;
+ segj.ax[jsnop]=-1.;
+ return;
+
+ } /* if( njun2 == 0) */
+
+ qp= sd*( pm* pp+ aj* ap)+ cd*( pm* ap- pp* aj);
+ qm=( ap* omc- pp* sd)/ qp;
+ qp=-( aj* omc+ pm* sd)/ qp;
+ segj.bx[jsnop]=( aj* qm+ ap* qp)* sdh/ sd;
+ segj.cx[jsnop]=( aj* qm- ap* qp)* cdh/ sd;
+
+ for( iend = 0; iend < njun1; iend++ )
+ {
+ segj.ax[iend]= segj.ax[iend]* qm;
+ segj.bx[iend]= segj.bx[iend]* qm;
+ segj.cx[iend]= segj.cx[iend]* qm;
+ }
+
+ jend= njun1;
+ for( iend = jend; iend < segj.jsno; iend++ )
+ {
+ segj.ax[iend]=- segj.ax[iend]* qp;
+ segj.bx[iend]= segj.bx[iend]* qp;
+ segj.cx[iend]=- segj.cx[iend]* qp;
+ }
+
+ segj.jsno= jsnop+1;
+ segj.ax[jsnop]=-1.;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute the components of all basis functions on segment j */
+void trio( int j )
+{
+ int jcox, jcoxx, jsnox, jx, jend=0, iend=0;
+
+ segj.jsno=0;
+ jx = j-1;
+ jcox= data.icon1[jx];
+ jcoxx = jcox-1;
+
+ if( jcox <= PCHCON)
+ {
+ jend=-1;
+ iend=-1;
+ }
+
+ if( (jcox == 0) || (jcox > PCHCON) )
+ {
+ jcox= data.icon2[jx];
+ jcoxx = jcox-1;
+
+ if( jcox <= PCHCON)
+ {
+ jend=1;
+ iend=1;
+ }
+
+ if( jcox == 0 || (jcox > PCHCON) )
+ {
+ jsnox = segj.jsno;
+ segj.jsno++;
+
+ /* Allocate to connections buffers */
+ if( segj.jsno >= segj.maxcon )
+ {
+ segj.maxcon = segj.jsno +1;
+ mem_realloc( (void *)&segj.jco, segj.maxcon * sizeof(int) );
+ mem_realloc( (void *) &segj.ax, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *) &segj.bx, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *) &segj.cx, segj.maxcon * sizeof(long double) );
+ }
+
+ sbf( j, j, &segj.ax[jsnox], &segj.bx[jsnox], &segj.cx[jsnox]);
+ segj.jco[jsnox]= j;
+ return;
+ }
+
+ } /* if( (jcox == 0) || (jcox > PCHCON) ) */
+
+ do
+ {
+ if( jcox < 0 )
+ jcox=- jcox;
+ else
+ jend=- jend;
+ jcoxx = jcox-1;
+
+ if( jcox != j)
+ {
+ jsnox = segj.jsno;
+ segj.jsno++;
+
+ /* Allocate to connections buffers */
+ if( segj.jsno >= segj.maxcon )
+ {
+ segj.maxcon = segj.jsno +1;
+ mem_realloc( (void *)&segj.jco, segj.maxcon * sizeof(int) );
+ mem_realloc( (void *) &segj.ax, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *) &segj.bx, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *) &segj.cx, segj.maxcon * sizeof(long double) );
+ }
+
+ sbf( jcox, j, &segj.ax[jsnox], &segj.bx[jsnox], &segj.cx[jsnox]);
+ segj.jco[jsnox]= jcox;
+
+ if( jend != 1)
+ jcox= data.icon1[jcoxx];
+ else
+ jcox= data.icon2[jcoxx];
+
+ if( jcox == 0 )
+ {
+ fprintf( output_fp,
+ "\n TRIO - SEGMENT CONNENTION ERROR FOR SEGMENT %5d", j );
+ stop(-1);
+ }
+ else
+ continue;
+
+ } /* if( jcox != j) */
+
+ if( iend == 1)
+ break;
+
+ jcox= data.icon2[jx];
+
+ if( jcox > PCHCON ) break;
+
+ jend=1;
+ iend=1;
+
+ } /* do */
+ while( jcox != 0 );
+
+ jsnox = segj.jsno;
+ segj.jsno++;
+
+ /* Allocate to connections buffers */
+ if( segj.jsno >= segj.maxcon )
+ {
+ segj.maxcon = segj.jsno +1;
+ mem_realloc( (void *)&segj.jco, segj.maxcon * sizeof(int) );
+ mem_realloc( (void *) &segj.ax, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *) &segj.bx, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *) &segj.cx, segj.maxcon * sizeof(long double) );
+ }
+
+ sbf( j, j, &segj.ax[jsnox], &segj.bx[jsnox], &segj.cx[jsnox]);
+ segj.jco[jsnox]= j;
+
+ return;
+
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* zint computes the internal impedance of a circular wire */
+void zint( long double sigl, long double rolam, complex long double *zint )
+{
+#define cc1 ( 6.0e-7 + 1.9e-6fj)
+#define cc2 (-3.4e-6 + 5.1e-6fj)
+#define cc3 (-2.52e-5 + 0.fj)
+#define cc4 (-9.06e-5 - 9.01e-5fj)
+#define cc5 ( 0. - 9.765e-4fj)
+#define cc6 (.0110486 - .0110485fj)
+#define cc7 ( 0. - .3926991fj)
+#define cc8 ( 1.6e-6 - 3.2e-6fj)
+#define cc9 ( 1.17e-5 - 2.4e-6fj)
+#define cc10 ( 3.46e-5 + 3.38e-5fj)
+#define cc11 ( 5.0e-7 + 2.452e-4fj)
+#define cc12 (-1.3813e-3 + 1.3811e-3fj)
+#define cc13 (-6.25001e-2 - 1.0e-7fj)
+#define cc14 (.7071068 + .7071068fj)
+#define cn cc14
+
+#define th(d) ( (((((cc1*(d)+cc2)*(d)+cc3)*(d)+cc4)*(d)+cc5)*(d)+cc6)*(d) + cc7 )
+#define ph(d) ( (((((cc8*(d)+cc9)*(d)+cc10)*(d)+cc11)*(d)+cc12)*(d)+cc13)*(d)+cc14 )
+#define f(d) ( csqrtl(POT/(d))*cexpl(-cn*(d)+th(-8./x)) )
+#define g(d) ( cexpl(cn*(d)+th(8./x))/csqrtl(TP*(d)) )
+
+ long double x, y, s, ber, bei;
+ long double tpcmu = 2.368705e+3;
+ long double cmotp = 60.00;
+ complex long double br1, br2;
+
+ x= sqrtl( tpcmu* sigl)* rolam;
+ if( x <= 110.)
+ {
+ if( x <= 8.)
+ {
+ y= x/8.;
+ y= y* y;
+ s= y* y;
+
+ ber=((((((-9.01e-6* s+1.22552e-3)* s-.08349609)* s+ 2.6419140)*
+ s-32.363456)* s+113.77778)* s-64.)* s+1.;
+
+ bei=((((((1.1346e-4* s-.01103667)* s+.52185615)* s-10.567658)*
+ s+72.817777)* s-113.77778)* s+16.)* y;
+
+ br1= cmplx( ber, bei);
+
+ ber=(((((((-3.94e-6* s+4.5957e-4)* s-.02609253)* s+ .66047849)*
+ s-6.0681481)* s+14.222222)* s-4.)* y)* x;
+
+ bei=((((((4.609e-5* s-3.79386e-3)* s+.14677204)* s- 2.3116751)*
+ s+11.377778)* s-10.666667)* s+.5)* x;
+
+ br2= cmplx( ber, bei);
+ br1= br1/ br2;
+ *zint= CPLX_01* sqrtl( cmotp/sigl )* br1/ rolam;
+
+ } /* if( x <= 8.) */
+
+ br2= CPLX_01* f(x)/ PI;
+ br1= g( x)+ br2;
+ br2= g( x)* ph(8./ x)- br2* ph(-8./ x);
+ br1= br1/ br2;
+ *zint= CPLX_01* sqrtl( cmotp/ sigl)* br1/ rolam;
+
+ } /* if( x <= 110.) */
+
+ br1= cmplx(.70710678,-.70710678);
+ *zint= CPLX_01* sqrtl( cmotp/ sigl)* br1/ rolam;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* cang returns the phase angle of a complex number in degrees. */
+long double cang( complex long double z )
+{
+ return( cargl(z)*TD );
+}
+
+/*-----------------------------------------------------------------------*/
diff --git a/fields.c b/fields.c
new file mode 100644
index 0000000..a1d92ad
--- /dev/null
+++ b/fields.c
@@ -0,0 +1,1754 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+ ******************************************************************/
+
+#include "nec2c.h"
+
+/* common /dataj/ */
+dataj_t dataj;
+
+/* common /gnd/ */
+extern gnd_t gnd;
+
+/* common /incom/ */
+extern incom_t incom;
+
+/* common /tmi/ */
+tmi_t tmi;
+
+/*common /tmh/ */
+static tmh_t tmh;
+
+/* common /gwav/ */
+extern gwav_t gwav;
+
+/* common /data/ */
+extern data_t data;
+
+/* common /crnt/ */
+extern crnt_t crnt;
+
+/* common /fpat/ */
+extern fpat_t fpat;
+
+/* common /plot/ */
+extern plot_t plot;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/*-------------------------------------------------------------------*/
+
+/* compute near e fields of a segment with sine, cosine, and */
+/* constant currents. ground effect included. */
+void efld( long double xi, long double yi, long double zi, long double ai, int ij )
+{
+#define txk egnd[0]
+#define tyk egnd[1]
+#define tzk egnd[2]
+#define txs egnd[3]
+#define tys egnd[4]
+#define tzs egnd[5]
+#define txc egnd[6]
+#define tyc egnd[7]
+#define tzc egnd[8]
+
+ int ip;
+ long double xij, yij, ijx, rfl, salpr, zij, zp, rhox;
+ long double rhoy, rhoz, rh, r, rmag, cth, px, py;
+ long double xymag, xspec, yspec, rhospc, dmin, shaf;
+ complex long double epx, epy, refs, refps, zrsin, zratx, zscrn;
+ complex long double tezs, ters, tezc, terc, tezk, terk, egnd[9];
+
+ xij= xi- dataj.xj;
+ yij= yi- dataj.yj;
+ ijx= ij;
+ rfl=-1.;
+
+ for( ip = 0; ip < gnd.ksymp; ip++ )
+ {
+ if( ip == 1)
+ ijx=1;
+ rfl=- rfl;
+ salpr= dataj.salpj* rfl;
+ zij= zi- rfl* dataj.zj;
+ zp= xij* dataj.cabj+ yij* dataj.sabj+ zij* salpr;
+ rhox= xij- dataj.cabj* zp;
+ rhoy= yij- dataj.sabj* zp;
+ rhoz= zij- salpr* zp;
+
+ rh= sqrtl( rhox* rhox+ rhoy* rhoy+ rhoz* rhoz+ ai* ai);
+ if( rh <= 1.e-10)
+ {
+ rhox=0.;
+ rhoy=0.;
+ rhoz=0.;
+ }
+ else
+ {
+ rhox= rhox/ rh;
+ rhoy= rhoy/ rh;
+ rhoz= rhoz/ rh;
+ }
+
+ /* lumped current element approx. for large separations */
+ r= sqrtl( zp* zp+ rh* rh);
+ if( r >= dataj.rkh)
+ {
+ rmag= TP* r;
+ cth= zp/ r;
+ px= rh/ r;
+ txk= cmplx( cosl( rmag),- sinl( rmag));
+ py= TP* r* r;
+ tyk= ETA* cth* txk* cmplx(1.0,-1.0/ rmag)/ py;
+ tzk= ETA* px* txk* cmplx(1.0, rmag-1.0/ rmag)/(2.* py);
+ tezk= tyk* cth- tzk* px;
+ terk= tyk* px+ tzk* cth;
+ rmag= sinl( PI* dataj.s)/ PI;
+ tezc= tezk* rmag;
+ terc= terk* rmag;
+ tezk= tezk* dataj.s;
+ terk= terk* dataj.s;
+ txs=CPLX_00;
+ tys=CPLX_00;
+ tzs=CPLX_00;
+
+ } /* if( r >= dataj.rkh) */
+
+ if( r < dataj.rkh)
+ {
+ /* eksc for thin wire approx. or ekscx for extended t.w. approx. */
+ if( dataj.iexk != 1)
+ eksc( dataj.s, zp, rh, TP, ijx, &tezs, &ters,
+ &tezc, &terc, &tezk, &terk );
+ else
+ ekscx( dataj.b, dataj.s, zp, rh, TP, ijx, dataj.ind1, dataj.ind2,
+ &tezs, &ters, &tezc, &terc, &tezk, &terk);
+
+ txs= tezs* dataj.cabj+ ters* rhox;
+ tys= tezs* dataj.sabj+ ters* rhoy;
+ tzs= tezs* salpr+ ters* rhoz;
+
+ } /* if( r < dataj.rkh) */
+
+ txk= tezk* dataj.cabj+ terk* rhox;
+ tyk= tezk* dataj.sabj+ terk* rhoy;
+ tzk= tezk* salpr+ terk* rhoz;
+ txc= tezc* dataj.cabj+ terc* rhox;
+ tyc= tezc* dataj.sabj+ terc* rhoy;
+ tzc= tezc* salpr+ terc* rhoz;
+
+ if( ip == 1)
+ {
+ if( gnd.iperf <= 0)
+ {
+ zratx= gnd.zrati;
+ rmag= r;
+ xymag= sqrtl( xij* xij+ yij* yij);
+
+ /* set parameters for radial wire ground screen. */
+ if( gnd.nradl != 0)
+ {
+ xspec=( xi* dataj.zj+ zi* dataj.xj)/( zi+ dataj.zj);
+ yspec=( yi* dataj.zj+ zi* dataj.yj)/( zi+ dataj.zj);
+ rhospc= sqrtl( xspec* xspec+ yspec* yspec+ gnd.t2* gnd.t2);
+
+ if( rhospc <= gnd.scrwl)
+ {
+ zscrn= gnd.t1* rhospc* logl( rhospc/ gnd.t2);
+ zratx=( zscrn* gnd.zrati)/( ETA* gnd.zrati+ zscrn);
+ }
+ } /* if( gnd.nradl != 0) */
+
+ /* calculation of reflection coefficients when ground is specified. */
+ if( xymag <= 1.0e-6)
+ {
+ px=0.;
+ py=0.;
+ cth=1.;
+ zrsin=CPLX_10;
+ }
+ else
+ {
+ px=- yij/ xymag;
+ py= xij/ xymag;
+ cth= zij/ rmag;
+ zrsin= csqrtl(1.0 - zratx*zratx*(1.0 - cth*cth) );
+
+ } /* if( xymag <= 1.0e-6) */
+
+ refs=( cth- zratx* zrsin)/( cth+ zratx* zrsin);
+ refps=-( zratx* cth- zrsin)/( zratx* cth+ zrsin);
+ refps= refps- refs;
+ epy= px* txk+ py* tyk;
+ epx= px* epy;
+ epy= py* epy;
+ txk= refs* txk+ refps* epx;
+ tyk= refs* tyk+ refps* epy;
+ tzk= refs* tzk;
+ epy= px* txs+ py* tys;
+ epx= px* epy;
+ epy= py* epy;
+ txs= refs* txs+ refps* epx;
+ tys= refs* tys+ refps* epy;
+ tzs= refs* tzs;
+ epy= px* txc+ py* tyc;
+ epx= px* epy;
+ epy= py* epy;
+ txc= refs* txc+ refps* epx;
+ tyc= refs* tyc+ refps* epy;
+ tzc= refs* tzc;
+
+ } /* if( gnd.iperf <= 0) */
+
+ dataj.exk= dataj.exk- txk* gnd.frati;
+ dataj.eyk= dataj.eyk- tyk* gnd.frati;
+ dataj.ezk= dataj.ezk- tzk* gnd.frati;
+ dataj.exs= dataj.exs- txs* gnd.frati;
+ dataj.eys= dataj.eys- tys* gnd.frati;
+ dataj.ezs= dataj.ezs- tzs* gnd.frati;
+ dataj.exc= dataj.exc- txc* gnd.frati;
+ dataj.eyc= dataj.eyc- tyc* gnd.frati;
+ dataj.ezc= dataj.ezc- tzc* gnd.frati;
+ continue;
+
+ } /* if( ip == 1) */
+
+ dataj.exk= txk;
+ dataj.eyk= tyk;
+ dataj.ezk= tzk;
+ dataj.exs= txs;
+ dataj.eys= tys;
+ dataj.ezs= tzs;
+ dataj.exc= txc;
+ dataj.eyc= tyc;
+ dataj.ezc= tzc;
+
+ } /* for( ip = 0; ip < gnd.ksymp; ip++ ) */
+
+ if( gnd.iperf != 2)
+ return;
+
+ /* field due to ground using sommerfeld/norton */
+ incom.sn= sqrtl( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj);
+ if( incom.sn >= 1.0e-5)
+ {
+ incom.xsn= dataj.cabj/ incom.sn;
+ incom.ysn= dataj.sabj/ incom.sn;
+ }
+ else
+ {
+ incom.sn=0.;
+ incom.xsn=1.;
+ incom.ysn=0.;
+ }
+
+ /* displace observation point for thin wire approximation */
+ zij= zi+ dataj.zj;
+ salpr=- dataj.salpj;
+ rhox= dataj.sabj* zij- salpr* yij;
+ rhoy= salpr* xij- dataj.cabj* zij;
+ rhoz= dataj.cabj* yij- dataj.sabj* xij;
+ rh= rhox* rhox+ rhoy* rhoy+ rhoz* rhoz;
+
+ if( rh <= 1.e-10)
+ {
+ incom.xo= xi- ai* incom.ysn;
+ incom.yo= yi+ ai* incom.xsn;
+ incom.zo= zi;
+ }
+ else
+ {
+ rh= ai/ sqrtl( rh);
+ if( rhoz < 0.)
+ rh=- rh;
+ incom.xo= xi+ rh* rhox;
+ incom.yo= yi+ rh* rhoy;
+ incom.zo= zi+ rh* rhoz;
+
+ } /* if( rh <= 1.e-10) */
+
+ r= xij* xij+ yij* yij+ zij* zij;
+ if( r <= .95)
+ {
+ /* field from interpolation is integrated over segment */
+ incom.isnor=1;
+ dmin= dataj.exk* conjl( dataj.exk)+ dataj.eyk*
+ conjl( dataj.eyk)+ dataj.ezk* conjl( dataj.ezk);
+ dmin=.01* sqrtl( dmin);
+ shaf=.5* dataj.s;
+ rom2(- shaf, shaf, egnd, dmin);
+ }
+ else
+ {
+ /* norton field equations and lumped current element approximation */
+ incom.isnor=2;
+ sflds(0., egnd);
+ } /* if( r <= .95) */
+
+ if( r > .95)
+ {
+ zp= xij* dataj.cabj+ yij* dataj.sabj+ zij* salpr;
+ rh= r- zp* zp;
+ if( rh <= 1.e-10)
+ dmin=0.;
+ else
+ dmin= sqrtl( rh/( rh+ ai* ai));
+
+ if( dmin <= .95)
+ {
+ px=1.- dmin;
+ terk=( txk* dataj.cabj+ tyk* dataj.sabj+ tzk* salpr)* px;
+ txk= dmin* txk+ terk* dataj.cabj;
+ tyk= dmin* tyk+ terk* dataj.sabj;
+ tzk= dmin* tzk+ terk* salpr;
+ ters=( txs* dataj.cabj+ tys* dataj.sabj+ tzs* salpr)* px;
+ txs= dmin* txs+ ters* dataj.cabj;
+ tys= dmin* tys+ ters* dataj.sabj;
+ tzs= dmin* tzs+ ters* salpr;
+ terc=( txc* dataj.cabj+ tyc* dataj.sabj+ tzc* salpr)* px;
+ txc= dmin* txc+ terc* dataj.cabj;
+ tyc= dmin* tyc+ terc* dataj.sabj;
+ tzc= dmin* tzc+ terc* salpr;
+
+ } /* if( dmin <= .95) */
+
+ } /* if( r > .95) */
+
+ dataj.exk= dataj.exk+ txk;
+ dataj.eyk= dataj.eyk+ tyk;
+ dataj.ezk= dataj.ezk+ tzk;
+ dataj.exs= dataj.exs+ txs;
+ dataj.eys= dataj.eys+ tys;
+ dataj.ezs= dataj.ezs+ tzs;
+ dataj.exc= dataj.exc+ txc;
+ dataj.eyc= dataj.eyc+ tyc;
+ dataj.ezc= dataj.ezc+ tzc;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute e field of sine, cosine, and constant */
+/* current filaments by thin wire approximation. */
+void eksc( long double s, long double z, long double rh, long double xk, int ij,
+ complex long double *ezs, complex long double *ers, complex long double *ezc,
+ complex long double *erc, complex long double *ezk, complex long double *erk )
+{
+ long double rhk, sh, shk, ss, cs, z1a, z2a, cint, sint;
+ complex long double gz1, gz2, gp1, gp2, gzp1, gzp2;
+
+ tmi.ij= ij;
+ tmi.zpk= xk* z;
+ rhk= xk* rh;
+ tmi.rkb2= rhk* rhk;
+ sh=.5* s;
+ shk= xk* sh;
+ ss= sinl( shk);
+ cs= cosl( shk);
+ z2a= sh- z;
+ z1a=-( sh+ z);
+ gx( z1a, rh, xk, &gz1, &gp1);
+ gx( z2a, rh, xk, &gz2, &gp2);
+ gzp1= gp1* z1a;
+ gzp2= gp2* z2a;
+ *ezs= CONST1*(( gz2- gz1)* cs* xk-( gzp2+ gzp1)* ss);
+ *ezc=- CONST1*(( gz2+ gz1)* ss* xk+( gzp2- gzp1)* cs);
+ *erk= CONST1*( gp2- gp1)* rh;
+ intx(- shk, shk, rhk, ij, &cint, &sint);
+ *ezk=- CONST1*( gzp2- gzp1+ xk* xk* cmplx( cint,- sint));
+ gzp1= gzp1* z1a;
+ gzp2= gzp2* z2a;
+
+ if( rh >= 1.0e-10)
+ {
+ *ers=- CONST1*(( gzp2+ gzp1+ gz2+ gz1)*
+ ss-( z2a* gz2- z1a* gz1)* cs*xk)/ rh;
+ *erc=- CONST1*(( gzp2- gzp1+ gz2- gz1)*
+ cs+( z2a* gz2+ z1a* gz1)* ss*xk)/ rh;
+ return;
+ }
+
+ *ers = CPLX_00;
+ *erc = CPLX_00;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute e field of sine, cosine, and constant current */
+/* filaments by extended thin wire approximation. */
+void ekscx( long double bx, long double s, long double z,
+ long double rhx, long double xk, int ij, int inx1, int inx2,
+ complex long double *ezs, complex long double *ers, complex long double *ezc,
+ complex long double *erc, complex long double *ezk, complex long double *erk )
+{
+ int ira;
+ long double b, rh, sh, rhk, shk, ss, cs, z1a;
+ long double z2a, a2, bk, bk2, cint, sint;
+ complex long double gz1, gz2, gzp1, gzp2, gr1, gr2;
+ complex long double grp1, grp2, grk1, grk2, gzz1, gzz2;
+
+ if( rhx >= bx)
+ {
+ rh= rhx;
+ b= bx;
+ ira=0;
+ }
+ else
+ {
+ rh= bx;
+ b= rhx;
+ ira=1;
+ }
+
+ sh=.5* s;
+ tmi.ij= ij;
+ tmi.zpk= xk* z;
+ rhk= xk* rh;
+ tmi.rkb2= rhk* rhk;
+ shk= xk* sh;
+ ss= sinl( shk);
+ cs= cosl( shk);
+ z2a= sh- z;
+ z1a=-( sh+ z);
+ a2= b* b;
+
+ if( inx1 != 2)
+ gxx( z1a, rh, b, a2, xk, ira, &gz1,
+ &gzp1, &gr1, &grp1, &grk1, &gzz1);
+ else
+ {
+ gx( z1a, rhx, xk, &gz1, &grk1);
+ gzp1= grk1* z1a;
+ gr1= gz1/ rhx;
+ grp1= gzp1/ rhx;
+ grk1= grk1* rhx;
+ gzz1= CPLX_00;
+ }
+
+ if( inx2 != 2)
+ gxx( z2a, rh, b, a2, xk, ira, &gz2,
+ &gzp2, &gr2, &grp2, &grk2, &gzz2);
+ else
+ {
+ gx( z2a, rhx, xk, &gz2, &grk2);
+ gzp2= grk2* z2a;
+ gr2= gz2/ rhx;
+ grp2= gzp2/ rhx;
+ grk2= grk2* rhx;
+ gzz2= CPLX_00;
+ }
+
+ *ezs= CONST1*(( gz2- gz1)* cs* xk-( gzp2+ gzp1)* ss);
+ *ezc=- CONST1*(( gz2+ gz1)* ss* xk+( gzp2- gzp1)* cs);
+ *ers=- CONST1*(( z2a* grp2+ z1a* grp1+ gr2+ gr1)*ss
+ -( z2a* gr2- z1a* gr1)* cs* xk);
+ *erc=- CONST1*(( z2a* grp2- z1a* grp1+ gr2- gr1)*cs
+ +( z2a* gr2+ z1a* gr1)* ss* xk);
+ *erk= CONST1*( grk2- grk1);
+ intx(- shk, shk, rhk, ij, &cint, &sint);
+ bk= b* xk;
+ bk2= bk* bk*.25;
+ *ezk=- CONST1*( gzp2- gzp1+ xk* xk*(1.- bk2)*
+ cmplx( cint,- sint)-bk2*( gzz2- gzz1));
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* integrand for h field of a wire */
+void gh( long double zk, long double *hr, long double *hi)
+{
+ long double rs, r, ckr, skr, rr2, rr3;
+
+ rs= zk- tmh.zpka;
+ rs= tmh.rhks+ rs* rs;
+ r= sqrtl( rs);
+ ckr= cosl( r);
+ skr= sinl( r);
+ rr2=1./ rs;
+ rr3= rr2/ r;
+ *hr= skr* rr2+ ckr* rr3;
+ *hi= ckr* rr2- skr* rr3;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* gwave computes the electric field, including ground wave, of a */
+/* current element over a ground plane using formulas of k.a. norton */
+/* (proc. ire, sept., 1937, pp.1203,1236.) */
+
+void gwave( complex long double *erv, complex long double *ezv,
+ complex long double *erh, complex long double *ezh, complex long double *eph )
+{
+ long double sppp, sppp2, cppp2, cppp, spp, spp2, cpp2, cpp;
+ complex long double rk1, rk2, t1, t2, t3, t4, p1, rv;
+ complex long double omr, w, f, q1, rh, v, g, xr1, xr2;
+ complex long double x1, x2, x3, x4, x5, x6, x7;
+
+ sppp= gwav.zmh/ gwav.r1;
+ sppp2= sppp* sppp;
+ cppp2=1.- sppp2;
+
+ if( cppp2 < 1.0e-20)
+ cppp2=1.0e-20;
+
+ cppp= sqrtl( cppp2);
+ spp= gwav.zph/ gwav.r2;
+ spp2= spp* spp;
+ cpp2=1.- spp2;
+
+ if( cpp2 < 1.0e-20)
+ cpp2=1.0e-20;
+
+ cpp= sqrtl( cpp2);
+ rk1=- TPJ* gwav.r1;
+ rk2=- TPJ* gwav.r2;
+ t1=1. -gwav.u2* cpp2;
+ t2= csqrtl( t1);
+ t3=(1. -1./ rk1)/ rk1;
+ t4=(1. -1./ rk2)/ rk2;
+ p1= rk2* gwav.u2* t1/(2.* cpp2);
+ rv=( spp- gwav.u* t2)/( spp+ gwav.u* t2);
+ omr=1.- rv;
+ w=1./ omr;
+ w=(4.0 + 0.0fj)* p1* w* w;
+ fbar( w, &f );
+ q1= rk2* t1/(2.* gwav.u2* cpp2);
+ rh=( t2- gwav.u* spp)/( t2+ gwav.u* spp);
+ v=1./(1.+ rh);
+ v=(4.0 + 0.0fj)* q1* v* v;
+ fbar( v, &g );
+ xr1= gwav.xx1/ gwav.r1;
+ xr2= gwav.xx2/ gwav.r2;
+ x1= cppp2* xr1;
+ x2= rv* cpp2* xr2;
+ x3= omr* cpp2* f* xr2;
+ x4= gwav.u* t2* spp*2.* xr2/ rk2;
+ x5= xr1* t3*(1.-3.* sppp2);
+ x6= xr2* t4*(1.-3.* spp2);
+ *ezv=( x1+ x2+ x3- x4- x5- x6)* (-CONST4);
+ x1= sppp* cppp* xr1;
+ x2= rv* spp* cpp* xr2;
+ x3= cpp* omr* gwav.u* t2* f* xr2;
+ x4= spp* cpp* omr* xr2/ rk2;
+ x5=3.* sppp* cppp* t3* xr1;
+ x6= cpp* gwav.u* t2* omr* xr2/ rk2*.5;
+ x7=3.* spp* cpp* t4* xr2;
+ *erv=-( x1+ x2- x3+ x4- x5+ x6- x7)* (-CONST4);
+ *ezh=-( x1- x2+ x3- x4- x5- x6+ x7)* (-CONST4);
+ x1= sppp2* xr1;
+ x2= rv* spp2* xr2;
+ x4= gwav.u2* t1* omr* f* xr2;
+ x5= t3*(1.-3.* cppp2)* xr1;
+ x6= t4*(1.-3.* cpp2)*(1.- gwav.u2*(1.+ rv)- gwav.u2* omr* f)* xr2;
+ x7= gwav.u2* cpp2* omr*(1.-1./ rk2)*( f*( gwav.u2* t1- spp2-1./ rk2)+1./rk2)* xr2;
+ *erh=( x1- x2- x4- x5+ x6+ x7)* (-CONST4);
+ x1= xr1;
+ x2= rh* xr2;
+ x3=( rh+1.)* g* xr2;
+ x4= t3* xr1;
+ x5= t4*(1.- gwav.u2*(1.+ rv)- gwav.u2* omr* f)* xr2;
+ x6=.5* gwav.u2* omr*( f*( gwav.u2* t1- spp2-1./ rk2)+1./ rk2)* xr2/ rk2;
+ *eph=-( x1- x2+ x3- x4+ x5+ x6)* (-CONST4);
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* segment end contributions for thin wire approx. */
+void gx( long double zz, long double rh, long double xk,
+ complex long double *gz, complex long double *gzp)
+{
+ long double r, r2, rkz;
+
+ r2= zz* zz+ rh* rh;
+ r= sqrtl( r2);
+ rkz= xk* r;
+ *gz= cmplx( cosl( rkz),- sinl( rkz))/ r;
+ *gzp=- cmplx(1.0, rkz)* *gz/ r2;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* segment end contributions for ext. thin wire approx. */
+void gxx( long double zz, long double rh, long double a,
+ long double a2, long double xk, int ira, complex long double *g1,
+ complex long double *g1p, complex long double *g2,
+ complex long double *g2p, complex long double *g3, complex long double *gzp )
+{
+ long double r, r2, r4, rk, rk2, rh2, t1, t2;
+ complex long double gz, c1, c2, c3;
+
+ r2= zz* zz+ rh* rh;
+ r= sqrtl( r2);
+ r4= r2* r2;
+ rk= xk* r;
+ rk2= rk* rk;
+ rh2= rh* rh;
+ t1=.25* a2* rh2/ r4;
+ t2=.5* a2/ r2;
+ c1= cmplx(1.0, rk);
+ c2=3.* c1- rk2;
+ c3= cmplx(6.0, rk)* rk2-15.* c1;
+ gz= cmplx( cosl( rk),- sinl( rk))/ r;
+ *g2= gz*(1.+ t1* c2);
+ *g1= *g2- t2* c1* gz;
+ gz= gz/ r2;
+ *g2p= gz*( t1* c3- c1);
+ *gzp= t2* c2* gz;
+ *g3= *g2p+ *gzp;
+ *g1p= *g3* zz;
+
+ if( ira != 1)
+ {
+ *g3=( *g3+ *gzp)* rh;
+ *gzp=- zz* c1* gz;
+
+ if( rh <= 1.0e-10)
+ {
+ *g2=0.;
+ *g2p=0.;
+ return;
+ }
+
+ *g2= *g2/ rh;
+ *g2p= *g2p* zz/ rh;
+ return;
+
+ } /* if( ira != 1) */
+
+ t2=.5* a;
+ *g2=- t2* c1* gz;
+ *g2p= t2* gz* c2/ r2;
+ *g3= rh2* *g2p- a* gz* c1;
+ *g2p= *g2p* zz;
+ *gzp=- zz* c1* gz;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* hfk computes the h field of a uniform current */
+/* filament by numerical integration */
+void hfk( long double el1, long double el2, long double rhk,
+ long double zpkx, long double *sgr, long double *sgi )
+{
+ int nx = 1, nma = 65536, nts = 4;
+ int ns, nt;
+ int flag = TRUE;
+ long double rx = 1.0e-4;
+ long double z, ze, s, ep, zend, dz=0., zp, dzot=0., t00r, g1r, g5r=0, t00i;
+ long double g1i, g5i=0., t01r, g3r=0, t01i, g3i=0, t10r, t10i, te1i, te1r, t02r;
+ long double g2r, g4r, t02i, g2i, g4i, t11r, t11i, t20r, t20i, te2i, te2r;
+
+ tmh.zpka= zpkx;
+ tmh.rhks= rhk* rhk;
+ z= el1;
+ ze= el2;
+ s= ze- z;
+ ep= s/(10.* nma);
+ zend= ze- ep;
+ *sgr=0.0;
+ *sgi=0.0;
+ ns= nx;
+ nt=0;
+ gh( z, &g1r, &g1i);
+
+ while( TRUE )
+ {
+ if( flag )
+ {
+ dz= s/ ns;
+ zp= z+ dz;
+
+ if( zp > ze )
+ {
+ dz= ze- z;
+ if( fabsl(dz) <= ep )
+ {
+ *sgr= *sgr* rhk*.5;
+ *sgi= *sgi* rhk*.5;
+ return;
+ }
+ }
+
+ dzot= dz*.5;
+ zp= z+ dzot;
+ gh( zp, &g3r, &g3i);
+ zp= z+ dz;
+ gh( zp, &g5r, &g5i);
+
+ } /* if( flag ) */
+
+ t00r=( g1r+ g5r)* dzot;
+ t00i=( g1i+ g5i)* dzot;
+ t01r=( t00r+ dz* g3r)*0.5;
+ t01i=( t00i+ dz* g3i)*0.5;
+ t10r=(4.0* t01r- t00r)/3.0;
+ t10i=(4.0* t01i- t00i)/3.0;
+
+ test( t01r, t10r, &te1r, t01i, t10i, &te1i, 0.);
+ if( (te1i <= rx) && (te1r <= rx) )
+ {
+ *sgr= *sgr+ t10r;
+ *sgi= *sgi+ t10i;
+ nt += 2;
+
+ z += dz;
+ if( z >= zend)
+ {
+ *sgr= *sgr* rhk*.5;
+ *sgi= *sgi* rhk*.5;
+ return;
+ }
+
+ g1r= g5r;
+ g1i= g5i;
+ if( nt >= nts)
+ if( ns > nx)
+ {
+ ns= ns/2;
+ nt=1;
+ }
+ flag = TRUE;
+ continue;
+
+ } /* if( (te1i <= rx) && (te1r <= rx) ) */
+
+ zp= z+ dz*0.25;
+ gh( zp, &g2r, &g2i);
+ zp= z+ dz*0.75;
+ gh( zp, &g4r, &g4i);
+ t02r=( t01r+ dzot*( g2r+ g4r))*0.5;
+ t02i=( t01i+ dzot*( g2i+ g4i))*0.5;
+ t11r=(4.0* t02r- t01r)/3.0;
+ t11i=(4.0* t02i- t01i)/3.0;
+ t20r=(16.0* t11r- t10r)/15.0;
+ t20i=(16.0* t11i- t10i)/15.0;
+
+ test( t11r, t20r, &te2r, t11i, t20i, &te2i, 0.);
+ if( (te2i > rx) || (te2r > rx) )
+ {
+ nt=0;
+ if( ns >= nma)
+ fprintf( output_fp, "\n STEP SIZE LIMITED AT Z= %10.5LF", z );
+ else
+ {
+ ns= ns*2;
+ dz= s/ ns;
+ dzot= dz*0.5;
+ g5r= g3r;
+ g5i= g3i;
+ g3r= g2r;
+ g3i= g2i;
+
+ flag = FALSE;
+ continue;
+ }
+
+ } /* if( (te2i > rx) || (te2r > rx) ) */
+
+ *sgr= *sgr+ t20r;
+ *sgi= *sgi+ t20i;
+ nt++;
+
+ z += dz;
+ if( z >= zend)
+ {
+ *sgr= *sgr* rhk*.5;
+ *sgi= *sgi* rhk*.5;
+ return;
+ }
+
+ g1r= g5r;
+ g1i= g5i;
+ if( nt >= nts)
+ if( ns > nx)
+ {
+ ns= ns/2;
+ nt=1;
+ }
+ flag = TRUE;
+
+ } /* while( TRUE ) */
+
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* hintg computes the h field of a patch current */
+void hintg( long double xi, long double yi, long double zi )
+{
+ int ip;
+ long double rx, ry, rfl, xymag, pxx, pyy, cth;
+ long double rz, rsq, r, rk, cr, sr, t1zr, t2zr;
+ complex long double gam, f1x, f1y, f1z, f2x, f2y, f2z, rrv, rrh;
+
+ rx= xi- dataj.xj;
+ ry= yi- dataj.yj;
+ rfl=-1.;
+ dataj.exk=CPLX_00;
+ dataj.eyk=CPLX_00;
+ dataj.ezk=CPLX_00;
+ dataj.exs=CPLX_00;
+ dataj.eys=CPLX_00;
+ dataj.ezs=CPLX_00;
+
+ for( ip = 1; ip <= gnd.ksymp; ip++ )
+ {
+ rfl=- rfl;
+ rz= zi- dataj.zj* rfl;
+ rsq= rx* rx+ ry* ry+ rz* rz;
+
+ if( rsq < 1.0e-20)
+ continue;
+
+ r = sqrtl( rsq );
+ rk= TP* r;
+ cr= cosl( rk);
+ sr= sinl( rk);
+ gam=-( cmplx(cr,-sr)+rk*cmplx(sr,cr) )/( FPI*rsq*r )* dataj.s;
+ dataj.exc= gam* rx;
+ dataj.eyc= gam* ry;
+ dataj.ezc= gam* rz;
+ t1zr= dataj.t1zj* rfl;
+ t2zr= dataj.t2zj* rfl;
+ f1x= dataj.eyc* t1zr- dataj.ezc* dataj.t1yj;
+ f1y= dataj.ezc* dataj.t1xj- dataj.exc* t1zr;
+ f1z= dataj.exc* dataj.t1yj- dataj.eyc* dataj.t1xj;
+ f2x= dataj.eyc* t2zr- dataj.ezc* dataj.t2yj;
+ f2y= dataj.ezc* dataj.t2xj- dataj.exc* t2zr;
+ f2z= dataj.exc* dataj.t2yj- dataj.eyc* dataj.t2xj;
+
+ if( ip != 1)
+ {
+ if( gnd.iperf == 1)
+ {
+ f1x=- f1x;
+ f1y=- f1y;
+ f1z=- f1z;
+ f2x=- f2x;
+ f2y=- f2y;
+ f2z=- f2z;
+ }
+ else
+ {
+ xymag= sqrtl( rx* rx+ ry* ry);
+ if( xymag <= 1.0e-6)
+ {
+ pxx=0.;
+ pyy=0.;
+ cth=1.;
+ rrv=CPLX_10;
+ }
+ else
+ {
+ pxx=- ry/ xymag;
+ pyy= rx/ xymag;
+ cth= rz/ r;
+ rrv= csqrtl(1.- gnd.zrati* gnd.zrati*(1.- cth* cth));
+
+ } /* if( xymag <= 1.0e-6) */
+
+ rrh= gnd.zrati* cth;
+ rrh=( rrh- rrv)/( rrh+ rrv);
+ rrv= gnd.zrati* rrv;
+ rrv=-( cth- rrv)/( cth+ rrv);
+ gam=( f1x* pxx+ f1y* pyy)*( rrv- rrh);
+ f1x= f1x* rrh+ gam* pxx;
+ f1y= f1y* rrh+ gam* pyy;
+ f1z= f1z* rrh;
+ gam=( f2x* pxx+ f2y* pyy)*( rrv- rrh);
+ f2x= f2x* rrh+ gam* pxx;
+ f2y= f2y* rrh+ gam* pyy;
+ f2z= f2z* rrh;
+
+ } /* if( gnd.iperf == 1) */
+
+ } /* if( ip != 1) */
+
+ dataj.exk += f1x;
+ dataj.eyk += f1y;
+ dataj.ezk += f1z;
+ dataj.exs += f2x;
+ dataj.eys += f2y;
+ dataj.ezs += f2z;
+
+ } /* for( ip = 1; ip <= gnd.ksymp; ip++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* hsfld computes the h field for constant, sine, and */
+/* cosine current on a segment including ground effects. */
+void hsfld( long double xi, long double yi, long double zi, long double ai )
+{
+ int ip;
+ long double xij, yij, rfl, salpr, zij, zp, rhox, rhoy, rhoz, rh, phx;
+ long double phy, phz, rmag, xymag, xspec, yspec, rhospc, px, py, cth;
+ complex long double hpk, hps, hpc, qx, qy, qz, rrv, rrh, zratx;
+
+ xij= xi- dataj.xj;
+ yij= yi- dataj.yj;
+ rfl=-1.;
+
+ for( ip = 0; ip < gnd.ksymp; ip++ )
+ {
+ rfl=- rfl;
+ salpr= dataj.salpj* rfl;
+ zij= zi- rfl* dataj.zj;
+ zp= xij* dataj.cabj+ yij* dataj.sabj+ zij* salpr;
+ rhox= xij- dataj.cabj* zp;
+ rhoy= yij- dataj.sabj* zp;
+ rhoz= zij- salpr* zp;
+ rh= sqrtl( rhox* rhox+ rhoy* rhoy+ rhoz* rhoz+ ai* ai);
+
+ if( rh <= 1.0e-10)
+ {
+ dataj.exk=0.;
+ dataj.eyk=0.;
+ dataj.ezk=0.;
+ dataj.exs=0.;
+ dataj.eys=0.;
+ dataj.ezs=0.;
+ dataj.exc=0.;
+ dataj.eyc=0.;
+ dataj.ezc=0.;
+ continue;
+ }
+
+ rhox= rhox/ rh;
+ rhoy= rhoy/ rh;
+ rhoz= rhoz/ rh;
+ phx= dataj.sabj* rhoz- salpr* rhoy;
+ phy= salpr* rhox- dataj.cabj* rhoz;
+ phz= dataj.cabj* rhoy- dataj.sabj* rhox;
+
+ hsflx( dataj.s, rh, zp, &hpk, &hps, &hpc);
+
+ if( ip == 1 )
+ {
+ if( gnd.iperf != 1 )
+ {
+ zratx= gnd.zrati;
+ rmag= sqrtl( zp* zp+ rh* rh);
+ xymag= sqrtl( xij* xij+ yij* yij);
+
+ /* set parameters for radial wire ground screen. */
+ if( gnd.nradl != 0)
+ {
+ xspec=( xi* dataj.zj+ zi* dataj.xj)/( zi+ dataj.zj);
+ yspec=( yi* dataj.zj+ zi* dataj.yj)/( zi+ dataj.zj);
+ rhospc= sqrtl( xspec* xspec+ yspec* yspec+ gnd.t2* gnd.t2);
+
+ if( rhospc <= gnd.scrwl)
+ {
+ rrv= gnd.t1* rhospc* logl( rhospc/ gnd.t2);
+ zratx=( rrv* gnd.zrati)/( ETA* gnd.zrati+ rrv);
+ }
+ }
+
+ /* calculation of reflection coefficients when ground is specified. */
+ if( xymag <= 1.0e-6)
+ {
+ px=0.;
+ py=0.;
+ cth=1.;
+ rrv=CPLX_10;
+ }
+ else
+ {
+ px=- yij/ xymag;
+ py= xij/ xymag;
+ cth= zij/ rmag;
+ rrv= csqrtl(1.- zratx* zratx*(1.- cth* cth));
+ }
+
+ rrh= zratx* cth;
+ rrh=-( rrh- rrv)/( rrh+ rrv);
+ rrv= zratx* rrv;
+ rrv=( cth- rrv)/( cth+ rrv);
+ qy=( phx* px+ phy* py)*( rrv- rrh);
+ qx= qy* px+ phx* rrh;
+ qy= qy* py+ phy* rrh;
+ qz= phz* rrh;
+ dataj.exk= dataj.exk- hpk* qx;
+ dataj.eyk= dataj.eyk- hpk* qy;
+ dataj.ezk= dataj.ezk- hpk* qz;
+ dataj.exs= dataj.exs- hps* qx;
+ dataj.eys= dataj.eys- hps* qy;
+ dataj.ezs= dataj.ezs- hps* qz;
+ dataj.exc= dataj.exc- hpc* qx;
+ dataj.eyc= dataj.eyc- hpc* qy;
+ dataj.ezc= dataj.ezc- hpc* qz;
+ continue;
+
+ } /* if( gnd.iperf != 1 ) */
+
+ dataj.exk= dataj.exk- hpk* phx;
+ dataj.eyk= dataj.eyk- hpk* phy;
+ dataj.ezk= dataj.ezk- hpk* phz;
+ dataj.exs= dataj.exs- hps* phx;
+ dataj.eys= dataj.eys- hps* phy;
+ dataj.ezs= dataj.ezs- hps* phz;
+ dataj.exc= dataj.exc- hpc* phx;
+ dataj.eyc= dataj.eyc- hpc* phy;
+ dataj.ezc= dataj.ezc- hpc* phz;
+ continue;
+
+ } /* if( ip == 1 ) */
+
+ dataj.exk= hpk* phx;
+ dataj.eyk= hpk* phy;
+ dataj.ezk= hpk* phz;
+ dataj.exs= hps* phx;
+ dataj.eys= hps* phy;
+ dataj.ezs= hps* phz;
+ dataj.exc= hpc* phx;
+ dataj.eyc= hpc* phy;
+ dataj.ezc= hpc* phz;
+
+ } /* for( ip = 0; ip < gnd.ksymp; ip++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* calculates h field of sine cosine, and constant current of segment */
+void hsflx( long double s, long double rh, long double zpx,
+ complex long double *hpk, complex long double *hps,
+ complex long double *hpc )
+{
+ long double r1, r2, zp, z2a, hss, dh, z1;
+ long double rhz, dk, cdk, sdk, hkr, hki, rh2;
+ complex long double fjk, ekr1, ekr2, t1, t2, cons;
+
+ fjk = -TPJ;
+ if( rh >= 1.0e-10)
+ {
+ if( zpx >= 0.)
+ {
+ zp= zpx;
+ hss=1.;
+ }
+ else
+ {
+ zp=- zpx;
+ hss=-1.;
+ }
+
+ dh=.5* s;
+ z1= zp+ dh;
+ z2a= zp- dh;
+ if( z2a >= 1.0e-7)
+ rhz= rh/ z2a;
+ else
+ rhz=1.;
+
+ dk= TP* dh;
+ cdk= cosl( dk);
+ sdk= sinl( dk);
+ hfk(- dk, dk, rh* TP, zp* TP, &hkr, &hki);
+ *hpk= cmplx( hkr, hki);
+
+ if( rhz >= 1.0e-3)
+ {
+ rh2= rh* rh;
+ r1= sqrtl( rh2+ z1* z1);
+ r2= sqrtl( rh2+ z2a* z2a);
+ ekr1= cexp( fjk* r1);
+ ekr2= cexp( fjk* r2);
+ t1= z1* ekr1/ r1;
+ t2= z2a* ekr2/ r2;
+ *hps=( cdk*( ekr2- ekr1)- CPLX_01* sdk*( t2+ t1))* hss;
+ *hpc=- sdk*( ekr2+ ekr1)- CPLX_01* cdk*( t2- t1);
+ cons=- CPLX_01/(2.* TP* rh);
+ *hps= cons* *hps;
+ *hpc= cons* *hpc;
+ return;
+
+ } /* if( rhz >= 1.0e-3) */
+
+ ekr1= cmplx( cdk, sdk)/( z2a* z2a);
+ ekr2= cmplx( cdk,- sdk)/( z1* z1);
+ t1= TP*(1./ z1-1./ z2a);
+ t2= cexp( fjk* zp)* rh/ PI8;
+ *hps= t2*( t1+( ekr1+ ekr2)* sdk)* hss;
+ *hpc= t2*(- CPLX_01* t1+( ekr1- ekr2)* cdk);
+ return;
+
+ } /* if( rh >= 1.0e-10) */
+
+ *hps=CPLX_00;
+ *hpc=CPLX_00;
+ *hpk=CPLX_00;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* nefld computes the near field at specified points in space after */
+/* the structure currents have been computed. */
+void nefld( long double xob, long double yob, long double zob,
+ complex long double *ex, complex long double *ey, complex long double *ez )
+{
+ int i, ix, ipr, iprx, jc, ipa;
+ long double zp, xi, ax;
+ complex long double acx, bcx, ccx;
+
+ *ex=CPLX_00;
+ *ey=CPLX_00;
+ *ez=CPLX_00;
+ ax=0.;
+
+ if( data.n != 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ dataj.xj= xob- data.x[i];
+ dataj.yj= yob- data.y[i];
+ dataj.zj= zob- data.z[i];
+ zp= data.cab[i]* dataj.xj+ data.sab[i]* dataj.yj+ data.salp[i]* dataj.zj;
+
+ if( fabsl( zp) > 0.5001* data.si[i])
+ continue;
+
+ zp= dataj.xj* dataj.xj+ dataj.yj* dataj.yj+ dataj.zj* dataj.zj- zp* zp;
+ dataj.xj= data.bi[i];
+
+ if( zp > 0.9* dataj.xj* dataj.xj)
+ continue;
+
+ ax= dataj.xj;
+ break;
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ for( i = 0; i < data.n; i++ )
+ {
+ ix = i+1;
+ dataj.s= data.si[i];
+ dataj.b= data.bi[i];
+ dataj.xj= data.x[i];
+ dataj.yj= data.y[i];
+ dataj.zj= data.z[i];
+ dataj.cabj= data.cab[i];
+ dataj.sabj= data.sab[i];
+ dataj.salpj= data.salp[i];
+
+ if( dataj.iexk != 0)
+ {
+ ipr= data.icon1[i];
+
+ if (ipr > PCHCON) dataj.ind1 = 2;
+ else if( ipr < 0 )
+ {
+ ipr = -ipr;
+ iprx = ipr-1;
+
+ if( -data.icon1[iprx] != ix )
+ dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* if( ipr < 0 ) */
+ else
+ if( ipr == 0 )
+ dataj.ind1=1;
+ else
+ {
+ iprx = ipr-1;
+
+ if( ipr != ix )
+ {
+ if( data.icon2[iprx] != ix )
+ dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* if( ipr != ix ) */
+ else
+ {
+ if( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj > 1.0e-8)
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* else */
+
+ ipr= data.icon2[i];
+
+ if (ipr > PCHCON) dataj.ind2 = 2;
+ else if( ipr < 0 )
+ {
+ ipr = -ipr;
+ iprx = ipr-1;
+
+ if( -data.icon2[iprx] != ix )
+ dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* if( ipr < 0 ) */
+ else
+ if( ipr == 0 )
+ dataj.ind2=1;
+ else
+ {
+ iprx = ipr-1;
+
+ if( ipr != ix )
+ {
+ if( data.icon1[iprx] != ix )
+ dataj.ind2=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind2=2;
+ else
+ dataj.ind2=0;
+ }
+ } /* if( ipr != (i+1) ) */
+ else
+ {
+ if( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj > 1.0e-8)
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+
+ } /* else */
+
+ } /* if( dataj.iexk != 0) */
+
+ efld( xob, yob, zob, ax,1);
+ acx= cmplx( crnt.air[i], crnt.aii[i]);
+ bcx= cmplx( crnt.bir[i], crnt.bii[i]);
+ ccx= cmplx( crnt.cir[i], crnt.cii[i]);
+ *ex += dataj.exk* acx+ dataj.exs* bcx+ dataj.exc* ccx;
+ *ey += dataj.eyk* acx+ dataj.eys* bcx+ dataj.eyc* ccx;
+ *ez += dataj.ezk* acx+ dataj.ezs* bcx+ dataj.ezc* ccx;
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ if( data.m == 0)
+ return;
+
+ } /* if( n != 0) */
+
+ jc= data.n-1;
+ for( i = 0; i < data.m; i++ )
+ {
+ dataj.s= data.pbi[i];
+ dataj.xj= data.px[i];
+ dataj.yj= data.py[i];
+ dataj.zj= data.pz[i];
+ dataj.t1xj= data.t1x[i];
+ dataj.t1yj= data.t1y[i];
+ dataj.t1zj= data.t1z[i];
+ dataj.t2xj= data.t2x[i];
+ dataj.t2yj= data.t2y[i];
+ dataj.t2zj= data.t2z[i];
+ jc += 3;
+ acx= dataj.t1xj* crnt.cur[jc-2]+ dataj.t1yj* crnt.cur[jc-1]+ dataj.t1zj* crnt.cur[jc];
+ bcx= dataj.t2xj* crnt.cur[jc-2]+ dataj.t2yj* crnt.cur[jc-1]+ dataj.t2zj* crnt.cur[jc];
+
+ for( ipa = 0; ipa < gnd.ksymp; ipa++ )
+ {
+ dataj.ipgnd= ipa+1;
+ unere( xob, yob, zob);
+ *ex= *ex+ acx* dataj.exk+ bcx* dataj.exs;
+ *ey= *ey+ acx* dataj.eyk+ bcx* dataj.eys;
+ *ez= *ez+ acx* dataj.ezk+ bcx* dataj.ezs;
+ }
+
+ } /* for( i = 0; i < m; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute near e or h fields over a range of points */
+void nfpat( void )
+{
+ int i, j, kk;
+ long double znrt, cth=0., sth=0., ynrt, cph=0., sph=0., xnrt, xob, yob;
+ long double zob, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, xxx;
+ complex long double ex, ey, ez;
+
+ if( fpat.nfeh != 1)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "-------- NEAR ELECTRIC FIELDS --------\n"
+ " ------- LOCATION ------- ------- EX ------ ------- EY ------ ------- EZ ------\n"
+ " X Y Z MAGNITUDE PHASE MAGNITUDE PHASE MAGNITUDE PHASE\n"
+ " METERS METERS METERS VOLTS/M DEGREES VOLTS/M DEGREES VOLTS/M DEGREES" );
+ }
+ else
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "-------- NEAR MAGNETIC FIELDS ---------\n\n"
+ " ------- LOCATION ------- ------- HX ------ ------- HY ------ ------- HZ ------\n"
+ " X Y Z MAGNITUDE PHASE MAGNITUDE PHASE MAGNITUDE PHASE\n"
+ " METERS METERS METERS AMPS/M DEGREES AMPS/M DEGREES AMPS/M DEGREES" );
+ }
+
+ znrt= fpat.znr- fpat.dznr;
+ for( i = 0; i < fpat.nrz; i++ )
+ {
+ znrt += fpat.dznr;
+ if( fpat.near != 0)
+ {
+ cth= cosl( TA* znrt);
+ sth= sinl( TA* znrt);
+ }
+
+ ynrt= fpat.ynr- fpat.dynr;
+ for( j = 0; j < fpat.nry; j++ )
+ {
+ ynrt += fpat.dynr;
+ if( fpat.near != 0)
+ {
+ cph= cosl( TA* ynrt);
+ sph= sinl( TA* ynrt);
+ }
+
+ xnrt= fpat.xnr- fpat.dxnr;
+ for( kk = 0; kk < fpat.nrx; kk++ )
+ {
+ xnrt += fpat.dxnr;
+ if( fpat.near != 0)
+ {
+ xob= xnrt* sth* cph;
+ yob= xnrt* sth* sph;
+ zob= xnrt* cth;
+ }
+ else
+ {
+ xob= xnrt;
+ yob= ynrt;
+ zob= znrt;
+ }
+
+ tmp1= xob/ data.wlam;
+ tmp2= yob/ data.wlam;
+ tmp3= zob/ data.wlam;
+
+ if( fpat.nfeh != 1)
+ nefld( tmp1, tmp2, tmp3, &ex, &ey, &ez);
+ else
+ nhfld( tmp1, tmp2, tmp3, &ex, &ey, &ez);
+
+ tmp1= cabsl( ex);
+ tmp2= cang( ex);
+ tmp3= cabsl( ey);
+ tmp4= cang( ey);
+ tmp5= cabsl( ez);
+ tmp6= cang( ez);
+
+ fprintf( output_fp, "\n"
+ " %9.4LF %9.4LF %9.4LF %11.4LE %7.2LF %11.4LE %7.2LF %11.4LE %7.2LF",
+ xob, yob, zob, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6 );
+
+ if( plot.iplp1 != 2)
+ continue;
+
+ if( plot.iplp4 < 0 )
+ xxx= xob;
+ else
+ if( plot.iplp4 == 0 )
+ xxx= yob;
+ else
+ xxx= zob;
+
+ if( plot.iplp2 == 2)
+ {
+ switch( plot.iplp3 )
+ {
+ case 1:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", xxx, tmp1, tmp2 );
+ break;
+ case 2:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", xxx, tmp3, tmp4 );
+ break;
+ case 3:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", xxx, tmp5, tmp6 );
+ break;
+ case 4:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE %12.4LE %12.4LE %12.4LE %12.4LE\n",
+ xxx, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6 );
+ }
+ continue;
+ }
+
+ if( plot.iplp2 != 1)
+ continue;
+
+ switch( plot.iplp3 )
+ {
+ case 1:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", xxx, creall(ex), cimagl(ex) );
+ break;
+ case 2:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", xxx, creall(ey), cimagl(ey) );
+ break;
+ case 3:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", xxx, creall(ez), cimagl(ez) );
+ break;
+ case 4:
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE %12.4LE %12.4LE %12.4LE %12.4LE\n",
+ xxx,creall(ex),cimagl(ex),creall(ey),cimagl(ey),creall(ez),cimagl(ez) );
+ }
+ } /* for( kk = 0; kk < fpat.nrx; kk++ ) */
+
+ } /* for( j = 0; j < fpat.nry; j++ ) */
+
+ } /* for( i = 0; i < fpat.nrz; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* nhfld computes the near field at specified points in space after */
+/* the structure currents have been computed. */
+
+void nhfld( long double xob, long double yob, long double zob,
+ complex long double *hx, complex long double *hy, complex long double *hz )
+{
+ int i, jc;
+ long double ax, zp;
+ complex long double acx, bcx, ccx;
+
+ *hx=CPLX_00;
+ *hy=CPLX_00;
+ *hz=CPLX_00;
+ ax=0.;
+
+ if( data.n != 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ dataj.xj= xob- data.x[i];
+ dataj.yj= yob- data.y[i];
+ dataj.zj= zob- data.z[i];
+ zp= data.cab[i]* dataj.xj+ data.sab[i]* dataj.yj+ data.salp[i]* dataj.zj;
+
+ if( fabsl( zp) > 0.5001* data.si[i])
+ continue;
+
+ zp= dataj.xj* dataj.xj+ dataj.yj* dataj.yj+ dataj.zj* dataj.zj- zp* zp;
+ dataj.xj= data.bi[i];
+
+ if( zp > 0.9* dataj.xj* dataj.xj)
+ continue;
+
+ ax= dataj.xj;
+ break;
+ }
+
+ for( i = 0; i < data.n; i++ )
+ {
+ dataj.s= data.si[i];
+ dataj.b= data.bi[i];
+ dataj.xj= data.x[i];
+ dataj.yj= data.y[i];
+ dataj.zj= data.z[i];
+ dataj.cabj= data.cab[i];
+ dataj.sabj= data.sab[i];
+ dataj.salpj= data.salp[i];
+ hsfld( xob, yob, zob, ax);
+ acx= cmplx( crnt.air[i], crnt.aii[i]);
+ bcx= cmplx( crnt.bir[i], crnt.bii[i]);
+ ccx= cmplx( crnt.cir[i], crnt.cii[i]);
+ *hx += dataj.exk* acx+ dataj.exs* bcx+ dataj.exc* ccx;
+ *hy += dataj.eyk* acx+ dataj.eys* bcx+ dataj.eyc* ccx;
+ *hz += dataj.ezk* acx+ dataj.ezs* bcx+ dataj.ezc* ccx;
+ }
+
+ if( data.m == 0)
+ return;
+
+ } /* if( data.n != 0) */
+
+ jc= data.n-1;
+ for( i = 0; i < data.m; i++ )
+ {
+ dataj.s= data.pbi[i];
+ dataj.xj= data.px[i];
+ dataj.yj= data.py[i];
+ dataj.zj= data.pz[i];
+ dataj.t1xj= data.t1x[i];
+ dataj.t1yj= data.t1y[i];
+ dataj.t1zj= data.t1z[i];
+ dataj.t2xj= data.t2x[i];
+ dataj.t2yj= data.t2y[i];
+ dataj.t2zj= data.t2z[i];
+ hintg( xob, yob, zob);
+ jc += 3;
+ acx= dataj.t1xj* crnt.cur[jc-2]+ dataj.t1yj* crnt.cur[jc-1]+ dataj.t1zj* crnt.cur[jc];
+ bcx= dataj.t2xj* crnt.cur[jc-2]+ dataj.t2yj* crnt.cur[jc-1]+ dataj.t2zj* crnt.cur[jc];
+ *hx= *hx+ acx* dataj.exk+ bcx* dataj.exs;
+ *hy= *hy+ acx* dataj.eyk+ bcx* dataj.eys;
+ *hz= *hz+ acx* dataj.ezk+ bcx* dataj.ezs;
+ }
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* integrate over patches at wire connection point */
+void pcint( long double xi, long double yi, long double zi, long double cabi,
+ long double sabi, long double salpi, complex long double *e )
+{
+ int nint, i1, i2;
+ long double d, ds, da, gcon, fcon, xxj, xyj, xzj, xs, s1;
+ long double xss, yss, zss, s2x, s2, g1, g2, g3, g4, f2, f1;
+ complex long double e1, e2, e3, e4, e5, e6, e7, e8, e9;
+
+ nint = 10;
+ d= sqrtl( dataj.s)*.5;
+ ds=4.* d/ (long double) nint;
+ da= ds* ds;
+ gcon=1./ dataj.s;
+ fcon=1./(2.* TP* d);
+ xxj= dataj.xj;
+ xyj= dataj.yj;
+ xzj= dataj.zj;
+ xs= dataj.s;
+ dataj.s= da;
+ s1= d+ ds*.5;
+ xss= dataj.xj+ s1*( dataj.t1xj+ dataj.t2xj);
+ yss= dataj.yj+ s1*( dataj.t1yj+ dataj.t2yj);
+ zss= dataj.zj+ s1*( dataj.t1zj+ dataj.t2zj);
+ s1= s1+ d;
+ s2x= s1;
+ e1=CPLX_00;
+ e2=CPLX_00;
+ e3=CPLX_00;
+ e4=CPLX_00;
+ e5=CPLX_00;
+ e6=CPLX_00;
+ e7=CPLX_00;
+ e8=CPLX_00;
+ e9=CPLX_00;
+
+ for( i1 = 0; i1 < nint; i1++ )
+ {
+ s1= s1- ds;
+ s2= s2x;
+ xss= xss- ds* dataj.t1xj;
+ yss= yss- ds* dataj.t1yj;
+ zss= zss- ds* dataj.t1zj;
+ dataj.xj= xss;
+ dataj.yj= yss;
+ dataj.zj= zss;
+
+ for( i2 = 0; i2 < nint; i2++ )
+ {
+ s2= s2- ds;
+ dataj.xj= dataj.xj- ds* dataj.t2xj;
+ dataj.yj= dataj.yj- ds* dataj.t2yj;
+ dataj.zj= dataj.zj- ds* dataj.t2zj;
+ unere( xi, yi, zi);
+ dataj.exk= dataj.exk* cabi+ dataj.eyk* sabi+ dataj.ezk* salpi;
+ dataj.exs= dataj.exs* cabi+ dataj.eys* sabi+ dataj.ezs* salpi;
+ g1=( d+ s1)*( d+ s2)* gcon;
+ g2=( d- s1)*( d+ s2)* gcon;
+ g3=( d- s1)*( d- s2)* gcon;
+ g4=( d+ s1)*( d- s2)* gcon;
+ f2=( s1* s1+ s2* s2)* TP;
+ f1= s1/ f2-( g1- g2- g3+ g4)* fcon;
+ f2= s2/ f2-( g1+ g2- g3- g4)* fcon;
+ e1= e1+ dataj.exk* g1;
+ e2= e2+ dataj.exk* g2;
+ e3= e3+ dataj.exk* g3;
+ e4= e4+ dataj.exk* g4;
+ e5= e5+ dataj.exs* g1;
+ e6= e6+ dataj.exs* g2;
+ e7= e7+ dataj.exs* g3;
+ e8= e8+ dataj.exs* g4;
+ e9= e9+ dataj.exk* f1+ dataj.exs* f2;
+
+ } /* for( i2 = 0; i2 < nint; i2++ ) */
+
+ } /* for( i1 = 0; i1 < nint; i1++ ) */
+
+ e[0]= e1;
+ e[1]= e2;
+ e[2]= e3;
+ e[3]= e4;
+ e[4]= e5;
+ e[5]= e6;
+ e[6]= e7;
+ e[7]= e8;
+ e[8]= e9;
+ dataj.xj= xxj;
+ dataj.yj= xyj;
+ dataj.zj= xzj;
+ dataj.s= xs;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* calculates the electric field due to unit current */
+/* in the t1 and t2 directions on a patch */
+void unere( long double xob, long double yob, long double zob )
+{
+ long double zr, t1zr, t2zr, rx, ry, rz, r, tt1;
+ long double tt2, rt, xymag, px, py, cth, r2;
+ complex long double er, q1, q2, rrv, rrh, edp;
+
+ zr= dataj.zj;
+ t1zr= dataj.t1zj;
+ t2zr= dataj.t2zj;
+
+ if( dataj.ipgnd == 2)
+ {
+ zr=- zr;
+ t1zr=- t1zr;
+ t2zr=- t2zr;
+ }
+
+ rx= xob- dataj.xj;
+ ry= yob- dataj.yj;
+ rz= zob- zr;
+ r2= rx* rx+ ry* ry+ rz* rz;
+
+ if( r2 <= 1.0e-20)
+ {
+ dataj.exk=CPLX_00;
+ dataj.eyk=CPLX_00;
+ dataj.ezk=CPLX_00;
+ dataj.exs=CPLX_00;
+ dataj.eys=CPLX_00;
+ dataj.ezs=CPLX_00;
+ return;
+ }
+
+ r= sqrtl( r2);
+ tt1=- TP* r;
+ tt2= tt1* tt1;
+ rt= r2* r;
+ er= cmplx( sinl( tt1),- cosl( tt1))*( CONST2* dataj.s);
+ q1= cmplx( tt2-1., tt1)* er/ rt;
+ q2= cmplx(3.- tt2,-3.* tt1)* er/( rt* r2);
+ er = q2*( dataj.t1xj* rx+ dataj.t1yj* ry+ t1zr* rz);
+ dataj.exk= q1* dataj.t1xj+ er* rx;
+ dataj.eyk= q1* dataj.t1yj+ er* ry;
+ dataj.ezk= q1* t1zr+ er* rz;
+ er= q2*( dataj.t2xj* rx+ dataj.t2yj* ry+ t2zr* rz);
+ dataj.exs= q1* dataj.t2xj+ er* rx;
+ dataj.eys= q1* dataj.t2yj+ er* ry;
+ dataj.ezs= q1* t2zr+ er* rz;
+
+ if( dataj.ipgnd == 1)
+ return;
+
+ if( gnd.iperf == 1)
+ {
+ dataj.exk=- dataj.exk;
+ dataj.eyk=- dataj.eyk;
+ dataj.ezk=- dataj.ezk;
+ dataj.exs=- dataj.exs;
+ dataj.eys=- dataj.eys;
+ dataj.ezs=- dataj.ezs;
+ return;
+ }
+
+ xymag= sqrtl( rx* rx+ ry* ry);
+ if( xymag <= 1.0e-6)
+ {
+ px=0.;
+ py=0.;
+ cth=1.;
+ rrv=CPLX_10;
+ }
+ else
+ {
+ px=- ry/ xymag;
+ py= rx/ xymag;
+ cth= rz/ sqrtl( xymag* xymag+ rz* rz);
+ rrv= csqrtl(1.- gnd.zrati* gnd.zrati*(1.- cth* cth));
+ }
+
+ rrh= gnd.zrati* cth;
+ rrh=( rrh- rrv)/( rrh+ rrv);
+ rrv= gnd.zrati* rrv;
+ rrv=-( cth- rrv)/( cth+ rrv);
+ edp=( dataj.exk* px+ dataj.eyk* py)*( rrh- rrv);
+ dataj.exk= dataj.exk* rrv+ edp* px;
+ dataj.eyk= dataj.eyk* rrv+ edp* py;
+ dataj.ezk= dataj.ezk* rrv;
+ edp=( dataj.exs* px+ dataj.eys* py)*( rrh- rrv);
+ dataj.exs= dataj.exs* rrv+ edp* px;
+ dataj.eys= dataj.eys* rrv+ edp* py;
+ dataj.ezs= dataj.ezs* rrv;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/geometry.c b/geometry.c
new file mode 100644
index 0000000..e474f2a
--- /dev/null
+++ b/geometry.c
@@ -0,0 +1,2409 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+ *******************************************************************/
+
+#include "nec2c.h"
+
+/* common /data/ */
+extern data_t data;
+
+/* common /segj/ */
+extern segj_t segj;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/* common /plot/ */
+extern plot_t plot;
+
+/*-------------------------------------------------------------------*/
+
+/* arc generates segment geometry data for an arc of ns segments */
+void arc( int itg, int ns, long double rada,
+ long double ang1, long double ang2, long double rad )
+{
+ int ist, i, mreq;
+ long double ang, dang, xs1, xs2, zs1, zs2;
+
+ ist= data.n;
+ data.n += ns;
+ data.np= data.n;
+ data.mp= data.m;
+ data.ipsym=0;
+
+ if( ns < 1)
+ return;
+
+ if( fabsl( ang2- ang1) < 360.00001)
+ {
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (data.n+data.m) * sizeof(int) );
+
+ /* Reallocate wire buffers */
+ mreq = data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ ang= ang1* TA;
+ dang=( ang2- ang1)* TA/ ns;
+ xs1= rada* cosl( ang);
+ zs1= rada* sinl( ang);
+
+ for( i = ist; i < data.n; i++ )
+ {
+ ang += dang;
+ xs2= rada* cosl( ang);
+ zs2= rada* sinl( ang);
+ data.x1[i]= xs1;
+
+ data.y1[i]=0.;
+ data.z1[i]= zs1;
+ data.x2[i]= xs2;
+ data.y2[i]=0.;
+ data.z2[i]= zs2;
+ xs1= xs2;
+ zs1= zs2;
+ data.bi[i]= rad;
+ data.itag[i]= itg;
+
+ } /* for( i = ist; i < data.n; i++ ) */
+
+ } /* if( fabsl( ang2- ang1) < 360.00001) */
+ else
+ {
+ fprintf( output_fp, "\n ERROR -- ARC ANGLE EXCEEDS 360 DEGREES");
+ stop(-1);
+ }
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* connect sets up segment connection data in arrays icon1 and */
+/* icon2 by searching for segment ends that are in contact. */
+void conect( int ignd )
+{
+ int i, iz, ic, j, jx, ix, ixx, iseg, iend, jend, nsflg, jump, ipf;
+ long double sep=0., xi1, yi1, zi1, xi2, yi2, zi2;
+ long double slen, xa, ya, za, xs, ys, zs;
+
+ segj.maxcon = 1;
+
+ if( ignd != 0)
+ {
+ fprintf( output_fp, "\n\n GROUND PLANE SPECIFIED." );
+
+ if( ignd > 0)
+ fprintf( output_fp,
+ "\n WHERE WIRE ENDS TOUCH GROUND, CURRENT WILL"
+ " BE INTERPOLATED TO IMAGE IN GROUND PLANE.\n" );
+
+ if( data.ipsym == 2)
+ {
+ data.np=2* data.np;
+ data.mp=2* data.mp;
+ }
+
+ if( abs( data.ipsym) > 2 )
+ {
+ data.np= data.n;
+ data.mp= data.m;
+ }
+
+ /*** possibly should be error condition?? **/
+ if( data.np > data.n)
+ {
+ fprintf( output_fp,
+ "\n ERROR: NP > N IN CONECT()" );
+ stop(-1);
+ }
+
+ if( (data.np == data.n) && (data.mp == data.m) )
+ data.ipsym=0;
+
+ } /* if( ignd != 0) */
+
+ if( data.n != 0)
+ {
+ /* Allocate memory to connections */
+ mem_realloc( (void *)&data.icon1, (data.n+data.m) * sizeof(int) );
+ mem_realloc( (void *)&data.icon2, (data.n+data.m) * sizeof(int) );
+
+ for( i = 0; i < data.n; i++ )
+ {
+ data.icon1[i] = data.icon2[i] = 0;
+ iz = i+1;
+ xi1= data.x1[i];
+ yi1= data.y1[i];
+ zi1= data.z1[i];
+ xi2= data.x2[i];
+ yi2= data.y2[i];
+ zi2= data.z2[i];
+ slen= sqrtl( (xi2- xi1)*(xi2- xi1) + (yi2- yi1) *
+ (yi2- yi1) + (zi2- zi1)*(zi2- zi1) ) * SMIN;
+
+ /* determine connection data for end 1 of segment. */
+ jump = FALSE;
+ if( ignd > 0)
+ {
+ if( zi1 <= -slen)
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR -- SEGMENT"
+ " %d EXTENDS BELOW GROUND", iz );
+ stop(-1);
+ }
+
+ if( zi1 <= slen)
+ {
+ data.icon1[i]= iz;
+ data.z1[i]=0.;
+ jump = TRUE;
+
+ } /* if( zi1 <= slen) */
+
+ } /* if( ignd > 0) */
+
+ if( ! jump )
+ {
+ ic= i;
+ for( j = 1; j < data.n; j++)
+ {
+ ic++;
+ if( ic >= data.n)
+ ic=0;
+
+ sep= fabsl( xi1- data.x1[ic])+ fabsl(yi1- data.y1[ic])+ fabsl(zi1- data.z1[ic]);
+ if( sep <= slen)
+ {
+ data.icon1[i]= -(ic+1);
+ break;
+ }
+
+ sep= fabsl( xi1- data.x2[ic])+ fabsl(yi1- data.y2[ic])+ fabsl(zi1- data.z2[ic]);
+ if( sep <= slen)
+ {
+ data.icon1[i]= (ic+1);
+ break;
+ }
+
+ } /* for( j = 1; j < data.n; j++) */
+
+ } /* if( ! jump ) */
+
+ /* determine connection data for end 2 of segment. */
+ if( (ignd > 0) || jump )
+ {
+ if( zi2 <= -slen)
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR -- SEGMENT"
+ " %d EXTENDS BELOW GROUND", iz );
+ stop(-1);
+ }
+
+ if( zi2 <= slen)
+ {
+ if( data.icon1[i] == iz )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR -- SEGMENT"
+ " %d LIES IN GROUND PLANE", iz );
+ stop(-1);
+ }
+
+ data.icon2[i]= iz;
+ data.z2[i]=0.;
+ continue;
+
+ } /* if( zi2 <= slen) */
+
+ } /* if( ignd > 0) */
+
+ ic= i;
+ for( j = 1; j < data.n; j++ )
+ {
+ ic++;
+ if( ic >= data.n)
+ ic=0;
+
+ sep= fabsl(xi2- data.x1[ic])+ fabsl(yi2- data.y1[ic])+ fabsl(zi2- data.z1[ic]);
+ if( sep <= slen)
+ {
+ data.icon2[i]= (ic+1);
+ break;
+ }
+
+ sep= fabsl(xi2- data.x2[ic])+ fabsl(yi2- data.y2[ic])+ fabsl(zi2- data.z2[ic]);
+ if( sep <= slen)
+ {
+ data.icon2[i]= -(ic+1);
+ break;
+ }
+
+ } /* for( j = 1; j < data.n; j++ ) */
+
+ } /* for( i = 0; i < data.n; i++ ) */
+
+ /* find wire-surface connections for new patches */
+ if( data.m != 0)
+ {
+ ix = -1;
+ i = 0;
+ while( ++i <= data.m )
+ {
+ ix++;
+ xs= data.px[ix];
+ ys= data.py[ix];
+ zs= data.pz[ix];
+
+ for( iseg = 0; iseg < data.n; iseg++ )
+ {
+ xi1= data.x1[iseg];
+ yi1= data.y1[iseg];
+ zi1= data.z1[iseg];
+ xi2= data.x2[iseg];
+ yi2= data.y2[iseg];
+ zi2= data.z2[iseg];
+
+ /* for first end of segment */
+ slen=( fabsl(xi2- xi1)+ fabsl(yi2- yi1)+ fabsl(zi2- zi1))* SMIN;
+ sep= fabsl(xi1- xs)+ fabsl(yi1- ys)+ fabsl(zi1- zs);
+
+ /* connection - divide patch into 4 patches at present array loc. */
+ if( sep <= slen)
+ {
+ data.icon1[iseg]=PCHCON+ i;
+ ic=0;
+ subph( i, ic );
+ break;
+ }
+
+ sep= fabsl(xi2- xs)+ fabsl(yi2- ys)+ fabsl(zi2- zs);
+ if( sep <= slen)
+ {
+ data.icon2[iseg]=PCHCON+ i;
+ ic=0;
+ subph( i, ic );
+ break;
+ }
+
+ } /* for( iseg = 0; iseg < data.n; iseg++ ) */
+
+ } /* while( ++i <= data.m ) */
+
+ } /* if( data.m != 0) */
+
+ } /* if( data.n != 0) */
+
+ fprintf( output_fp, "\n\n"
+ " TOTAL SEGMENTS USED: %d SEGMENTS IN A"
+ " SYMMETRIC CELL: %d SYMMETRY FLAG: %d",
+ data.n, data.np, data.ipsym );
+
+ if( data.m > 0)
+ fprintf( output_fp, "\n"
+ " TOTAL PATCHES USED: %d PATCHES"
+ " IN A SYMMETRIC CELL: %d", data.m, data.mp );
+
+ iseg=( data.n+ data.m)/( data.np+ data.mp);
+ if( iseg != 1)
+ {
+ /*** may be error condition?? ***/
+ if( data.ipsym == 0 )
+ {
+ fprintf( output_fp,
+ "\n ERROR: IPSYM=0 IN CONECT()" );
+ stop(-1);
+ }
+
+ if( data.ipsym < 0 )
+ fprintf( output_fp,
+ "\n STRUCTURE HAS %d FOLD ROTATIONAL SYMMETRY\n", iseg );
+ else
+ {
+ ic= iseg/2;
+ if( iseg == 8)
+ ic=3;
+ fprintf( output_fp,
+ "\n STRUCTURE HAS %d PLANES OF SYMMETRY\n", ic );
+ } /* if( data.ipsym < 0 ) */
+
+ } /* if( iseg == 1) */
+
+ if( data.n == 0)
+ return;
+
+ /* Allocate to connection buffers */
+ mem_realloc( (void *)&segj.jco, segj.maxcon * sizeof(int) );
+
+ /* adjust connected seg. ends to exactly coincide. print junctions */
+ /* of 3 or more seg. also find old seg. connecting to new seg. */
+ iseg = 0;
+ ipf = FALSE;
+ for( j = 0; j < data.n; j++ )
+ {
+ jx = j+1;
+ iend=-1;
+ jend=-1;
+ ix= data.icon1[j];
+ ic=1;
+ segj.jco[0]= -jx;
+ xa= data.x1[j];
+ ya= data.y1[j];
+ za= data.z1[j];
+
+ while( TRUE )
+ {
+ if( (ix != 0) && (ix != (j+1)) && (ix <= PCHCON) )
+ {
+ nsflg=0;
+
+ do
+ {
+ if( ix == 0 )
+ {
+ fprintf( output_fp,
+ "\n CONNECT - SEGMENT CONNECTION ERROR FOR SEGMENT: %d", ix );
+ stop(-1);
+ }
+
+ if( ix < 0 )
+ ix= -ix;
+ else
+ jend= -jend;
+
+ jump = FALSE;
+
+ if( ix == jx )
+ break;
+
+ if( ix < jx )
+ {
+ jump = TRUE;
+ break;
+ }
+
+ /* Record max. no. of connections */
+ ic++;
+ if( ic >= segj.maxcon )
+ {
+ segj.maxcon = ic+1;
+ mem_realloc( (void *)&segj.jco, segj.maxcon * sizeof(int) );
+ }
+ segj.jco[ic-1]= ix* jend;
+
+ if( ix > 0)
+ nsflg=1;
+
+ ixx = ix-1;
+ if( jend != 1)
+ {
+ xa= xa+ data.x1[ixx];
+ ya= ya+ data.y1[ixx];
+ za= za+ data.z1[ixx];
+ ix= data.icon1[ixx];
+ continue;
+ }
+
+ xa= xa+ data.x2[ixx];
+ ya= ya+ data.y2[ixx];
+ za= za+ data.z2[ixx];
+ ix= data.icon2[ixx];
+
+ } /* do */
+ while( ix != 0 );
+
+ if( jump && (iend == 1) )
+ break;
+ else
+ if( jump )
+ {
+ iend=1;
+ jend=1;
+ ix= data.icon2[j];
+ ic=1;
+ segj.jco[0]= jx;
+ xa= data.x2[j];
+ ya= data.y2[j];
+ za= data.z2[j];
+ continue;
+ }
+
+ sep= (long double)ic;
+ xa= xa/ sep;
+ ya= ya/ sep;
+ za= za/ sep;
+
+ for( i = 0; i < ic; i++ )
+ {
+ ix= segj.jco[i];
+ if( ix <= 0)
+ {
+ ix=- ix;
+ ixx = ix-1;
+ data.x1[ixx]= xa;
+ data.y1[ixx]= ya;
+ data.z1[ixx]= za;
+ continue;
+ }
+
+ ixx = ix-1;
+ data.x2[ixx]= xa;
+ data.y2[ixx]= ya;
+ data.z2[ixx]= za;
+
+ } /* for( i = 0; i < ic; i++ ) */
+
+ if( ic >= 3)
+ {
+ if( ! ipf )
+ {
+ fprintf( output_fp, "\n\n"
+ " ---------- MULTIPLE WIRE JUNCTIONS ----------\n"
+ " JUNCTION SEGMENTS (- FOR END 1, + FOR END 2)" );
+ ipf = TRUE;
+ }
+
+ iseg++;
+ fprintf( output_fp, "\n %5d ", iseg );
+
+ for( i = 1; i <= ic; i++ )
+ {
+ fprintf( output_fp, "%5d", segj.jco[i-1] );
+ if( !(i % 20) )
+ fprintf( output_fp, "\n " );
+ }
+
+ } /* if( ic >= 3) */
+
+ } /*if( (ix != 0) && (ix != j) && (ix <= PCHCON) ) */
+
+ if( iend == 1)
+ break;
+
+ iend=1;
+ jend=1;
+ ix= data.icon2[j];
+ ic=1;
+ segj.jco[0]= jx;
+ xa= data.x2[j];
+ ya= data.y2[j];
+ za= data.z2[j];
+
+ } /* while( TRUE ) */
+
+ } /* for( j = 0; j < data.n; j++ ) */
+
+ mem_realloc( (void *)&segj.ax, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *)&segj.bx, segj.maxcon * sizeof(long double) );
+ mem_realloc( (void *)&segj.cx, segj.maxcon * sizeof(long double) );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* datagn is the main routine for input of geometry data. */
+void datagn( void )
+{
+ char gm[3];
+ char ifx[2] = {'*', 'X'}, ify[2]={'*','Y'}, ifz[2]={'*','Z'};
+ char ipt[4] = { 'P', 'R', 'T', 'Q' };
+
+ /* input card mnemonic list */
+ /* "XT" stands for "exit", added for testing */
+#define GM_NUM 12
+ char *atst[GM_NUM] =
+ {
+ "GW", "GX", "GR", "GS", "GE", "GM", \
+ "SP", "SM", "GA", "SC", "GH", "GF"
+ };
+
+ int nwire, isct, iphd, i1, i2, itg, iy, iz, mreq;
+ int ix, i, ns, gm_num; /* geometry card id as a number */
+ long double rad, xs1, xs2, ys1, ys2, zs1, zs2, x4=0, y4=0, z4=0;
+ long double x3=0, y3=0, z3=0, xw1, xw2, yw1, yw2, zw1, zw2;
+ long double dummy;
+
+ data.ipsym=0;
+ nwire=0;
+ data.n=0;
+ data.np=0;
+ data.m=0;
+ data.mp=0;
+ isct=0;
+ iphd = FALSE;
+
+ /* read geometry data card and branch to */
+ /* section for operation requested */
+ do
+ {
+ readgm( gm, &itg, &ns, &xw1, &yw1, &zw1, &xw2, &yw2, &zw2, &rad);
+
+ /* identify card id mnemonic */
+ for( gm_num = 0; gm_num < GM_NUM; gm_num++ )
+ if( strncmp( gm, atst[gm_num], 2) == 0 )
+ break;
+
+ if( iphd == FALSE )
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "-------- STRUCTURE SPECIFICATION --------\n"
+ " "
+ "COORDINATES MUST BE INPUT IN\n"
+ " "
+ "METERS OR BE SCALED TO METERS\n"
+ " "
+ "BEFORE STRUCTURE INPUT IS ENDED\n" );
+
+ fprintf( output_fp, "\n"
+ " WIRE "
+ " SEG FIRST LAST TAG\n"
+ " No: X1 Y1 Z1 X2 "
+ " Y2 Z2 RADIUS No: SEG SEG No:" );
+
+ iphd=1;
+ }
+
+ if( gm_num != 10 )
+ isct=0;
+
+ switch( gm_num )
+ {
+ case 0: /* "gw" card, generate segment data for straight wire. */
+
+ nwire++;
+ i1= data.n+1;
+ i2= data.n+ ns;
+
+ fprintf( output_fp, "\n"
+ " %5d %10.4LF %10.4LF %10.4LF %10.4LF"
+ " %10.4LF %10.4LF %10.4LF %5d %5d %5d %4d",
+ nwire, xw1, yw1, zw1, xw2, yw2, zw2, rad, ns, i1, i2, itg );
+
+ if( rad != 0)
+ {
+ xs1=1.;
+ ys1=1.;
+ }
+ else
+ {
+ readgm( gm, &ix, &iy, &xs1, &ys1, &zs1,
+ &dummy, &dummy, &dummy, &dummy);
+
+ if( strcmp(gm, "GC" ) != 0 )
+ {
+ fprintf( output_fp, "\n GEOMETRY DATA CARD ERROR" );
+ stop(-1);
+ }
+
+ fprintf( output_fp,
+ "\n ABOVE WIRE IS TAPERED. SEGMENT LENGTH RATIO: %9.5LF\n"
+ " "
+ "RADIUS FROM: %9.5LF TO: %9.5LF", xs1, ys1, zs1 );
+
+ if( (ys1 == 0) || (zs1 == 0) )
+ {
+ fprintf( output_fp, "\n GEOMETRY DATA CARD ERROR" );
+ stop(-1);
+ }
+
+ rad= ys1;
+ ys1= powl( (zs1/ys1), (1./(ns-1.)) );
+ }
+
+ wire( xw1, yw1, zw1, xw2, yw2, zw2, rad, xs1, ys1, ns, itg);
+
+ continue;
+
+ /* reflect structure along x,y, or z */
+ /* axes or rotate to form cylinder. */
+ case 1: /* "gx" card */
+
+ iy= ns/10;
+ iz= ns- iy*10;
+ ix= iy/10;
+ iy= iy- ix*10;
+
+ if( ix != 0)
+ ix=1;
+ if( iy != 0)
+ iy=1;
+ if( iz != 0)
+ iz=1;
+
+ fprintf( output_fp,
+ "\n STRUCTURE REFLECTED ALONG THE AXES %c %c %c"
+ " - TAGS INCREMENTED BY %d\n",
+ ifx[ix], ify[iy], ifz[iz], itg );
+
+ reflc( ix, iy, iz, itg, ns);
+
+ continue;
+
+ case 2: /* "gr" card */
+
+ fprintf( output_fp,
+ "\n STRUCTURE ROTATED ABOUT Z-AXIS %d TIMES"
+ " - LABELS INCREMENTED BY %d\n", ns, itg );
+
+ ix=-1;
+ iz = 0;
+ reflc( ix, iy, iz, itg, ns);
+
+ continue;
+
+ case 3: /* "gs" card, scale structure dimensions by factor xw1. */
+
+ if( data.n > 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ data.x1[i]= data.x1[i]* xw1;
+ data.y1[i]= data.y1[i]* xw1;
+ data.z1[i]= data.z1[i]* xw1;
+ data.x2[i]= data.x2[i]* xw1;
+ data.y2[i]= data.y2[i]* xw1;
+ data.z2[i]= data.z2[i]* xw1;
+ data.bi[i]= data.bi[i]* xw1;
+ }
+ } /* if( data.n >= n2) */
+
+ if( data.m > 0)
+ {
+ yw1= xw1* xw1;
+ for( i = 0; i < data.m; i++ )
+ {
+ data.px[i]= data.px[i]* xw1;
+ data.py[i]= data.py[i]* xw1;
+ data.pz[i]= data.pz[i]* xw1;
+ data.pbi[i]= data.pbi[i]* yw1;
+ }
+ } /* if( data.m >= m2) */
+
+ fprintf( output_fp,
+ "\n STRUCTURE SCALED BY FACTOR: %10.5LF", xw1 );
+
+ continue;
+
+ case 4: /* "ge" card, terminate structure geometry input. */
+
+ if( ns != 0)
+ {
+ plot.iplp1=1;
+ plot.iplp2=1;
+ }
+
+ conect( itg);
+
+ if( data.n != 0)
+ {
+ /* Allocate wire buffers */
+ mreq = data.n * sizeof(long double);
+ mem_realloc( (void *)&data.si, mreq );
+ mem_realloc( (void *)&data.sab, mreq );
+ mem_realloc( (void *)&data.cab, mreq );
+ mem_realloc( (void *)&data.salp, mreq );
+ mem_realloc( (void *)&data.x, mreq );
+ mem_realloc( (void *)&data.y, mreq );
+ mem_realloc( (void *)&data.z, mreq );
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ " ---------- SEGMENTATION DATA ----------\n"
+ " "
+ " COORDINATES IN METERS\n"
+ " "
+ " I+ AND I- INDICATE THE SEGMENTS BEFORE AND AFTER I\n" );
+
+ fprintf( output_fp, "\n"
+ " SEG COORDINATES OF SEGM CENTER SEGM ORIENTATION"
+ " ANGLES WIRE CONNECTION DATA TAG\n"
+ " No: X Y Z LENGTH ALPHA "
+ " BETA RADIUS I- I I+ No:" );
+
+ for( i = 0; i < data.n; i++ )
+ {
+ xw1= data.x2[i]- data.x1[i];
+ yw1= data.y2[i]- data.y1[i];
+ zw1= data.z2[i]- data.z1[i];
+ data.x[i]=( data.x1[i]+ data.x2[i])/2.;
+ data.y[i]=( data.y1[i]+ data.y2[i])/2.;
+ data.z[i]=( data.z1[i]+ data.z2[i])/2.;
+ xw2= xw1* xw1+ yw1* yw1+ zw1* zw1;
+ yw2= sqrtl( xw2);
+ yw2=( xw2/ yw2+ yw2)*.5;
+ data.si[i]= yw2;
+ data.cab[i]= xw1/ yw2;
+ data.sab[i]= yw1/ yw2;
+ xw2= zw1/ yw2;
+
+ if( xw2 > 1.)
+ xw2=1.;
+ if( xw2 < -1.)
+ xw2=-1.;
+
+ data.salp[i]= xw2;
+ xw2= asinl( xw2)* TD;
+ yw2= atan2l( yw1, xw1)* TD;
+
+ fprintf( output_fp, "\n"
+ " %5d %9.4LF %9.4LF %9.4LF %9.4LF"
+ " %9.4LF %9.4LF %9.4LF %5d %5d %5d %5d",
+ i+1, data.x[i], data.y[i], data.z[i], data.si[i], xw2, yw2,
+ data.bi[i], data.icon1[i], i+1, data.icon2[i], data.itag[i] );
+
+ if( plot.iplp1 == 1)
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE "
+ "%12.4LE %12.4LE %12.4LE %12.4LE %5d %5d %5d\n",
+ data.x[i],data.y[i],data.z[i],data.si[i],xw2,yw2,
+ data.bi[i],data.icon1[i],i+1,data.icon2[i] );
+
+ if( (data.si[i] <= 1.e-20) || (data.bi[i] <= 0.) )
+ {
+ fprintf( output_fp, "\n SEGMENT DATA ERROR" );
+ stop(-1);
+ }
+
+ } /* for( i = 0; i < data.n; i++ ) */
+
+ } /* if( data.n != 0) */
+
+ if( data.m != 0)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ " --------- SURFACE PATCH DATA ---------\n"
+ " "
+ " COORDINATES IN METERS\n\n"
+ " PATCH COORD. OF PATCH CENTER UNIT NORMAL VECTOR "
+ " PATCH COMPONENTS OF UNIT TANGENT VECTORS\n"
+ " No: X Y Z X Y Z "
+ " AREA X1 Y1 Z1 X2 Y2 Z2" );
+
+ for( i = 0; i < data.m; i++ )
+ {
+ xw1=( data.t1y[i]* data.t2z[i]- data.t1z[i]* data.t2y[i])* data.psalp[i];
+ yw1=( data.t1z[i]* data.t2x[i]- data.t1x[i]* data.t2z[i])* data.psalp[i];
+ zw1=( data.t1x[i]* data.t2y[i]- data.t1y[i]* data.t2x[i])* data.psalp[i];
+
+ fprintf( output_fp, "\n"
+ " %4d %10.5LF %10.5LF %10.5LF %8.4LF %8.4LF %8.4LF"
+ " %10.5LF %8.4LF %8.4LF %8.4LF %8.4LF %8.4LF %8.4LF",
+ i+1, data.px[i], data.py[i], data.pz[i], xw1, yw1, zw1, data.pbi[i],
+ data.t1x[i], data.t1y[i], data.t1z[i], data.t2x[i], data.t2y[i], data.t2z[i] );
+
+ } /* for( i = 0; i < data.m; i++ ) */
+
+ } /* if( data.m == 0) */
+
+ data.npm = data.n+data.m;
+ data.np2m = data.n+2*data.m;
+ data.np3m = data.n+3*data.m;
+
+ return;
+
+ /* "gm" card, move structure or reproduce */
+ /* original structure in new positions. */
+ case 5:
+
+ fprintf( output_fp,
+ "\n THE STRUCTURE HAS BEEN MOVED, MOVE DATA CARD IS:\n"
+ " %3d %5d %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF",
+ itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, rad );
+
+ xw1= xw1* TA;
+ yw1= yw1* TA;
+ zw1= zw1* TA;
+
+ move( xw1, yw1, zw1, xw2, yw2, zw2, (int)( rad+.5), ns, itg);
+ continue;
+
+ case 6: /* "sp" card, generate single new patch */
+
+ i1= data.m+1;
+ ns++;
+
+ if( itg != 0)
+ {
+ fprintf( output_fp, "\n PATCH DATA ERROR" );
+ stop(-1);
+ }
+
+ fprintf( output_fp, "\n"
+ " %5d%c %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF",
+ i1, ipt[ns-1], xw1, yw1, zw1, xw2, yw2, zw2 );
+
+ if( (ns == 2) || (ns == 4) )
+ isct=1;
+
+ if( ns > 1)
+ {
+ readgm( gm, &ix, &iy, &x3, &y3, &z3, &x4, &y4, &z4, &dummy);
+
+ if( (ns == 2) || (itg > 0) )
+ {
+ x4= xw1+ x3- xw2;
+ y4= yw1+ y3- yw2;
+ z4= zw1+ z3- zw2;
+ }
+
+ fprintf( output_fp, "\n"
+ " %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF",
+ x3, y3, z3, x4, y4, z4 );
+
+ if( strcmp(gm, "SC") != 0 )
+ {
+ fprintf( output_fp, "\n PATCH DATA ERROR" );
+ stop(-1);
+ }
+
+ } /* if( ns > 1) */
+ else
+ {
+ xw2= xw2* TA;
+ yw2= yw2* TA;
+ }
+
+ patch( itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, x3, y3, z3, x4, y4, z4);
+
+ continue;
+
+ case 7: /* "sm" card, generate multiple-patch surface */
+
+ i1= data.m+1;
+ fprintf( output_fp, "\n"
+ " %5d%c %10.5LF %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF"
+ " SURFACE - %d BY %d PATCHES",
+ i1, ipt[1], xw1, yw1, zw1, xw2, yw2, zw2, itg, ns );
+
+ if( (itg < 1) || (ns < 1) )
+ {
+ fprintf( output_fp, "\n PATCH DATA ERROR" );
+ stop(-1);
+ }
+
+ readgm( gm, &ix, &iy, &x3, &y3, &z3, &x4, &y4, &z4, &dummy);
+
+ if( (ns == 2) || (itg > 0) )
+ {
+ x4= xw1+ x3- xw2;
+ y4= yw1+ y3- yw2;
+ z4= zw1+ z3- zw2;
+ }
+
+ fprintf( output_fp, "\n"
+ " %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF",
+ x3, y3, z3, x4, y4, z4 );
+
+ if( strcmp(gm, "SC" ) != 0 )
+ {
+ fprintf( output_fp, "\n PATCH DATA ERROR" );
+ stop(-1);
+ }
+
+ patch( itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, x3, y3, z3, x4, y4, z4);
+
+ continue;
+
+ case 8: /* "ga" card, generate segment data for wire arc */
+
+ nwire++;
+ i1= data.n+1;
+ i2= data.n+ ns;
+
+ fprintf( output_fp, "\n"
+ " %5d ARC RADIUS: %9.5LF FROM: %8.3LF TO: %8.3LF DEGREES"
+ " %11.5LF %5d %5d %5d %4d",
+ nwire, xw1, yw1, zw1, xw2, ns, i1, i2, itg );
+
+ arc( itg, ns, xw1, yw1, zw1, xw2);
+
+ continue;
+
+ case 9: /* "sc" card */
+
+ if( isct == 0)
+ {
+ fprintf( output_fp, "\n PATCH DATA ERROR" );
+ stop(-1);
+ }
+
+ i1= data.m+1;
+ ns++;
+
+ if( (itg != 0) || ((ns != 2) && (ns != 4)) )
+ {
+ fprintf( output_fp, "\n PATCH DATA ERROR" );
+ stop(-1);
+ }
+
+ xs1= x4;
+ ys1= y4;
+ zs1= z4;
+ xs2= x3;
+ ys2= y3;
+ zs2= z3;
+ x3= xw1;
+ y3= yw1;
+ z3= zw1;
+
+ if( ns == 4)
+ {
+ x4= xw2;
+ y4= yw2;
+ z4= zw2;
+ }
+
+ xw1= xs1;
+ yw1= ys1;
+ zw1= zs1;
+ xw2= xs2;
+ yw2= ys2;
+ zw2= zs2;
+
+ if( ns != 4)
+ {
+ x4= xw1+ x3- xw2;
+ y4= yw1+ y3- yw2;
+ z4= zw1+ z3- zw2;
+ }
+
+ fprintf( output_fp, "\n"
+ " %5d%c %10.5LF %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF",
+ i1, ipt[ns-1], xw1, yw1, zw1, xw2, yw2, zw2 );
+
+ fprintf( output_fp, "\n"
+ " %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF %11.5LF",
+ x3, y3, z3, x4, y4, z4 );
+
+ patch( itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, x3, y3, z3, x4, y4, z4);
+
+ continue;
+
+ case 10: /* "gh" card, generate helix */
+
+ nwire++;
+ i1= data.n+1;
+ i2= data.n+ ns;
+
+ fprintf( output_fp, "\n"
+ " %5d HELIX STRUCTURE - SPACING OF TURNS: %8.3LF AXIAL"
+ " LENGTH: %8.3LF %8.3LF %5d %5d %5d %4d\n "
+ " RADIUS X1:%8.3LF Y1:%8.3LF X2:%8.3LF Y2:%8.3LF ",
+ nwire, xw1, yw1, rad, ns, i1, i2, itg, zw1, xw2, yw2, zw2 );
+
+ helix( xw1, yw1, zw1, xw2, yw2, zw2, rad, ns, itg);
+
+ continue;
+
+ case 11: /* "gf" card, not supported */
+ abort_on_error(-5);
+
+ default: /* error message */
+
+ fprintf( output_fp, "\n GEOMETRY DATA CARD ERROR" );
+ fprintf( output_fp, "\n"
+ " %2s %3d %5d %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF %10.5LF",
+ gm, itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, rad );
+
+ stop(-1);
+
+ } /* switch( gm_num ) */
+
+ } /* do */
+ while( TRUE );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* subroutine helix generates segment geometry */
+/* data for a helix of ns segments */
+void helix( long double s, long double hl, long double a1, long double b1,
+ long double a2, long double b2, long double rad, int ns, int itg )
+{
+ int ist, i, mreq;
+ long double turns, zinc, copy, sangle, hdia, turn, pitch, hmaj, hmin;
+
+ ist= data.n;
+ data.n += ns;
+ data.np= data.n;
+ data.mp= data.m;
+ data.ipsym=0;
+
+ if( ns < 1)
+ return;
+
+ turns= fabsl( hl/ s);
+ zinc= fabsl( hl/ ns);
+
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (data.n+data.m) * sizeof(int) );/*????*/
+
+ /* Reallocate wire buffers */
+ mreq = data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ data.z1[ist]=0.;
+ for( i = ist; i < data.n; i++ )
+ {
+ data.bi[i]= rad;
+ data.itag[i]= itg;
+
+ if( i != ist )
+ data.z1[i]= data.z1[i-1]+ zinc;
+
+ data.z2[i]= data.z1[i]+ zinc;
+
+ if( a2 == a1)
+ {
+ if( b1 == 0.)
+ b1= a1;
+
+ data.x1[i]= a1* cosl(2.* PI* data.z1[i]/ s);
+ data.y1[i]= b1* sinl(2.* PI* data.z1[i]/ s);
+ data.x2[i]= a1* cosl(2.* PI* data.z2[i]/ s);
+ data.y2[i]= b1* sinl(2.* PI* data.z2[i]/ s);
+ }
+ else
+ {
+ if( b2 == 0.)
+ b2= a2;
+
+ data.x1[i]=( a1+( a2- a1)* data.z1[i]/ fabsl( hl))* cosl(2.* PI* data.z1[i]/ s);
+ data.y1[i]=( b1+( b2- b1)* data.z1[i]/ fabsl( hl))* sinl(2.* PI* data.z1[i]/ s);
+ data.x2[i]=( a1+( a2- a1)* data.z2[i]/ fabsl( hl))* cosl(2.* PI* data.z2[i]/ s);
+ data.y2[i]=( b1+( b2- b1)* data.z2[i]/ fabsl( hl))* sinl(2.* PI* data.z2[i]/ s);
+
+ } /* if( a2 == a1) */
+
+ if( hl > 0.)
+ continue;
+
+ copy= data.x1[i];
+ data.x1[i]= data.y1[i];
+ data.y1[i]= copy;
+ copy= data.x2[i];
+ data.x2[i]= data.y2[i];
+ data.y2[i]= copy;
+
+ } /* for( i = ist; i < data.n; i++ ) */
+
+ if( a2 != a1)
+ {
+ sangle= atanl( a2/( fabsl( hl)+( fabsl( hl)* a1)/( a2- a1)));
+ fprintf( output_fp,
+ "\n THE CONE ANGLE OF THE SPIRAL IS %10.4LF", sangle );
+ return;
+ }
+
+ if( a1 == b1)
+ {
+ hdia=2.* a1;
+ turn= hdia* PI;
+ pitch= atanl( s/( PI* hdia));
+ turn= turn/ cosl( pitch);
+ pitch=180.* pitch/ PI;
+ }
+ else
+ {
+ if( a1 >= b1)
+ {
+ hmaj=2.* a1;
+ hmin=2.* b1;
+ }
+ else
+ {
+ hmaj=2.* b1;
+ hmin=2.* a1;
+ }
+
+ hdia= sqrtl(( hmaj*hmaj+ hmin*hmin)/2* hmaj);
+ turn=2.* PI* hdia;
+ pitch=(180./ PI)* atanl( s/( PI* hdia));
+
+ } /* if( a1 == b1) */
+
+ fprintf( output_fp, "\n"
+ " THE PITCH ANGLE IS: %.4LF THE LENGTH OF WIRE/TURN IS: %.4LF",
+ pitch, turn );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* isegno returns the segment number of the mth segment having the */
+/* tag number itagi. if itagi=0 segment number m is returned. */
+int isegno( int itagi, int mx)
+{
+ int icnt, i, iseg;
+
+ if( mx <= 0)
+ {
+ fprintf( output_fp,
+ "\n CHECK DATA, PARAMETER SPECIFYING SEGMENT"
+ " POSITION IN A GROUP OF EQUAL TAGS MUST NOT BE ZERO" );
+ stop(-1);
+ }
+
+ icnt=0;
+ if( itagi == 0)
+ {
+ iseg = mx;
+ return( iseg );
+ }
+
+ if( data.n > 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ if( data.itag[i] != itagi )
+ continue;
+
+ icnt++;
+ if( icnt == mx)
+ {
+ iseg= i+1;
+ return( iseg );
+ }
+
+ } /* for( i = 0; i < data.n; i++ ) */
+
+ } /* if( data.n > 0) */
+
+ fprintf( output_fp, "\n\n"
+ " NO SEGMENT HAS AN ITAG OF %d", itagi );
+ stop(-1);
+
+ return(0);
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* subroutine move moves the structure with respect to its */
+/* coordinate system or reproduces structure in new positions. */
+/* structure is rotated about x,y,z axes by rox,roy,roz */
+/* respectively, then shifted by xs,ys,zs */
+void move( long double rox, long double roy, long double roz, long double xs,
+ long double ys, long double zs, int its, int nrpt, int itgi )
+{
+ int nrp, ix, i1, k, ir, i, ii, mreq;
+ long double sps, cps, sth, cth, sph, cph, xx, xy;
+ long double xz, yx, yy, yz, zx, zy, zz, xi, yi, zi;
+
+ if( fabsl( rox)+ fabsl( roy) > 1.0e-10)
+ data.ipsym= data.ipsym*3;
+
+ sps= sinl( rox);
+ cps= cosl( rox);
+ sth= sinl( roy);
+ cth= cosl( roy);
+ sph= sinl( roz);
+ cph= cosl( roz);
+ xx= cph* cth;
+ xy= cph* sth* sps- sph* cps;
+ xz= cph* sth* cps+ sph* sps;
+ yx= sph* cth;
+ yy= sph* sth* sps+ cph* cps;
+ yz= sph* sth* cps- cph* sps;
+ zx=- sth;
+ zy= cth* sps;
+ zz= cth* cps;
+
+ if( nrpt == 0)
+ nrp=1;
+ else
+ nrp= nrpt;
+
+ ix=1;
+ if( data.n > 0)
+ {
+ i1= isegno( its, 1);
+ if( i1 < 1)
+ i1= 1;
+
+ ix= i1;
+ if( nrpt == 0)
+ k= i1-1;
+ else
+ {
+ k= data.n;
+ /* Reallocate tags buffer */
+ mreq = data.n+data.m + (data.n+1-i1)*nrpt;
+ mem_realloc( (void *)&data.itag, mreq * sizeof(int) );
+
+ /* Reallocate wire buffers */
+ mreq = (data.n+(data.n+1-i1)*nrpt) * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+ }
+
+ for( ir = 0; ir < nrp; ir++ )
+ {
+ for( i = i1-1; i < data.n; i++ )
+ {
+ xi= data.x1[i];
+ yi= data.y1[i];
+ zi= data.z1[i];
+ data.x1[k]= xi* xx+ yi* xy+ zi* xz+ xs;
+ data.y1[k]= xi* yx+ yi* yy+ zi* yz+ ys;
+ data.z1[k]= xi* zx+ yi* zy+ zi* zz+ zs;
+ xi= data.x2[i];
+ yi= data.y2[i];
+ zi= data.z2[i];
+ data.x2[k]= xi* xx+ yi* xy+ zi* xz+ xs;
+ data.y2[k]= xi* yx+ yi* yy+ zi* yz+ ys;
+ data.z2[k]= xi* zx+ yi* zy+ zi* zz+ zs;
+ data.bi[k]= data.bi[i];
+ data.itag[k]= data.itag[i];
+ if( data.itag[i] != 0)
+ data.itag[k]= data.itag[i]+ itgi;
+
+ k++;
+
+ } /* for( i = i1; i < data.n; i++ ) */
+
+ i1= data.n+1;
+ data.n= k;
+
+ } /* for( ir = 0; ir < nrp; ir++ ) */
+
+ } /* if( data.n >= n2) */
+
+ if( data.m > 0)
+ {
+ i1 = 0;
+ if( nrpt == 0)
+ k= 0;
+ else
+ k = data.m;
+
+ /* Reallocate patch buffers */
+ mreq = data.m * (1+nrpt) * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ for( ii = 0; ii < nrp; ii++ )
+ {
+ for( i = i1; i < data.m; i++ )
+ {
+ xi= data.px[i];
+ yi= data.py[i];
+ zi= data.pz[i];
+ data.px[k]= xi* xx+ yi* xy+ zi* xz+ xs;
+ data.py[k]= xi* yx+ yi* yy+ zi* yz+ ys;
+ data.pz[k]= xi* zx+ yi* zy+ zi* zz+ zs;
+ xi= data.t1x[i];
+ yi= data.t1y[i];
+ zi= data.t1z[i];
+ data.t1x[k]= xi* xx+ yi* xy+ zi* xz;
+ data.t1y[k]= xi* yx+ yi* yy+ zi* yz;
+ data.t1z[k]= xi* zx+ yi* zy+ zi* zz;
+ xi= data.t2x[i];
+ yi= data.t2y[i];
+ zi= data.t2z[i];
+ data.t2x[k]= xi* xx+ yi* xy+ zi* xz;
+ data.t2y[k]= xi* yx+ yi* yy+ zi* yz;
+ data.t2z[k]= xi* zx+ yi* zy+ zi* zz;
+ data.psalp[k]= data.psalp[i];
+ data.pbi[k]= data.pbi[i];
+ k++;
+
+ } /* for( i = i1; i < data.m; i++ ) */
+
+ i1= data.m;
+ data.m = k;
+
+ } /* for( ii = 0; ii < nrp; ii++ ) */
+
+ } /* if( data.m >= m2) */
+
+ if( (nrpt == 0) && (ix == 1) )
+ return;
+
+ data.np= data.n;
+ data.mp= data.m;
+ data.ipsym=0;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* patch generates and modifies patch geometry data */
+void patch( int nx, int ny,
+ long double ax1, long double ay1, long double az1,
+ long double ax2, long double ay2, long double az2,
+ long double ax3, long double ay3, long double az3,
+ long double ax4, long double ay4, long double az4 )
+{
+ int mi, ntp, iy, ix, mreq;
+ long double s1x=0., s1y=0., s1z=0., s2x=0., s2y=0., s2z=0., xst=0.;
+ long double znv, xnv, ynv, xa, xn2, yn2, zn2, salpn, xs, ys, zs, xt, yt, zt;
+
+ /* new patches. for nx=0, ny=1,2,3,4 patch is (respectively) */
+ /* arbitrary, rectagular, triangular, or quadrilateral. */
+ /* for nx and ny > 0 a rectangular surface is produced with */
+ /* nx by ny rectangular patches. */
+
+ data.m++;
+ mi= data.m-1;
+
+ /* Reallocate patch buffers */
+ mreq = data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ if( nx > 0)
+ ntp=2;
+ else
+ ntp= ny;
+
+ if( ntp <= 1)
+ {
+ data.px[mi]= ax1;
+ data.py[mi]= ay1;
+ data.pz[mi]= az1;
+ data.pbi[mi]= az2;
+ znv= cosl( ax2);
+ xnv= znv* cosl( ay2);
+ ynv= znv* sinl( ay2);
+ znv= sinl( ax2);
+ xa= sqrtl( xnv* xnv+ ynv* ynv);
+
+ if( xa >= 1.0e-6)
+ {
+ data.t1x[mi]=- ynv/ xa;
+ data.t1y[mi]= xnv/ xa;
+ data.t1z[mi]=0.;
+ }
+ else
+ {
+ data.t1x[mi]=1.;
+ data.t1y[mi]=0.;
+ data.t1z[mi]=0.;
+ }
+
+ } /* if( ntp <= 1) */
+ else
+ {
+ s1x= ax2- ax1;
+ s1y= ay2- ay1;
+ s1z= az2- az1;
+ s2x= ax3- ax2;
+ s2y= ay3- ay2;
+ s2z= az3- az2;
+
+ if( nx != 0)
+ {
+ s1x= s1x/ nx;
+ s1y= s1y/ nx;
+ s1z= s1z/ nx;
+ s2x= s2x/ ny;
+ s2y= s2y/ ny;
+ s2z= s2z/ ny;
+ }
+
+ xnv= s1y* s2z- s1z* s2y;
+ ynv= s1z* s2x- s1x* s2z;
+ znv= s1x* s2y- s1y* s2x;
+ xa= sqrtl( xnv* xnv+ ynv* ynv+ znv* znv);
+ xnv= xnv/ xa;
+ ynv= ynv/ xa;
+ znv= znv/ xa;
+ xst= sqrtl( s1x* s1x+ s1y* s1y+ s1z* s1z);
+ data.t1x[mi]= s1x/ xst;
+ data.t1y[mi]= s1y/ xst;
+ data.t1z[mi]= s1z/ xst;
+
+ if( ntp <= 2)
+ {
+ data.px[mi]= ax1+.5*( s1x+ s2x);
+ data.py[mi]= ay1+.5*( s1y+ s2y);
+ data.pz[mi]= az1+.5*( s1z+ s2z);
+ data.pbi[mi]= xa;
+ }
+ else
+ {
+ if( ntp != 4)
+ {
+ data.px[mi]=( ax1+ ax2+ ax3)/3.;
+ data.py[mi]=( ay1+ ay2+ ay3)/3.;
+ data.pz[mi]=( az1+ az2+ az3)/3.;
+ data.pbi[mi]=.5* xa;
+ }
+ else
+ {
+ s1x= ax3- ax1;
+ s1y= ay3- ay1;
+ s1z= az3- az1;
+ s2x= ax4- ax1;
+ s2y= ay4- ay1;
+ s2z= az4- az1;
+ xn2= s1y* s2z- s1z* s2y;
+ yn2= s1z* s2x- s1x* s2z;
+ zn2= s1x* s2y- s1y* s2x;
+ xst= sqrtl( xn2* xn2+ yn2* yn2+ zn2* zn2);
+ salpn=1./(3.*( xa+ xst));
+ data.px[mi]=( xa*( ax1+ ax2+ ax3)+ xst*( ax1+ ax3+ ax4))* salpn;
+ data.py[mi]=( xa*( ay1+ ay2+ ay3)+ xst*( ay1+ ay3+ ay4))* salpn;
+ data.pz[mi]=( xa*( az1+ az2+ az3)+ xst*( az1+ az3+ az4))* salpn;
+ data.pbi[mi]=.5*( xa+ xst);
+ s1x=( xnv* xn2+ ynv* yn2+ znv* zn2)/ xst;
+
+ if( s1x <= 0.9998)
+ {
+ fprintf( output_fp,
+ "\n ERROR -- CORNERS OF QUADRILATERAL"
+ " PATCH DO NOT LIE IN A PLANE" );
+ stop(-1);
+ }
+
+ } /* if( ntp != 4) */
+
+ } /* if( ntp <= 2) */
+
+ } /* if( ntp <= 1) */
+
+ data.t2x[mi]= ynv* data.t1z[mi]- znv* data.t1y[mi];
+ data.t2y[mi]= znv* data.t1x[mi]- xnv* data.t1z[mi];
+ data.t2z[mi]= xnv* data.t1y[mi]- ynv* data.t1x[mi];
+ data.psalp[mi]=1.;
+
+ if( nx != 0)
+ {
+ data.m += nx*ny-1;
+
+ /* Reallocate patch buffers */
+ mreq = data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ xn2= data.px[mi]- s1x- s2x;
+ yn2= data.py[mi]- s1y- s2y;
+ zn2= data.pz[mi]- s1z- s2z;
+ xs= data.t1x[mi];
+ ys= data.t1y[mi];
+ zs= data.t1z[mi];
+ xt= data.t2x[mi];
+ yt= data.t2y[mi];
+ zt= data.t2z[mi];
+
+ for( iy = 0; iy < ny; iy++ )
+ {
+ xn2 += s2x;
+ yn2 += s2y;
+ zn2 += s2z;
+
+ for( ix = 1; ix <= nx; ix++ )
+ {
+ xst= (long double)ix;
+ data.px[mi]= xn2+ xst* s1x;
+ data.py[mi]= yn2+ xst* s1y;
+ data.pz[mi]= zn2+ xst* s1z;
+ data.pbi[mi]= xa;
+ data.psalp[mi]=1.;
+ data.t1x[mi]= xs;
+ data.t1y[mi]= ys;
+ data.t1z[mi]= zs;
+ data.t2x[mi]= xt;
+ data.t2y[mi]= yt;
+ data.t2z[mi]= zt;
+ mi++;
+ } /* for( ix = 0; ix < nx; ix++ ) */
+
+ } /* for( iy = 0; iy < ny; iy++ ) */
+
+ } /* if( nx != 0) */
+
+ data.ipsym=0;
+ data.np= data.n;
+ data.mp= data.m;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/*** this function was an 'entry point' (part of) 'patch()' ***/
+void subph( int nx, int ny )
+{
+ int mia, ix, iy, mi, mreq;
+ long double xs, ys, zs, xa, xst, s1x, s1y, s1z, s2x, s2y, s2z, saln, xt, yt;
+
+ /* Reallocate patch buffers */
+ if( ny == 0 )
+ data.m += 3;
+ else
+ data.m += 4;
+
+ mreq = data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+ mem_realloc( (void *)&data.icon1, (data.n+data.m) * sizeof(int) );
+ mem_realloc( (void *)&data.icon2, (data.n+data.m) * sizeof(int) );
+
+
+ /* Shift patches to make room for new ones */
+ if( (ny == 0) && (nx != data.m) )
+ {
+ for( iy = data.m-1; iy > nx+2; iy-- )
+ {
+ ix = iy-3;
+ data.px[iy]= data.px[ix];
+ data.py[iy]= data.py[ix];
+ data.pz[iy]= data.pz[ix];
+ data.pbi[iy]= data.pbi[ix];
+ data.psalp[iy]= data.psalp[ix];
+ data.t1x[iy]= data.t1x[ix];
+ data.t1y[iy]= data.t1y[ix];
+ data.t1z[iy]= data.t1z[ix];
+ data.t2x[iy]= data.t2x[ix];
+ data.t2y[iy]= data.t2y[ix];
+ data.t2z[iy]= data.t2z[ix];
+ }
+
+ } /* if( (ny == 0) || (nx != m) ) */
+
+ /* divide patch for connection */
+ mi= nx-1;
+ xs= data.px[mi];
+ ys= data.py[mi];
+ zs= data.pz[mi];
+ xa= data.pbi[mi]/4.;
+ xst= sqrtl( xa)/2.;
+ s1x= data.t1x[mi];
+ s1y= data.t1y[mi];
+ s1z= data.t1z[mi];
+ s2x= data.t2x[mi];
+ s2y= data.t2y[mi];
+ s2z= data.t2z[mi];
+ saln= data.psalp[mi];
+ xt= xst;
+ yt= xst;
+
+ if( ny == 0)
+ mia= mi;
+ else
+ {
+ data.mp++;
+ mia= data.m-1;
+ }
+
+ for( ix = 1; ix <= 4; ix++ )
+ {
+ data.px[mia]= xs+ xt* s1x+ yt* s2x;
+ data.py[mia]= ys+ xt* s1y+ yt* s2y;
+ data.pz[mia]= zs+ xt* s1z+ yt* s2z;
+ data.pbi[mia]= xa;
+ data.t1x[mia]= s1x;
+ data.t1y[mia]= s1y;
+ data.t1z[mia]= s1z;
+ data.t2x[mia]= s2x;
+ data.t2y[mia]= s2y;
+ data.t2z[mia]= s2z;
+ data.psalp[mia]= saln;
+
+ if( ix == 2)
+ yt=- yt;
+
+ if( (ix == 1) || (ix == 3) )
+ xt=- xt;
+
+ mia++;
+ }
+
+ if( nx <= data.mp)
+ data.mp += 3;
+
+ if( ny > 0 )
+ data.pz[mi]=10000.;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+void readgm( char *gm, int *i1, int *i2, long double *x1, long double *y1,
+ long double *z1, long double *x2, long double *y2, long double *z2, long double *rad )
+{
+ char line_buf[134];
+ int nlin, i, line_idx;
+ int nint = 2, nflt = 7;
+ int iarr[2] = { 0, 0 };
+ long double rarr[7] = { 0., 0., 0., 0., 0., 0., 0. };
+
+
+ /* read a line from input file */
+ load_line( line_buf, input_fp );
+
+ /* get line length */
+ nlin= strlen( line_buf );
+
+ /* abort if card's mnemonic too short or missing */
+ if( nlin < 2 )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA CARD ERROR:"
+ "\n CARD'S MNEMONIC CODE TOO SHORT OR MISSING." );
+ stop(-1);
+ }
+
+ /* extract card's mnemonic code */
+ strncpy( gm, line_buf, 2 );
+ gm[2] = '\0';
+
+ /* Exit if "XT" command read (for testing) */
+ if( strcmp( gm, "XT" ) == 0 )
+ {
+ fprintf( stderr,
+ "\nnec2c: Exiting after an \"XT\" command in readgm()\n" );
+ fprintf( output_fp,
+ "\n\n nec2c: Exiting after an \"XT\" command in readgm()" );
+ stop(0);
+ }
+
+ /* Return if only mnemonic on card */
+ if( nlin == 2 )
+ {
+ *i1 = *i2 = 0;
+ *x1 = *y1 = *z1 = *x2 = *y2 = *z2 = *rad = 0.;
+ return;
+ }
+
+ /* read integers from line */
+ line_idx = 1;
+ for( i = 0; i < nint; i++ )
+ {
+ /* Find first numerical character */
+ while( ((line_buf[++line_idx] < '0') ||
+ (line_buf[ line_idx] > '9')) &&
+ (line_buf[ line_idx] != '+') &&
+ (line_buf[ line_idx] != '-') )
+ if( (line_buf[line_idx] == '\0') )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *x1= rarr[0];
+ *y1= rarr[1];
+ *z1= rarr[2];
+ *x2= rarr[3];
+ *y2= rarr[4];
+ *z2= rarr[5];
+ *rad= rarr[6];
+ return;
+ }
+
+ /* read an integer from line */
+ iarr[i] = atoi( &line_buf[line_idx] );
+
+ /* traverse numerical field to next ' ' or ',' or '\0' */
+ line_idx--;
+ while(
+ (line_buf[++line_idx] != ' ') &&
+ (line_buf[ line_idx] != ' ') &&
+ (line_buf[ line_idx] != ',') &&
+ (line_buf[ line_idx] != '\0') )
+ {
+ /* test for non-numerical characters */
+ if( ((line_buf[line_idx] < '0') ||
+ (line_buf[line_idx] > '9')) &&
+ (line_buf[line_idx] != '+') &&
+ (line_buf[line_idx] != '-') )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA CARD \"%s\" ERROR:"
+ "\n NON-NUMERICAL CHARACTER '%c' IN INTEGER FIELD AT CHAR. %d\n",
+ gm, line_buf[line_idx], (line_idx+1) );
+ stop(-1);
+ }
+
+ } /* while( (line_buff[++line_idx] ... */
+
+ /* Return on end of line */
+ if( line_buf[line_idx] == '\0' )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *x1= rarr[0];
+ *y1= rarr[1];
+ *z1= rarr[2];
+ *x2= rarr[3];
+ *y2= rarr[4];
+ *z2= rarr[5];
+ *rad= rarr[6];
+ return;
+ }
+
+ } /* for( i = 0; i < nint; i++ ) */
+
+ /* read long doubles from line */
+ for( i = 0; i < nflt; i++ )
+ {
+ /* Find first numerical character */
+ while( ((line_buf[++line_idx] < '0') ||
+ (line_buf[ line_idx] > '9')) &&
+ (line_buf[ line_idx] != '+') &&
+ (line_buf[ line_idx] != '-') &&
+ (line_buf[ line_idx] != '.') )
+ if( (line_buf[line_idx] == '\0') )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *x1= rarr[0];
+ *y1= rarr[1];
+ *z1= rarr[2];
+ *x2= rarr[3];
+ *y2= rarr[4];
+ *z2= rarr[5];
+ *rad= rarr[6];
+ return;
+ }
+
+ /* read a long double from line */
+ rarr[i] = atof( &line_buf[line_idx] );
+
+ /* traverse numerical field to next ' ' or ',' or '\0' */
+ line_idx--;
+ while(
+ (line_buf[++line_idx] != ' ') &&
+ (line_buf[ line_idx] != ' ') &&
+ (line_buf[ line_idx] != ',') &&
+ (line_buf[ line_idx] != '\0') )
+ {
+ /* test for non-numerical characters */
+ if( ((line_buf[line_idx] < '0') ||
+ (line_buf[line_idx] > '9')) &&
+ (line_buf[line_idx] != '.') &&
+ (line_buf[line_idx] != '+') &&
+ (line_buf[line_idx] != '-') &&
+ (line_buf[line_idx] != 'E') &&
+ (line_buf[line_idx] != 'e') )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA CARD \"%s\" ERROR:"
+ "\n NON-NUMERICAL CHARACTER '%c' IN FLOAT FIELD AT CHAR. %d.\n",
+ gm, line_buf[line_idx], (line_idx+1) );
+ stop(-1);
+ }
+
+ } /* while( (line_buff[++line_idx] ... */
+
+ /* Return on end of line */
+ if( line_buf[line_idx] == '\0' )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *x1= rarr[0];
+ *y1= rarr[1];
+ *z1= rarr[2];
+ *x2= rarr[3];
+ *y2= rarr[4];
+ *z2= rarr[5];
+ *rad= rarr[6];
+ return;
+ }
+
+ } /* for( i = 0; i < nflt; i++ ) */
+
+ *i1 = iarr[0];
+ *i2 = iarr[1];
+ *x1 = rarr[0];
+ *y1 = rarr[1];
+ *z1 = rarr[2];
+ *x2 = rarr[3];
+ *y2 = rarr[4];
+ *z2 = rarr[5];
+ *rad = rarr[6];
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* reflc reflects partial structure along x,y, or z axes or rotates */
+/* structure to complete a symmetric structure. */
+void reflc( int ix, int iy, int iz, int itx, int nop )
+{
+ int iti, i, nx, itagi, k, mreq;
+ long double e1, e2, fnop, sam, cs, ss, xk, yk;
+
+ data.np= data.n;
+ data.mp= data.m;
+ data.ipsym=0;
+ iti= itx;
+
+ if( ix >= 0)
+ {
+ if( nop == 0)
+ return;
+
+ data.ipsym=1;
+
+ /* reflect along z axis */
+ if( iz != 0)
+ {
+ data.ipsym=2;
+
+ if( data.n > 0 )
+ {
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (2*data.n+data.m) * sizeof(int) );
+
+ /* Reallocate wire buffers */
+ mreq = 2*data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ for( i = 0; i < data.n; i++ )
+ {
+ nx= i+ data.n;
+ e1= data.z1[i];
+ e2= data.z2[i];
+
+ if( (fabsl(e1)+fabsl(e2) <= 1.0e-5) || (e1*e2 < -1.0e-6) )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR--SEGMENT %d"
+ " LIES IN PLANE OF SYMMETRY", i+1 );
+ stop(-1);
+ }
+
+ data.x1[nx]= data.x1[i];
+ data.y1[nx]= data.y1[i];
+ data.z1[nx]=- e1;
+ data.x2[nx]= data.x2[i];
+ data.y2[nx]= data.y2[i];
+ data.z2[nx]=- e2;
+ itagi= data.itag[i];
+
+ if( itagi == 0)
+ data.itag[nx]=0;
+ if( itagi != 0)
+ data.itag[nx]= itagi+ iti;
+
+ data.bi[nx]= data.bi[i];
+
+ } /* for( i = 0; i < data.n; i++ ) */
+
+ data.n= data.n*2;
+ iti= iti*2;
+
+ } /* if( data.n > 0) */
+
+ if( data.m > 0 )
+ {
+ /* Reallocate patch buffers */
+ mreq = 2*data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ for( i = 0; i < data.m; i++ )
+ {
+ nx = i+data.m;
+ if( fabsl(data.pz[i]) <= 1.0e-10)
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR--PATCH %d"
+ " LIES IN PLANE OF SYMMETRY", i+1 );
+ stop(-1);
+ }
+
+ data.px[nx]= data.px[i];
+ data.py[nx]= data.py[i];
+ data.pz[nx]=- data.pz[i];
+ data.t1x[nx]= data.t1x[i];
+ data.t1y[nx]= data.t1y[i];
+ data.t1z[nx]=- data.t1z[i];
+ data.t2x[nx]= data.t2x[i];
+ data.t2y[nx]= data.t2y[i];
+ data.t2z[nx]=- data.t2z[i];
+ data.psalp[nx]=- data.psalp[i];
+ data.pbi[nx]= data.pbi[i];
+ }
+
+ data.m= data.m*2;
+
+ } /* if( data.m >= m2) */
+
+ } /* if( iz != 0) */
+
+ /* reflect along y axis */
+ if( iy != 0)
+ {
+ if( data.n > 0)
+ {
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (2*data.n+data.m) * sizeof(int) );/*????*/
+
+ /* Reallocate wire buffers */
+ mreq = 2*data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ for( i = 0; i < data.n; i++ )
+ {
+ nx= i+ data.n;
+ e1= data.y1[i];
+ e2= data.y2[i];
+
+ if( (fabsl(e1)+fabsl(e2) <= 1.0e-5) || (e1*e2 < -1.0e-6) )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR--SEGMENT %d"
+ " LIES IN PLANE OF SYMMETRY", i+1 );
+ stop(-1);
+ }
+
+ data.x1[nx]= data.x1[i];
+ data.y1[nx]=- e1;
+ data.z1[nx]= data.z1[i];
+ data.x2[nx]= data.x2[i];
+ data.y2[nx]=- e2;
+ data.z2[nx]= data.z2[i];
+ itagi= data.itag[i];
+
+ if( itagi == 0)
+ data.itag[nx]=0;
+ if( itagi != 0)
+ data.itag[nx]= itagi+ iti;
+
+ data.bi[nx]= data.bi[i];
+
+ } /* for( i = n2-1; i < data.n; i++ ) */
+
+ data.n= data.n*2;
+ iti= iti*2;
+
+ } /* if( data.n >= n2) */
+
+ if( data.m > 0 )
+ {
+ /* Reallocate patch buffers */
+ mreq = 2*data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ for( i = 0; i < data.m; i++ )
+ {
+ nx= i+data.m;
+ if( fabsl( data.py[i]) <= 1.0e-10)
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR--PATCH %d"
+ " LIES IN PLANE OF SYMMETRY", i+1 );
+ stop(-1);
+ }
+
+ data.px[nx]= data.px[i];
+ data.py[nx]=- data.py[i];
+ data.pz[nx]= data.pz[i];
+ data.t1x[nx]= data.t1x[i];
+ data.t1y[nx]=- data.t1y[i];
+ data.t1z[nx]= data.t1z[i];
+ data.t2x[nx]= data.t2x[i];
+ data.t2y[nx]=- data.t2y[i];
+ data.t2z[nx]= data.t2z[i];
+ data.psalp[nx]=- data.psalp[i];
+ data.pbi[nx]= data.pbi[i];
+
+ } /* for( i = m2; i <= data.m; i++ ) */
+
+ data.m= data.m*2;
+
+ } /* if( data.m >= m2) */
+
+ } /* if( iy != 0) */
+
+ /* reflect along x axis */
+ if( ix == 0 )
+ return;
+
+ if( data.n > 0 )
+ {
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (2*data.n+data.m) * sizeof(int) );/*????*/
+
+ /* Reallocate wire buffers */
+ mreq = 2*data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ for( i = 0; i < data.n; i++ )
+ {
+ nx= i+ data.n;
+ e1= data.x1[i];
+ e2= data.x2[i];
+
+ if( (fabsl(e1)+fabsl(e2) <= 1.0e-5) || (e1*e2 < -1.0e-6) )
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR--SEGMENT %d"
+ " LIES IN PLANE OF SYMMETRY", i+1 );
+ stop(-1);
+ }
+
+ data.x1[nx]=- e1;
+ data.y1[nx]= data.y1[i];
+ data.z1[nx]= data.z1[i];
+ data.x2[nx]=- e2;
+ data.y2[nx]= data.y2[i];
+ data.z2[nx]= data.z2[i];
+ itagi= data.itag[i];
+
+ if( itagi == 0)
+ data.itag[nx]=0;
+ if( itagi != 0)
+ data.itag[nx]= itagi+ iti;
+
+ data.bi[nx]= data.bi[i];
+ }
+
+ data.n= data.n*2;
+
+ } /* if( data.n > 0) */
+
+ if( data.m == 0 )
+ return;
+
+ /* Reallocate patch buffers */
+ mreq = 2*data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ for( i = 0; i < data.m; i++ )
+ {
+ nx= i+data.m;
+ if( fabsl( data.px[i]) <= 1.0e-10)
+ {
+ fprintf( output_fp,
+ "\n GEOMETRY DATA ERROR--PATCH %d"
+ " LIES IN PLANE OF SYMMETRY", i+1 );
+ stop(-1);
+ }
+
+ data.px[nx]=- data.px[i];
+ data.py[nx]= data.py[i];
+ data.pz[nx]= data.pz[i];
+ data.t1x[nx]=- data.t1x[i];
+ data.t1y[nx]= data.t1y[i];
+ data.t1z[nx]= data.t1z[i];
+ data.t2x[nx]=- data.t2x[i];
+ data.t2y[nx]= data.t2y[i];
+ data.t2z[nx]= data.t2z[i];
+ data.psalp[nx]=- data.psalp[i];
+ data.pbi[nx]= data.pbi[i];
+ }
+
+ data.m= data.m*2;
+ return;
+
+ } /* if( ix >= 0) */
+
+ /* reproduce structure with rotation to form cylindrical structure */
+ fnop= (long double)nop;
+ data.ipsym=-1;
+ sam=TP/ fnop;
+ cs= cosl( sam);
+ ss= sinl( sam);
+
+ if( data.n > 0)
+ {
+ data.n *= nop;
+ nx= data.np;
+
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (data.n+data.m) * sizeof(int) );/*????*/
+
+ /* Reallocate wire buffers */
+ mreq = data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ for( i = nx; i < data.n; i++ )
+ {
+ k= i- data.np;
+ xk= data.x1[k];
+ yk= data.y1[k];
+ data.x1[i]= xk* cs- yk* ss;
+ data.y1[i]= xk* ss+ yk* cs;
+ data.z1[i]= data.z1[k];
+ xk= data.x2[k];
+ yk= data.y2[k];
+ data.x2[i]= xk* cs- yk* ss;
+ data.y2[i]= xk* ss+ yk* cs;
+ data.z2[i]= data.z2[k];
+ data.bi[i]= data.bi[k];
+ itagi= data.itag[k];
+
+ if( itagi == 0)
+ data.itag[i]=0;
+ if( itagi != 0)
+ data.itag[i]= itagi+ iti;
+ }
+
+ } /* if( data.n >= n2) */
+
+ if( data.m == 0 )
+ return;
+
+ data.m *= nop;
+ nx= data.mp;
+
+ /* Reallocate patch buffers */
+ mreq = data.m * sizeof(long double);
+ mem_realloc( (void *)&data.px, mreq );
+ mem_realloc( (void *)&data.py, mreq );
+ mem_realloc( (void *)&data.pz, mreq );
+ mem_realloc( (void *)&data.t1x, mreq );
+ mem_realloc( (void *)&data.t1y, mreq );
+ mem_realloc( (void *)&data.t1z, mreq );
+ mem_realloc( (void *)&data.t2x, mreq );
+ mem_realloc( (void *)&data.t2y, mreq );
+ mem_realloc( (void *)&data.t2z, mreq );
+ mem_realloc( (void *)&data.pbi, mreq );
+ mem_realloc( (void *)&data.psalp, mreq );
+
+ for( i = nx; i < data.m; i++ )
+ {
+ k = i-data.mp;
+ xk= data.px[k];
+ yk= data.py[k];
+ data.px[i]= xk* cs- yk* ss;
+ data.py[i]= xk* ss+ yk* cs;
+ data.pz[i]= data.pz[k];
+ xk= data.t1x[k];
+ yk= data.t1y[k];
+ data.t1x[i]= xk* cs- yk* ss;
+ data.t1y[i]= xk* ss+ yk* cs;
+ data.t1z[i]= data.t1z[k];
+ xk= data.t2x[k];
+ yk= data.t2y[k];
+ data.t2x[i]= xk* cs- yk* ss;
+ data.t2y[i]= xk* ss+ yk* cs;
+ data.t2z[i]= data.t2z[k];
+ data.psalp[i]= data.psalp[k];
+ data.pbi[i]= data.pbi[k];
+
+ } /* for( i = nx; i < data.m; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* subroutine wire generates segment geometry */
+/* data for a straight wire of ns segments. */
+void wire( long double xw1, long double yw1, long double zw1,
+ long double xw2, long double yw2, long double zw2, long double rad,
+ long double rdel, long double rrad, int ns, int itg )
+{
+ int ist, i, mreq;
+ long double xd, yd, zd, delz, rd, fns, radz;
+ long double xs1, ys1, zs1, xs2, ys2, zs2;
+
+ ist= data.n;
+ data.n= data.n+ ns;
+ data.np= data.n;
+ data.mp= data.m;
+ data.ipsym=0;
+
+ if( ns < 1)
+ return;
+
+ /* Reallocate tags buffer */
+ mem_realloc( (void *)&data.itag, (data.n+data.m) * sizeof(int) );/*????*/
+
+ /* Reallocate wire buffers */
+ mreq = data.n * sizeof(long double);
+ mem_realloc( (void *)&data.x1, mreq );
+ mem_realloc( (void *)&data.y1, mreq );
+ mem_realloc( (void *)&data.z1, mreq );
+ mem_realloc( (void *)&data.x2, mreq );
+ mem_realloc( (void *)&data.y2, mreq );
+ mem_realloc( (void *)&data.z2, mreq );
+ mem_realloc( (void *)&data.bi, mreq );
+
+ xd= xw2- xw1;
+ yd= yw2- yw1;
+ zd= zw2- zw1;
+
+ if( fabsl( rdel-1.) >= 1.0e-6)
+ {
+ delz= sqrtl( xd* xd+ yd* yd+ zd* zd);
+ xd= xd/ delz;
+ yd= yd/ delz;
+ zd= zd/ delz;
+ delz= delz*(1.- rdel)/(1.- powl(rdel, ns) );
+ rd= rdel;
+ }
+ else
+ {
+ fns= ns;
+ xd= xd/ fns;
+ yd= yd/ fns;
+ zd= zd/ fns;
+ delz=1.;
+ rd=1.;
+ }
+
+ radz= rad;
+ xs1= xw1;
+ ys1= yw1;
+ zs1= zw1;
+
+ for( i = ist; i < data.n; i++ )
+ {
+ data.itag[i]= itg;
+ xs2= xs1+ xd* delz;
+ ys2= ys1+ yd* delz;
+ zs2= zs1+ zd* delz;
+ data.x1[i]= xs1;
+ data.y1[i]= ys1;
+ data.z1[i]= zs1;
+ data.x2[i]= xs2;
+ data.y2[i]= ys2;
+ data.z2[i]= zs2;
+ data.bi[i]= radz;
+ delz= delz* rd;
+ radz= radz* rrad;
+ xs1= xs2;
+ ys1= ys2;
+ zs1= zs2;
+ }
+
+ data.x2[data.n-1]= xw2;
+ data.y2[data.n-1]= yw2;
+ data.z2[data.n-1]= zw2;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/ground.c b/ground.c
new file mode 100644
index 0000000..86577b5
--- /dev/null
+++ b/ground.c
@@ -0,0 +1,346 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+ *******************************************************************/
+
+#include "nec2c.h"
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/* common /data/ */
+extern data_t data;
+
+/* common /dataj/ */
+extern dataj_t dataj;
+
+/* common /incom/ */
+incom_t incom;;
+
+/* common /gwav/ */
+extern gwav_t gwav;
+
+/* common /gnd/ */
+extern gnd_t gnd;
+
+/*-------------------------------------------------------------------*/
+
+/* segment to obtain the total field due to ground. the method of */
+/* variable interval width romberg integration is used. there are 9 */
+/* field components - the x, y, and z components due to constant, */
+/* sine, and cosine current distributions. */
+void rom2( long double a, long double b, complex long double *sum, long double dmin )
+{
+ int i, ns, nt, flag=TRUE;
+ int nts = 4, nx = 1, n = 9;
+ long double ze, ep, zend, dz=0., dzot=0., tmag1, tmag2, tr, ti;
+ long double z, s; /***also global***/
+ long double rx = 1.0e-4;
+ complex long double g1[9], g2[9], g3[9], g4[9], g5[9];
+ complex long double t00, t01[9], t10[9], t02, t11, t20[9];
+
+ z= a;
+ ze= b;
+ s= b- a;
+
+ if( s < 0.)
+ {
+ fprintf( output_fp, "\n ERROR - B LESS THAN A IN ROM2" );
+ stop(-1);
+ }
+
+ ep= s/(1.e4* data.npm);
+ zend= ze- ep;
+
+ for( i = 0; i < n; i++ )
+ sum[i]=CPLX_00;
+
+ ns= nx;
+ nt=0;
+ sflds( z, g1);
+
+ while( TRUE )
+ {
+ if( flag )
+ {
+ dz= s/ ns;
+ if( z+ dz > ze)
+ {
+ dz= ze- z;
+ if( dz <= ep)
+ return;
+ }
+
+ dzot= dz*.5;
+ sflds( z+ dzot, g3);
+ sflds( z+ dz, g5);
+
+ } /* if( flag ) */
+
+ tmag1=0.;
+ tmag2=0.;
+
+ /* evaluate 3 point romberg result and test convergence. */
+ for( i = 0; i < n; i++ )
+ {
+ t00=( g1[i]+ g5[i])* dzot;
+ t01[i]=( t00+ dz* g3[i])*.5;
+ t10[i]=(4.* t01[i]- t00)/3.;
+ if( i > 2)
+ continue;
+
+ tr= creal( t01[i]);
+ ti= cimag( t01[i]);
+ tmag1= tmag1+ tr* tr+ ti* ti;
+ tr= creal( t10[i]);
+ ti= cimag( t10[i]);
+ tmag2= tmag2+ tr* tr+ ti* ti;
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ tmag1= sqrtl( tmag1);
+ tmag2= sqrtl( tmag2);
+ test( tmag1, tmag2, &tr, 0., 0., &ti, dmin);
+
+ if( tr <= rx)
+ {
+ for( i = 0; i < n; i++ )
+ sum[i] += t10[i];
+ nt += 2;
+
+ z += dz;
+ if( z > zend)
+ return;
+
+ for( i = 0; i < n; i++ )
+ g1[i]= g5[i];
+
+ if( (nt >= nts) && (ns > nx) )
+ {
+ ns= ns/2;
+ nt=1;
+ }
+ flag = TRUE;
+ continue;
+
+ } /* if( tr <= rx) */
+
+ sflds( z+ dz*.25, g2);
+ sflds( z+ dz*.75, g4);
+ tmag1=0.;
+ tmag2=0.;
+
+ /* evaluate 5 point romberg result and test convergence. */
+ for( i = 0; i < n; i++ )
+ {
+ t02=( t01[i]+ dzot*( g2[i]+ g4[i]))*.5;
+ t11=( 4.0 * t02- t01[i] )/3.;
+ t20[i]=(16.* t11- t10[i])/15.;
+ if( i > 2)
+ continue;
+
+ tr= creal( t11);
+ ti= cimag( t11);
+ tmag1= tmag1+ tr* tr+ ti* ti;
+ tr= creal( t20[i]);
+ ti= cimag( t20[i]);
+ tmag2= tmag2+ tr* tr+ ti* ti;
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ tmag1= sqrtl( tmag1);
+ tmag2= sqrtl( tmag2);
+ test( tmag1, tmag2, &tr, 0.,0., &ti, dmin);
+
+ if( tr > rx)
+ {
+ nt=0;
+ if( ns < data.npm )
+ {
+ ns= ns*2;
+ dz= s/ ns;
+ dzot= dz*.5;
+
+ for( i = 0; i < n; i++ )
+ {
+ g5[i]= g3[i];
+ g3[i]= g2[i];
+ }
+
+ flag=FALSE;
+ continue;
+
+ } /* if( ns < npm) */
+
+ fprintf( output_fp,
+ "\n ROM2 -- STEP SIZE LIMITED AT Z = %12.5LE", z );
+
+ } /* if( tr > rx) */
+
+ for( i = 0; i < n; i++ )
+ sum[i]= sum[i]+ t20[i];
+ nt= nt+1;
+
+ z= z+ dz;
+ if( z > zend)
+ return;
+
+ for( i = 0; i < n; i++ )
+ g1[i]= g5[i];
+
+ flag = TRUE;
+ if( (nt < nts) || (ns <= nx) )
+ continue;
+
+ ns= ns/2;
+ nt=1;
+
+ } /* while( TRUE ) */
+
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* sfldx returns the field due to ground for a current element on */
+/* the source segment at t relative to the segment center. */
+void sflds( long double t, complex long double *e )
+{
+ long double xt, yt, zt, rhx, rhy, rhs, rho, phx, phy;
+ long double cph, sph, zphs, r2s, rk, sfac, thet;
+ complex long double erv, ezv, erh, ezh, eph, er, et, hrv, hzv, hrh;
+
+ xt= dataj.xj+ t* dataj.cabj;
+ yt= dataj.yj+ t* dataj.sabj;
+ zt= dataj.zj+ t* dataj.salpj;
+ rhx= incom.xo- xt;
+ rhy= incom.yo- yt;
+ rhs= rhx* rhx+ rhy* rhy;
+ rho= sqrtl( rhs);
+
+ if( rho <= 0.)
+ {
+ rhx=1.;
+ rhy=0.;
+ phx=0.;
+ phy=1.;
+ }
+ else
+ {
+ rhx= rhx/ rho;
+ rhy= rhy/ rho;
+ phx=- rhy;
+ phy= rhx;
+ }
+
+ cph= rhx* incom.xsn+ rhy* incom.ysn;
+ sph= rhy* incom.xsn- rhx* incom.ysn;
+
+ if( fabsl( cph) < 1.0e-10)
+ cph=0.;
+ if( fabsl( sph) < 1.0e-10)
+ sph=0.;
+
+ gwav.zph= incom.zo+ zt;
+ zphs= gwav.zph* gwav.zph;
+ r2s= rhs+ zphs;
+ gwav.r2= sqrtl( r2s);
+ rk= gwav.r2* TP;
+ gwav.xx2= cmplx( cosl( rk),- sinl( rk));
+
+ /* use norton approximation for field due to ground. current is */
+ /* lumped at segment center with current moment for constant, sine, */
+ /* or cosine distribution. */
+ if( incom.isnor != 1)
+ {
+ gwav.zmh=1.;
+ gwav.r1=1.;
+ gwav.xx1=0.;
+ gwave( &erv, &ezv, &erh, &ezh, &eph);
+
+ et=-CONST1* gnd.frati* gwav.xx2/( r2s* gwav.r2);
+ er=2.* et* cmplx(1.0, rk);
+ et= et* cmplx(1.0 - rk* rk, rk);
+ hrv=( er+ et)* rho* gwav.zph/ r2s;
+ hzv=( zphs* er- rhs* et)/ r2s;
+ hrh=( rhs* er- zphs* et)/ r2s;
+ erv= erv- hrv;
+ ezv= ezv- hzv;
+ erh= erh+ hrh;
+ ezh= ezh+ hrv;
+ eph= eph+ et;
+ erv= erv* dataj.salpj;
+ ezv= ezv* dataj.salpj;
+ erh= erh* incom.sn* cph;
+ ezh= ezh* incom.sn* cph;
+ eph= eph* incom.sn* sph;
+ erh= erv+ erh;
+ e[0]=( erh* rhx+ eph* phx)* dataj.s;
+ e[1]=( erh* rhy+ eph* phy)* dataj.s;
+ e[2]=( ezv+ ezh)* dataj.s;
+ e[3]=0.;
+ e[4]=0.;
+ e[5]=0.;
+ sfac= PI* dataj.s;
+ sfac= sinl( sfac)/ sfac;
+ e[6]= e[0]* sfac;
+ e[7]= e[1]* sfac;
+ e[8]= e[2]* sfac;
+
+ return;
+ } /* if( smat.isnor != 1) */
+
+ /* interpolate in sommerfeld field tables */
+ if( rho >= 1.0e-12)
+ thet= atanl( gwav.zph/ rho);
+ else
+ thet= POT;
+
+ /* combine vertical and horizontal components and convert */
+ /* to x,y,z components. multiply by exp(-jkr)/r. */
+ intrp( gwav.r2, thet, &erv, &ezv, &erh, &eph );
+ gwav.xx2= gwav.xx2/ gwav.r2;
+ sfac= incom.sn* cph;
+ erh= gwav.xx2*( dataj.salpj* erv+ sfac* erh);
+ ezh= gwav.xx2*( dataj.salpj* ezv- sfac* erv);
+ /* x,y,z fields for constant current */
+ eph= incom.sn* sph* gwav.xx2* eph;
+ e[0]= erh* rhx+ eph* phx;
+ e[1]= erh* rhy+ eph* phy;
+ e[2]= ezh;
+ /* x,y,z fields for sine current */
+ rk= TP* t;
+ sfac= sinl( rk);
+ e[3]= e[0]* sfac;
+ e[4]= e[1]* sfac;
+ /* x,y,z fields for cosine current */
+ e[5]= e[2]* sfac;
+ sfac= cosl( rk);
+ e[6]= e[0]* sfac;
+ e[7]= e[1]* sfac;
+ e[8]= e[2]* sfac;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/input.c b/input.c
new file mode 100644
index 0000000..2192965
--- /dev/null
+++ b/input.c
@@ -0,0 +1,438 @@
+/******* Translated to the C language by N. Kyriazis 20 Aug 2003 ******
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+*******************************************************************/
+
+#include "nec2c.h"
+
+/* common /data/ */
+extern data_t data;
+
+/* common /segj/ */
+extern segj_t segj;
+
+/* common /vsorc/ */
+extern vsorc_t vsorc;
+
+/* common /dataj/ */
+extern dataj_t dataj;
+
+/* common /zload/ */
+extern zload_t zload;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/*-------------------------------------------------------------------*/
+
+/* fill incident field array for charge discontinuity voltage source */
+void qdsrc( int is, complex long double v, complex long double *e )
+{
+ int i, jx, j, jp1, ipr, ij, i1;
+ long double xi, yi, zi, ai, cabi, sabi, salpi, tx, ty, tz;
+ complex long double curd, etk, ets, etc;
+
+ is--;
+ i= data.icon1[is];
+ data.icon1[is]=0;
+ tbf( is+1,0);
+ data.icon1[is]= i;
+ dataj.s= data.si[is]*.5;
+ curd= CCJ* v/(( logl(2.* dataj.s/ data.bi[is])-1.)*( segj.bx[segj.jsno-1]*
+ cosl( TP* dataj.s)+ segj.cx[segj.jsno-1]* sinl( TP* dataj.s))* data.wlam);
+ vsorc.vqds[vsorc.nqds]= v;
+ vsorc.iqds[vsorc.nqds]= is+1;
+ vsorc.nqds++;
+
+ for( jx = 0; jx < segj.jsno; jx++ )
+ {
+ j= segj.jco[jx]-1;
+ jp1 = j+1;
+ dataj.s= data.si[j];
+ dataj.b= data.bi[j];
+ dataj.xj= data.x[j];
+ dataj.yj= data.y[j];
+ dataj.zj= data.z[j];
+ dataj.cabj= data.cab[j];
+ dataj.sabj= data.sab[j];
+ dataj.salpj= data.salp[j];
+
+ if( dataj.iexk != 0)
+ {
+ ipr= data.icon1[j];
+
+ if (ipr > PCHCON) dataj.ind1=2;
+ else if( ipr < 0 )
+ {
+ ipr=- ipr;
+ ipr--;
+ if( -data.icon1[ipr-1] != jp1 )
+ dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[ipr]+ dataj.sabj*
+ data.sab[ipr]+ dataj.salpj* data.salp[ipr]);
+ if( (xi < 0.999999) || (fabsl(data.bi[ipr]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* if( ipr < 0 ) */
+ else
+ if( ipr == 0 )
+ dataj.ind1=1;
+ else /* ipr > 0 */
+ {
+ ipr--;
+ if( ipr != j )
+ {
+ if( data.icon2[ipr] != jp1)
+ dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[ipr]+ dataj.sabj*
+ data.sab[ipr]+ dataj.salpj* data.salp[ipr]);
+ if( (xi < 0.999999) || (fabsl(data.bi[ipr]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* if( ipr != j ) */
+ else
+ {
+ if( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj > 1.0e-8)
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* else */
+
+ ipr= data.icon2[j];
+ if (ipr > PCHCON) dataj.ind2=2;
+ else if( ipr < 0 )
+ {
+ ipr = -ipr;
+ ipr--;
+ if( -data.icon2[ipr] != jp1 )
+ dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[ipr]+ dataj.sabj*
+ data.sab[ipr]+ dataj.salpj* data.salp[ipr]);
+ if( (xi < 0.999999) || (fabsl(data.bi[ipr]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* if( ipr < 0 ) */
+ else
+ if( ipr == 0 )
+ dataj.ind2=1;
+ else /* ipr > 0 */
+ {
+ ipr--;
+ if( ipr != j )
+ {
+ if( data.icon1[ipr] != jp1)
+ dataj.ind2=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[ipr]+ dataj.sabj*
+ data.sab[ipr]+ dataj.salpj* data.salp[ipr]);
+ if( (xi < 0.999999) || (fabsl(data.bi[ipr]/dataj.b-1.) > 1.0e-6) )
+ dataj.ind2=2;
+ else
+ dataj.ind2=0;
+ }
+ } /* if( ipr != j )*/
+ else
+ {
+ if( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj > 1.0e-8)
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+ }
+ } /* else */
+
+ } /* if( dataj.iexk != 0) */
+
+ for( i = 0; i < data.n; i++ )
+ {
+ ij= i- j;
+ xi= data.x[i];
+ yi= data.y[i];
+ zi= data.z[i];
+ ai= data.bi[i];
+ efld( xi, yi, zi, ai, ij);
+ cabi= data.cab[i];
+ sabi= data.sab[i];
+ salpi= data.salp[i];
+ etk= dataj.exk* cabi+ dataj.eyk* sabi+ dataj.ezk* salpi;
+ ets= dataj.exs* cabi+ dataj.eys* sabi+ dataj.ezs* salpi;
+ etc= dataj.exc* cabi+ dataj.eyc* sabi+ dataj.ezc* salpi;
+ e[i]= e[i]-( etk* segj.ax[jx]+ ets* segj.bx[jx]+ etc* segj.cx[jx])* curd;
+ }
+
+ if( data.m != 0)
+ {
+ i1= data.n-1;
+ for( i = 0; i < data.m; i++ )
+ {
+ xi= data.px[i];
+ yi= data.py[i];
+ zi= data.pz[i];
+ hsfld( xi, yi, zi,0.);
+ i1++;
+ tx= data.t2x[i];
+ ty= data.t2y[i];
+ tz= data.t2z[i];
+ etk= dataj.exk* tx+ dataj.eyk* ty+ dataj.ezk* tz;
+ ets= dataj.exs* tx+ dataj.eys* ty+ dataj.ezs* tz;
+ etc= dataj.exc* tx+ dataj.eyc* ty+ dataj.ezc* tz;
+ e[i1] += ( etk* segj.ax[jx]+ ets* segj.bx[jx]+
+ etc* segj.cx[jx] )* curd* data.psalp[i];
+ i1++;
+ tx= data.t1x[i];
+ ty= data.t1y[i];
+ tz= data.t1z[i];
+ etk= dataj.exk* tx+ dataj.eyk* ty+ dataj.ezk* tz;
+ ets= dataj.exs* tx+ dataj.eys* ty+ dataj.ezs* tz;
+ etc= dataj.exc* tx+ dataj.eyc* ty+ dataj.ezc* tz;
+ e[i1] += ( etk* segj.ax[jx]+ ets* segj.bx[jx]+
+ etc* segj.cx[jx])* curd* data.psalp[i];
+ }
+
+ } /* if( m != 0) */
+
+ if( zload.nload > 0 )
+ e[j] += zload.zarray[j]* curd*(segj.ax[jx]+ segj.cx[jx]);
+
+ } /* for( jx = 0; jx < segj.jsno; jx++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+void readmn( char *gm, int *i1, int *i2, int *i3, int *i4,
+ long double *f1, long double *f2, long double *f3,
+ long double *f4, long double *f5, long double *f6 )
+{
+ char line_buf[134];
+ int nlin, i, line_idx;
+ int nint = 4, nflt = 6;
+ int iarr[4] = { 0, 0, 0, 0 };
+ long double rarr[6] = { 0., 0., 0., 0., 0., 0. };
+
+ /* read a line from input file */
+ load_line( line_buf, input_fp );
+
+ /* get line length */
+ nlin= strlen( line_buf );
+
+ /* abort if card's mnemonic too short or missing */
+ if( nlin < 2 )
+ {
+ fprintf( output_fp,
+ "\n COMMAND DATA CARD ERROR:"
+ "\n CARD'S MNEMONIC CODE TOO SHORT OR MISSING." );
+ stop(-1);
+ }
+
+ /* extract card's mnemonic code */
+ strncpy( gm, line_buf, 2 );
+ gm[2] = '\0';
+
+ /* Exit if "XT" command read (for testing) */
+ if( strcmp( gm, "XT" ) == 0 )
+ {
+ fprintf( stderr,
+ "\nnec2c: Exiting after an \"XT\" command in readgm()\n" );
+ fprintf( output_fp,
+ "\n\n nec2c: Exiting after an \"XT\" command in readgm()" );
+ stop(0);
+ }
+
+ /* Return if only mnemonic on card */
+ if( nlin == 2 )
+ {
+ *i1 = *i2 = *i3 = *i4 = 0;
+ *f1 = *f2 = *f3 = *f4 = *f5 = *f6 = 0.0;
+ return;
+ }
+
+ /* read integers from line */
+ line_idx = 1;
+ for( i = 0; i < nint; i++ )
+ {
+ /* Find first numerical character */
+ while( ((line_buf[++line_idx] < '0') ||
+ (line_buf[ line_idx] > '9')) &&
+ (line_buf[ line_idx] != '+') &&
+ (line_buf[ line_idx] != '-') )
+ if( (line_buf[line_idx] == '\0') )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *i3= iarr[2];
+ *i4= iarr[3];
+ *f1= rarr[0];
+ *f2= rarr[1];
+ *f3= rarr[2];
+ *f4= rarr[3];
+ *f5= rarr[4];
+ *f6= rarr[5];
+ return;
+ }
+
+ /* read an integer from line */
+ iarr[i] = atoi( &line_buf[line_idx] );
+
+ /* traverse numerical field to next ' ' or ',' or '\0' */
+ line_idx--;
+ while(
+ (line_buf[++line_idx] != ' ') &&
+ (line_buf[ line_idx] != ' ') &&
+ (line_buf[ line_idx] != ',') &&
+ (line_buf[ line_idx] != '\0') )
+ {
+ /* test for non-numerical characters */
+ if( ((line_buf[line_idx] < '0') ||
+ (line_buf[line_idx] > '9')) &&
+ (line_buf[line_idx] != '+') &&
+ (line_buf[line_idx] != '-') )
+ {
+ fprintf( output_fp,
+ "\n COMMAND DATA CARD \"%s\" ERROR:"
+ "\n NON-NUMERICAL CHARACTER '%c' IN INTEGER FIELD AT CHAR. %d\n",
+ gm, line_buf[line_idx], (line_idx+1) );
+ stop(-1);
+ }
+
+ } /* while( (line_buff[++line_idx] ... */
+
+ /* Return on end of line */
+ if( line_buf[line_idx] == '\0' )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *i3= iarr[2];
+ *i4= iarr[3];
+ *f1= rarr[0];
+ *f2= rarr[1];
+ *f3= rarr[2];
+ *f4= rarr[3];
+ *f5= rarr[4];
+ *f6= rarr[5];
+ return;
+ }
+
+ } /* for( i = 0; i < nint; i++ ) */
+
+ /* read long doubles from line */
+ for( i = 0; i < nflt; i++ )
+ {
+ /* Find first numerical character */
+ while( ((line_buf[++line_idx] < '0') ||
+ (line_buf[ line_idx] > '9')) &&
+ (line_buf[ line_idx] != '+') &&
+ (line_buf[ line_idx] != '-') &&
+ (line_buf[ line_idx] != '.') )
+ if( (line_buf[line_idx] == '\0') )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *i3= iarr[2];
+ *i4= iarr[3];
+ *f1= rarr[0];
+ *f2= rarr[1];
+ *f3= rarr[2];
+ *f4= rarr[3];
+ *f5= rarr[4];
+ *f6= rarr[5];
+ return;
+ }
+
+ /* read a long double from line */
+ rarr[i] = atof( &line_buf[line_idx] );
+
+ /* traverse numerical field to next ' ' or ',' */
+ line_idx--;
+ while(
+ (line_buf[++line_idx] != ' ') &&
+ (line_buf[ line_idx] != ' ') &&
+ (line_buf[ line_idx] != ',') &&
+ (line_buf[ line_idx] != '\0') )
+ {
+ /* test for non-numerical characters */
+ if( ((line_buf[line_idx] < '0') ||
+ (line_buf[line_idx] > '9')) &&
+ (line_buf[line_idx] != '.') &&
+ (line_buf[line_idx] != '+') &&
+ (line_buf[line_idx] != '-') &&
+ (line_buf[line_idx] != 'E') &&
+ (line_buf[line_idx] != 'e') )
+ {
+ fprintf( output_fp,
+ "\n COMMAND DATA CARD \"%s\" ERROR:"
+ "\n NON-NUMERICAL CHARACTER '%c' IN FLOAT FIELD AT CHAR. %d\n",
+ gm, line_buf[line_idx], (line_idx+1) );
+ stop(-1);
+ }
+
+ } /* while( (line_buff[++line_idx] ... */
+
+ /* Return on end of line */
+ if( line_buf[line_idx] == '\0' )
+ {
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *i3= iarr[2];
+ *i4= iarr[3];
+ *f1= rarr[0];
+ *f2= rarr[1];
+ *f3= rarr[2];
+ *f4= rarr[3];
+ *f5= rarr[4];
+ *f6= rarr[5];
+ return;
+ }
+
+ } /* for( i = 0; i < nflt; i++ ) */
+
+ *i1= iarr[0];
+ *i2= iarr[1];
+ *i3= iarr[2];
+ *i4= iarr[3];
+ *f1= rarr[0];
+ *f2= rarr[1];
+ *f3= rarr[2];
+ *f4= rarr[3];
+ *f5= rarr[4];
+ *f6= rarr[5];
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/main.c b/main.c
new file mode 100644
index 0000000..6b75199
--- /dev/null
+++ b/main.c
@@ -0,0 +1,2027 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+*******************************************************************/
+
+#include "nec2c.h"
+
+/* common /cmb/ */
+complex long double *cm;
+
+/* common /crnt/ */
+crnt_t crnt;
+
+/* common /data/ */
+data_t data;
+
+/*common /ggrid/ */
+extern ggrid_t ggrid;
+
+/* common /gnd/ */
+gnd_t gnd;
+
+/* common /matpar/ */
+matpar_t matpar;
+
+/* common /netcx/ */
+netcx_t netcx;
+
+/* common /save/ */
+save_t save;
+
+/* common /segj/ */
+segj_t segj;
+
+/* common /yparm/ */
+yparm_t yparm;
+
+/* common /zload/ */
+zload_t zload;
+
+/* common /vsorc/ */
+vsorc_t vsorc;
+
+/* common /fpat/ */
+fpat_t fpat;
+
+/* common /gwav/ */
+gwav_t gwav;
+
+/* common /plot/ */
+plot_t plot;
+
+/* common /smat/ */
+smat_t smat;
+
+/* pointers to input/output files */
+FILE *input_fp=NULL, *output_fp=NULL, *plot_fp=NULL;
+
+/* signal handler */
+static void sig_handler( int signal );
+
+/*-------------------------------------------------------------------*/
+
+int main( int argc, char **argv )
+{
+ char infile[81] = "", otfile[81] = "";
+ char ain[3], line_buf[81];
+
+ /* input card mnemonic list */
+#define NUM_CMNDS 20
+ char *atst[NUM_CMNDS] =
+ {
+ "FR", "LD", "GN", "EX", "NT", "TL", \
+ "XQ", "GD", "RP", "NX", "PT", "KH", \
+ "NE", "NH", "PQ", "EK", "CP", "PL", \
+ "EN", "WG"
+ };
+
+ char *hpol[3] = { "LINEAR", "RIGHT", "LEFT" };
+ char *pnet[3] = { " ", "STRAIGHT", " CROSSED" };
+
+ int *ldtyp, *ldtag, *ldtagf, *ldtagt;
+ int ifrtmw, ifrtmp, mpcnt, igo, nfrq;
+ int iexk, iptflg, iptflq, iped, iflow, itmp1, iresrv;
+ int itmp3, itmp2, itmp4, nthi=0, nphi=0, iptag=0, iptagf=0, iptagt=0;
+ int iptaq=0, iptaqf=0, iptaqt=0, nphic=0, inc=0;
+ int i, j, itmp5, nthic=0, mhz=0, ifrq=0, isave=0;
+
+ int
+ igox, /* used in place of "igo" in freq loop */
+ next_job, /* start next job (next sructure) flag */
+ idx, /* general purpose index */
+ ain_num, /* ain mnemonic as a number */
+ jmp_iloop, /* jump to input loop flag */
+ jmp_floop=0,/* jump to freq. loop flag */
+ mreq; /* Size req. for malloc's */
+
+ long double *zlr, *zli, *zlc, *fnorm;
+ long double *xtemp, *ytemp, *ztemp, *sitemp, *bitemp;
+ long double rkh, tmp1, delfrq=0., tmp2, tmp3, tmp4, tmp5, tmp6;
+ long double xpr1=0., xpr2=0., xpr3=0., xpr4=0., xpr5=0.;
+ long double zpnorm=0., thetis=0., phiss=0., extim;
+ long double tim1, tim, tim2, etha, fr, fr2, cmag, ph, ethm, ephm, epha;
+ complex long double eth, eph, curi, ex, ey, ez, epsc;
+
+ /* getopt() variables */
+ extern char *optarg;
+ extern int optind, opterr, optopt;
+ int option;
+
+ /*** signal handler related code ***/
+ /* new and old actions for sigaction() */
+ struct sigaction sa_new, sa_old;
+
+
+ /* initialize new actions */
+ sa_new.sa_handler = sig_handler;
+ sigemptyset( &sa_new.sa_mask );
+ sa_new.sa_flags = 0;
+
+ /* register function to handle signals */
+ sigaction( SIGINT, &sa_new, &sa_old );
+ sigaction( SIGSEGV, &sa_new, 0 );
+ sigaction( SIGFPE, &sa_new, 0 );
+ sigaction( SIGTERM, &sa_new, 0 );
+ sigaction( SIGABRT, &sa_new, 0 );
+
+ /*** command line arguments handler ***/
+ if( argc == 1 )
+ {
+ usage();
+ exit(-1);
+ }
+
+ /* process command line options */
+ while( (option = getopt(argc, argv, "i:o:hv") ) != -1 )
+ {
+ switch( option )
+ {
+ case 'i' : /* specify input file name */
+ if( strlen(optarg) > 75 )
+ abort_on_error(-1);
+ strcpy( infile, optarg );
+ break;
+
+ case 'o' : /* specify output file name */
+ if( strlen(optarg) > 75 )
+ abort_on_error(-2);
+ strcpy( otfile, optarg );
+ break;
+
+ case 'h' : /* print usage and exit */
+ usage();
+ exit(0);
+
+ case 'v' : /* print nec2c version */
+ puts( version );
+ exit(0);
+
+ default: /* print usage and exit */
+ usage();
+ exit(-1);
+
+ } /* end of switch( option ) */
+
+ } /* while( (option = getopt(argc, argv, "i:o:hv") ) != -1 ) */
+
+ /*** open input file ***/
+ if( (input_fp = fopen(infile, "r")) == NULL )
+ {
+ char mesg[88] = "nec2c: ";
+
+ strcat( mesg, infile );
+ perror( mesg );
+ exit(-1);
+ }
+
+ /* make an output file name if not */
+ /* specified by user on invocation */
+ if( strlen( otfile ) == 0 )
+ {
+ /* strip file name extension if there is one */
+ idx = 0;
+ while( (infile[++idx] != '.') && (infile[idx] != '\0') );
+ infile[idx] = '\0';
+
+ /* make the output file name from input file */
+ strcpy( otfile, infile );
+ strcat( otfile, ".out" ); /* add extension */
+ }
+
+ /* open output file */
+ if( (output_fp = fopen(otfile, "w")) == NULL )
+ {
+ char mesg[88] = "nec2c: ";
+
+ strcat( mesg, otfile );
+ perror( mesg );
+ exit(-1);
+ }
+
+ /*** here we had code to read interactively input/output ***/
+ /*** file names. this is done non-interactively above. ***/
+
+ secnds( &extim );
+
+ /* Null local buffer pointers */
+ /* type int */
+ ldtyp = ldtag = ldtagf = ldtagt = NULL;
+ /* type long double */
+ zlr = zli = zlc = fnorm = NULL;
+ xtemp = ytemp = ztemp = sitemp = bitemp = NULL;
+ /* type complex long double */
+ cm = NULL;
+
+ /* Null global pointers */
+ Null_Pointers();
+
+ /* Allocate some buffers */
+ mem_alloc( (void *)&ggrid.ar1, sizeof(complex long double)*11*10*4 );
+ mem_alloc( (void *)&ggrid.ar2, sizeof(complex long double)*17*5*4 );
+ mem_alloc( (void *)&ggrid.ar3, sizeof(complex long double)*9*8*4 );
+
+ /* Initialize ground grid parameters for somnec */
+ ggrid.nxa[0] = 11;
+ ggrid.nxa[1] = 17;
+ ggrid.nxa[2] = 9;
+
+ ggrid.nya[0] = 10;
+ ggrid.nya[1] = 5;
+ ggrid.nya[2] = 8;
+
+ ggrid.dxa[0] = .02;
+ ggrid.dxa[1] = .05;
+ ggrid.dxa[2] = .1;
+
+ ggrid.dya[0] = .1745329252;
+ ggrid.dya[1] = .0872664626;
+ ggrid.dya[2] = .1745329252;
+
+ ggrid.xsa[0] = 0.;
+ ggrid.xsa[1] = .2;
+ ggrid.xsa[2] = .2;
+
+ ggrid.ysa[0] = 0.;
+ ggrid.ysa[1] = 0.;
+ ggrid.ysa[2] = .3490658504;
+
+ /* l_1: */
+ /* main execution loop, exits at various points */
+ /* depending on error conditions or end of jobs */
+ while( TRUE )
+ {
+ ifrtmw=0;
+ ifrtmp=0;
+
+ /* print the nec2c header to output file */
+ fprintf( output_fp, "\n\n\n"
+ " "
+ " __________________________________________\n"
+ " "
+ "| |\n"
+ " "
+ "| NUMERICAL ELECTROMAGNETICS CODE (nec2c) |\n"
+ " "
+ "| Translated to 'C' in Double Precision |\n"
+ " "
+ "|__________________________________________|\n" );
+
+ /* read a line from input file */
+ if( load_line(line_buf, input_fp) == EOF )
+ abort_on_error(-3);
+
+ /* separate card's id mnemonic */
+ strncpy( ain, line_buf, 2 );
+ ain[2] = '\0';
+
+ /* if its a "cm" or "ce" card start reading comments */
+ if( (strcmp(ain, "CM") == 0) ||
+ (strcmp(ain, "CE") == 0) )
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---------------- COMMENTS ----------------\n" );
+
+ /* write comment to output file */
+ fprintf( output_fp,
+ " %s\n",
+ &line_buf[2] );
+
+ /* Keep reading till a non "CM" card */
+ while( strcmp(ain, "CM") == 0 )
+ {
+ /* read a line from input file */
+ if( load_line(line_buf, input_fp) == EOF )
+ abort_on_error(-3);
+
+ /* separate card's id mnemonic */
+ strncpy( ain, line_buf, 2 );
+ ain[2] = '\0';
+
+ /* write comment to output file */
+ fprintf( output_fp,
+ " %s\n",
+ &line_buf[2] );
+
+ } /* while( strcmp(ain, "CM") == 0 ) */
+
+ /* no "ce" card at end of comments */
+ if( strcmp(ain, "CE") != 0 )
+ {
+ fprintf( output_fp,
+ "\n\n ERROR: INCORRECT LABEL FOR A COMMENT CARD" );
+ abort_on_error(-4);
+ }
+
+ } /* if( strcmp(ain, "CM") == 0 ... */
+ else
+ rewind( input_fp );
+
+ /* initializations etc from original fortran code */
+ mpcnt=0;
+ matpar.imat=0;
+
+ /* set up geometry data in subroutine datagn */
+ datagn();
+ iflow=1;
+
+ /* Allocate some buffers */
+ mreq = data.npm * sizeof(long double);
+ mem_realloc( (void *)&crnt.air, mreq );
+ mem_realloc( (void *)&crnt.aii, mreq );
+ mem_realloc( (void *)&crnt.bir, mreq );
+ mem_realloc( (void *)&crnt.bii, mreq );
+ mem_realloc( (void *)&crnt.cir, mreq );
+ mem_realloc( (void *)&crnt.cii, mreq );
+ mem_realloc( (void *)&xtemp, mreq );
+ mem_realloc( (void *)&ytemp, mreq );
+ mem_realloc( (void *)&ztemp, mreq );
+ mem_realloc( (void *)&sitemp, mreq );
+ mem_realloc( (void *)&bitemp, mreq );
+
+ mreq = data.np2m * sizeof(int);
+ mem_realloc( (void *)&save.ip, mreq );
+
+ mreq = data.np3m * sizeof( complex long double);
+ mem_realloc( (void *)&crnt.cur, mreq );
+
+ /* Matrix parameters */
+ if( matpar.imat == 0)
+ {
+ netcx.neq= data.n+2*data.m;
+ netcx.neq2=0;
+ }
+
+ fprintf( output_fp, "\n\n\n" );
+
+ /* default values for input parameters and flags */
+ netcx.npeq= data.np+2*data.mp;
+ plot.iplp1=0;
+ plot.iplp2=0;
+ plot.iplp3=0;
+ plot.iplp4=0;
+ igo=1;
+ nfrq=1;
+ rkh=1.;
+ iexk=0;
+ fpat.ixtyp=0;
+ zload.nload=0;
+ netcx.nonet=0;
+ fpat.near=-1;
+ iptflg=-2;
+ iptflq=-1;
+ gnd.ifar=-1;
+ gnd.zrati=CPLX_10;
+ iped=0;
+ yparm.ncoup=0;
+ yparm.icoup=0;
+ save.fmhz= CVEL;
+ gnd.ksymp=1;
+ gnd.nradl=0;
+ gnd.iperf=0;
+
+ /* l_14: */
+
+ /* main input section, exits at various points */
+ /* depending on error conditions or end of job */
+ next_job = FALSE;
+ while( ! next_job )
+ {
+ jmp_iloop = FALSE;
+
+ /* main input section - standard read statement - jumps */
+ /* to appropriate section for specific parameter set up */
+ readmn( ain, &itmp1, &itmp2, &itmp3, &itmp4,
+ &tmp1, &tmp2, &tmp3, &tmp4, &tmp5, &tmp6 );
+
+ /* If its an "XT" card, exit */
+ if( strcmp(ain, "XT" ) == 0 )
+ {
+ fprintf( stderr,
+ "\nnec2c: Exiting after an \"XT\" command in main()\n" );
+ fprintf( output_fp,
+ "\n\n nec2c: Exiting after an \"XT\" command in main()" );
+ stop(0);
+ }
+
+ mpcnt++;
+ fprintf( output_fp,
+ "\n DATA CARD No: %3d "
+ "%s %3d %5d %5d %5d %12.5LE %12.5LE %12.5LE %12.5LE %12.5LE %12.5LE",
+ mpcnt, ain, itmp1, itmp2, itmp3, itmp4,
+ tmp1, tmp2, tmp3, tmp4, tmp5, tmp6 );
+
+ /* identify card id mnemonic (except "ce" and "cm") */
+ for( ain_num = 0; ain_num < NUM_CMNDS; ain_num++ )
+ if( strncmp( ain, atst[ain_num], 2) == 0 )
+ break;
+
+ /* take action according to card id mnemonic */
+ switch( ain_num )
+ {
+ case 0: /* "fr" card, frequency parameters */
+
+ ifrq= itmp1;
+ nfrq= itmp2;
+ if( nfrq == 0)
+ nfrq=1;
+ save.fmhz= tmp1;
+ delfrq= tmp2;
+ if( iped == 1)
+ zpnorm=0.;
+ igo=1;
+ iflow=1;
+
+ continue; /* continue card input loop */
+
+ case 1: /* "ld" card, loading parameters */
+ {
+ int idx;
+
+ if( iflow != 3 )
+ {
+ iflow=3;
+ /* Free loading buffers */
+ zload.nload=0;
+ free_ptr( (void *)&ldtyp );
+ free_ptr( (void *)&ldtag );
+ free_ptr( (void *)&ldtagf );
+ free_ptr( (void *)&ldtagt );
+ free_ptr( (void *)&zlr );
+ free_ptr( (void *)&zli );
+ free_ptr( (void *)&zlc );
+
+ if( igo > 2 )
+ igo=2;
+ if( itmp1 == -1 )
+ continue; /* continue card input loop */
+ }
+
+ /* Reallocate loading buffers */
+ zload.nload++;
+ idx = zload.nload * sizeof(int);
+ mem_realloc( (void *)&ldtyp, idx );
+ mem_realloc( (void *)&ldtag, idx );
+ mem_realloc( (void *)&ldtagf, idx );
+ mem_realloc( (void *)&ldtagt, idx );
+ idx = zload.nload * sizeof(long double);
+ mem_realloc( (void *)&zlr, idx );
+ mem_realloc( (void *)&zli, idx );
+ mem_realloc( (void *)&zlc, idx );
+
+ idx = zload.nload-1;
+ ldtyp[idx]= itmp1;
+ ldtag[idx]= itmp2;
+ if( itmp4 == 0)
+ itmp4= itmp3;
+ ldtagf[idx]= itmp3;
+ ldtagt[idx]= itmp4;
+
+ if( itmp4 < itmp3 )
+ {
+ fprintf( output_fp,
+ "\n\n DATA FAULT ON LOADING CARD No: %d: ITAG "
+ "STEP1: %d IS GREATER THAN ITAG STEP2: %d",
+ zload.nload, itmp3, itmp4 );
+ stop(-1);
+ }
+
+ zlr[idx]= tmp1;
+ zli[idx]= tmp2;
+ zlc[idx]= tmp3;
+ }
+
+ continue; /* continue card input loop */
+
+ case 2: /* "gn" card, ground parameters under the antenna */
+
+ iflow=4;
+
+ if( igo > 2)
+ igo=2;
+
+ if( itmp1 == -1 )
+ {
+ gnd.ksymp=1;
+ gnd.nradl=0;
+ gnd.iperf=0;
+ continue; /* continue card input loop */
+ }
+
+ gnd.iperf= itmp1;
+ gnd.nradl= itmp2;
+ gnd.ksymp=2;
+ save.epsr= tmp1;
+ save.sig= tmp2;
+
+ if( gnd.nradl != 0)
+ {
+ if( gnd.iperf == 2)
+ {
+ fprintf( output_fp,
+ "\n\n RADIAL WIRE G.S. APPROXIMATION MAY "
+ "NOT BE USED WITH SOMMERFELD GROUND OPTION" );
+ stop(-1);
+ }
+
+ save.scrwlt= tmp3;
+ save.scrwrt= tmp4;
+ continue; /* continue card input loop */
+ }
+
+ fpat.epsr2= tmp3;
+ fpat.sig2= tmp4;
+ fpat.clt= tmp5;
+ fpat.cht= tmp6;
+
+ continue; /* continue card input loop */
+
+ case 3: /* "ex" card, excitation parameters */
+
+ if( iflow != 5)
+ {
+ /* Free vsource buffers */
+ free_ptr( (void *)&vsorc.ivqd );
+ free_ptr( (void *)&vsorc.iqds );
+ free_ptr( (void *)&vsorc.vqd );
+ free_ptr( (void *)&vsorc.vqds );
+ free_ptr( (void *)&vsorc.isant );
+ free_ptr( (void *)&vsorc.vsant );
+
+ vsorc.nsant=0;
+ vsorc.nvqd=0;
+ iped=0;
+ iflow=5;
+ if( igo > 3)
+ igo=3;
+ }
+
+ fpat.ixtyp= itmp1;
+ netcx.masym= itmp4/10;
+ if( (itmp1 == 0) || (itmp1 == 5) )
+ {
+ netcx.ntsol=0;
+
+ if( fpat.ixtyp == 5)
+ {
+ vsorc.nvqd++;
+ mem_realloc( (void *)&vsorc.ivqd, vsorc.nvqd * sizeof(int) );
+ mem_realloc( (void *)&vsorc.iqds, vsorc.nvqd * sizeof(int) );
+ mem_realloc( (void *)&vsorc.vqd, vsorc.nvqd * sizeof(complex long double) );
+ mem_realloc( (void *)&vsorc.vqds, vsorc.nvqd * sizeof(complex long double) );
+
+ {
+ int indx = vsorc.nvqd-1;
+
+ vsorc.ivqd[indx]= isegno( itmp2, itmp3);
+ vsorc.vqd[indx]= cmplx( tmp1, tmp2);
+ if( cabsl( vsorc.vqd[indx]) < 1.e-20)
+ vsorc.vqd[indx] = CPLX_10;
+
+ iped= itmp4- netcx.masym*10;
+ zpnorm= tmp3;
+ if( (iped == 1) && (zpnorm > 0.0) )
+ iped=2;
+ continue; /* continue card input loop */
+ }
+
+ } /* if( fpat.ixtyp == 5) */
+
+ vsorc.nsant++;
+ mem_realloc( (void *)&vsorc.isant, vsorc.nsant * sizeof(int) );
+ mem_realloc( (void *)&vsorc.vsant, vsorc.nsant * sizeof(complex long double) );
+
+ {
+ int indx = vsorc.nsant-1;
+
+ vsorc.isant[indx]= isegno( itmp2, itmp3);
+ vsorc.vsant[indx]= cmplx( tmp1, tmp2);
+ if( cabsl( vsorc.vsant[indx]) < 1.e-20)
+ vsorc.vsant[indx] = CPLX_10;
+
+ iped= itmp4- netcx.masym*10;
+ zpnorm= tmp3;
+ if( (iped == 1) && (zpnorm > 0.0) )
+ iped=2;
+ continue; /* continue card input loop */
+ }
+
+ } /* if( (itmp1 <= 0) || (itmp1 == 5) ) */
+
+ nthi= itmp2;
+ nphi= itmp3;
+ xpr1= tmp1;
+ xpr2= tmp2;
+ xpr3= tmp3;
+ xpr4= tmp4;
+ xpr5= tmp5;
+ fpat.xpr6= tmp6;
+ vsorc.nsant=0;
+ vsorc.nvqd=0;
+ thetis= xpr1;
+ phiss= xpr2;
+
+ continue; /* continue card input loop */
+
+ case 4: case 5: /* "nt" & "tl" cards, network parameters */
+ {
+ int idx;
+
+ if( iflow != 6)
+ {
+ netcx.nonet=0;
+ netcx.ntsol=0;
+ iflow=6;
+
+ /* Free network buffers */
+ free_ptr( (void *)&netcx.ntyp );
+ free_ptr( (void *)&netcx.iseg1 );
+ free_ptr( (void *)&netcx.iseg2 );
+ free_ptr( (void *)&netcx.x11r );
+ free_ptr( (void *)&netcx.x11i );
+ free_ptr( (void *)&netcx.x12r );
+ free_ptr( (void *)&netcx.x12i );
+ free_ptr( (void *)&netcx.x22r );
+ free_ptr( (void *)&netcx.x22i );
+
+ if( igo > 3)
+ igo=3;
+
+ if( itmp2 == -1 )
+ continue; /* continue card input loop */
+ }
+
+ /* Re-allocate network buffers */
+ netcx.nonet++;
+ idx = netcx.nonet * sizeof(int);
+ mem_realloc( (void *)&netcx.ntyp, idx );
+ mem_realloc( (void *)&netcx.iseg1, idx );
+ mem_realloc( (void *)&netcx.iseg2, idx );
+ idx = netcx.nonet * sizeof(long double);
+ mem_realloc( (void *)&netcx.x11r, idx );
+ mem_realloc( (void *)&netcx.x11i, idx );
+ mem_realloc( (void *)&netcx.x12r, idx );
+ mem_realloc( (void *)&netcx.x12i, idx );
+ mem_realloc( (void *)&netcx.x22r, idx );
+ mem_realloc( (void *)&netcx.x22i, idx );
+
+ idx = netcx.nonet-1;
+ if( ain_num == 4 )
+ netcx.ntyp[idx]=1;
+ else
+ netcx.ntyp[idx]=2;
+
+ netcx.iseg1[idx]= isegno( itmp1, itmp2);
+ netcx.iseg2[idx]= isegno( itmp3, itmp4);
+ netcx.x11r[idx]= tmp1;
+ netcx.x11i[idx]= tmp2;
+ netcx.x12r[idx]= tmp3;
+ netcx.x12i[idx]= tmp4;
+ netcx.x22r[idx]= tmp5;
+ netcx.x22i[idx]= tmp6;
+
+ if( (netcx.ntyp[idx] == 1) || (tmp1 > 0.) )
+ continue; /* continue card input loop */
+
+ netcx.ntyp[idx]=3;
+ netcx.x11r[idx]=- tmp1;
+
+ continue; /* continue card input loop */
+ }
+
+ case 6: /* "xq" execute card - calc. including radiated fields */
+
+ if( ((iflow == 10) && (itmp1 == 0)) ||
+ ((nfrq == 1) && (itmp1 == 0) && (iflow > 7)) )
+ continue; /* continue card input loop */
+
+ if( itmp1 == 0)
+ {
+ if( iflow > 7)
+ iflow=11;
+ else
+ iflow=7;
+ }
+ else
+ {
+ gnd.ifar=0;
+ fpat.rfld=0.;
+ fpat.ipd=0;
+ fpat.iavp=0;
+ fpat.inor=0;
+ fpat.iax=0;
+ fpat.nth=91;
+ fpat.nph=1;
+ fpat.thets=0.;
+ fpat.phis=0.;
+ fpat.dth=1.0;
+ fpat.dph=0.;
+
+ if( itmp1 == 2)
+ fpat.phis=90.;
+
+ if( itmp1 == 3)
+ {
+ fpat.nph=2;
+ fpat.dph=90.;
+ }
+
+ } /* if( itmp1 == 0) */
+
+ break;
+
+ case 7: /* "gd" card, ground representation */
+
+ fpat.epsr2= tmp1;
+ fpat.sig2= tmp2;
+ fpat.clt= tmp3;
+ fpat.cht= tmp4;
+ iflow=9;
+
+ continue; /* continue card input loop */
+
+ case 8: /* "rp" card, standard observation angle parameters */
+
+ gnd.ifar= itmp1;
+ fpat.nth= itmp2;
+ fpat.nph= itmp3;
+
+ if( fpat.nth == 0)
+ fpat.nth=1;
+ if( fpat.nph == 0)
+ fpat.nph=1;
+
+ fpat.ipd= itmp4/10;
+ fpat.iavp= itmp4- fpat.ipd*10;
+ fpat.inor= fpat.ipd/10;
+ fpat.ipd= fpat.ipd- fpat.inor*10;
+ fpat.iax= fpat.inor/10;
+ fpat.inor= fpat.inor- fpat.iax*10;
+
+ if( fpat.iax != 0)
+ fpat.iax=1;
+ if( fpat.ipd != 0)
+ fpat.ipd=1;
+ if( (fpat.nth < 2) || (fpat.nph < 2) || (gnd.ifar == 1) )
+ fpat.iavp=0;
+
+ fpat.thets= tmp1;
+ fpat.phis= tmp2;
+ fpat.dth= tmp3;
+ fpat.dph= tmp4;
+ fpat.rfld= tmp5;
+ fpat.gnor= tmp6;
+ iflow=10;
+
+ break;
+
+ case 9: /* "nx" card, do next job */
+ next_job = TRUE;
+ continue; /* continue card input loop */
+
+ case 10: /* "pt" card, print control for current */
+
+ iptflg= itmp1;
+ iptag= itmp2;
+ iptagf= itmp3;
+ iptagt= itmp4;
+
+ if( (itmp3 == 0) && (iptflg != -1) )
+ iptflg=-2;
+ if( itmp4 == 0)
+ iptagt= iptagf;
+
+ continue; /* continue card input loop */
+
+ case 11: /* "kh" card, matrix integration limit */
+
+ rkh= tmp1;
+ if( igo > 2)
+ igo=2;
+ iflow=1;
+
+ continue; /* continue card input loop */
+
+ case 12: case 13: /* "ne"/"nh" cards, near field calculation parameters */
+
+ if( ain_num == 13 )
+ fpat.nfeh=1;
+ else
+ fpat.nfeh=0;
+
+ if( (iflow == 8) && (nfrq != 1) )
+ {
+ fprintf( output_fp,
+ "\n\n WHEN MULTIPLE FREQUENCIES ARE REQUESTED, "
+ "ONLY ONE NEAR FIELD CARD CAN BE USED -"
+ "\n LAST CARD READ WILL BE USED" );
+ }
+
+ fpat.near= itmp1;
+ fpat.nrx= itmp2;
+ fpat.nry= itmp3;
+ fpat.nrz= itmp4;
+ fpat.xnr= tmp1;
+ fpat.ynr= tmp2;
+ fpat.znr= tmp3;
+ fpat.dxnr= tmp4;
+ fpat.dynr= tmp5;
+ fpat.dznr= tmp6;
+ iflow=8;
+
+ if( nfrq != 1)
+ continue; /* continue card input loop */
+
+ break;
+
+ case 14: /* "pq" card, write control for charge */
+
+ iptflq= itmp1;
+ iptaq= itmp2;
+ iptaqf= itmp3;
+ iptaqt= itmp4;
+
+ if( (itmp3 == 0) && (iptflq != -1) )
+ iptflq=-2;
+ if( itmp4 == 0)
+ iptaqt= iptaqf;
+
+ continue; /* continue card input loop */
+
+ case 15: /* "ek" card, extended thin wire kernel option */
+
+ iexk=1;
+ if( itmp1 == -1)
+ iexk=0;
+ if( igo > 2)
+ igo=2;
+ iflow=1;
+
+ continue; /* continue card input loop */
+
+ case 16: /* "cp" card, maximum coupling between antennas */
+
+ if( iflow != 2)
+ {
+ yparm.ncoup=0;
+ free_ptr( (void *)&yparm.nctag );
+ free_ptr( (void *)&yparm.ncseg );
+ free_ptr( (void *)&yparm.y11a );
+ free_ptr( (void *)&yparm.y12a );
+ }
+
+ yparm.icoup=0;
+ iflow=2;
+
+ if( itmp2 == 0)
+ continue; /* continue card input loop */
+
+ yparm.ncoup++;
+ mem_realloc( (void *)&yparm.nctag, (yparm.ncoup) * sizeof(int) );
+ mem_realloc( (void *)&yparm.ncseg, (yparm.ncoup) * sizeof(int) );
+ yparm.nctag[yparm.ncoup-1]= itmp1;
+ yparm.ncseg[yparm.ncoup-1]= itmp2;
+
+ if( itmp4 == 0)
+ continue; /* continue card input loop */
+
+ yparm.ncoup++;
+ mem_realloc( (void *)&yparm.nctag, (yparm.ncoup) * sizeof(int) );
+ mem_realloc( (void *)&yparm.ncseg, (yparm.ncoup) * sizeof(int) );
+ yparm.nctag[yparm.ncoup-1]= itmp3;
+ yparm.ncseg[yparm.ncoup-1]= itmp4;
+
+ continue; /* continue card input loop */
+
+ case 17: /* "pl" card, plot flags */
+
+ plot.iplp1= itmp1;
+ plot.iplp2= itmp2;
+ plot.iplp3= itmp3;
+ plot.iplp4= itmp4;
+
+ if( plot_fp == NULL )
+ {
+ char plotfile[81];
+
+ /* Make a plot file name */
+ strcpy( plotfile, infile );
+ strcat( plotfile, ".plt" );
+
+ /* Open plot file */
+ if( (plot_fp = fopen(plotfile, "w")) == NULL )
+ {
+ char mesg[88] = "nec2c: ";
+
+ strcat( mesg, plotfile );
+ perror( mesg );
+ exit(-1);
+ }
+ }
+
+ continue; /* continue card input loop */
+
+ case 19: /* "wg" card, not supported */
+ abort_on_error(-5);
+
+ default:
+ if( ain_num != 18 )
+ {
+ fprintf( output_fp,
+ "\n\n FAULTY DATA CARD LABEL AFTER GEOMETRY SECTION" );
+ stop(-1);
+ }
+
+ /******************************************************
+ *** normal exit of nec2c when all jobs complete ok ***
+ ******************************************************/
+
+ /* time the process */
+ secnds( &tmp1 );
+ tmp1 -= extim;
+ fprintf( output_fp, "\n\n TOTAL RUN TIME: %d msec", (int)tmp1 );
+ stop(0);
+
+ } /* switch( ain_num ) */
+
+ /**************************************
+ *** end of the main input section. ***
+ *** beginning of frequency do loop ***
+ **************************************/
+
+ /* Allocate to normalization buffer */
+ {
+ int mreq1, mreq2;
+
+ mreq1 = mreq2 = 0;
+ if( iped )
+ mreq1 = 4*nfrq * sizeof(long double);
+ if( iptflg >= 2 )
+ mreq2 = nthi*nphi * sizeof(long double);
+
+ if( (mreq1 > 0) || (mreq2 > 0) )
+ {
+ if( mreq1 > mreq2 )
+ mem_realloc( (void *)&fnorm, mreq1 );
+ else
+ mem_realloc( (void *)&fnorm, mreq2 );
+ }
+ }
+
+ /* igox is used in place of "igo" in the */
+ /* freq loop. below is a special igox case */
+ if( ((ain_num == 6) || (ain_num == 8)) && (igo == 5) )
+ igox = 6;
+ else
+ igox = igo;
+
+ switch( igox )
+ {
+ case 1: /* label 41 */
+ /* Memory allocation for primary interacton matrix. */
+ iresrv = data.np2m * (data.np+2*data.mp);
+ mem_realloc( (void *)&cm, iresrv * sizeof(complex long double) );
+
+ /* Memory allocation for symmetry array */
+ smat.nop = netcx.neq/netcx.npeq;
+ mem_realloc( (void *)&smat.ssx, smat.nop*smat.nop* sizeof( complex long double) );
+
+ mhz=1;
+
+ if( (data.n != 0) && (ifrtmw != 1) )
+ {
+ ifrtmw=1;
+ for( i = 0; i < data.n; i++ )
+ {
+ xtemp[i]= data.x[i];
+ ytemp[i]= data.y[i];
+ ztemp[i]= data.z[i];
+ sitemp[i]= data.si[i];
+ bitemp[i]= data.bi[i];
+ }
+ }
+
+ if( (data.m != 0) && (ifrtmp != 1) )
+ {
+ ifrtmp=1;
+ for( i = 0; i < data.m; i++ )
+ {
+ j = i+data.n;
+ xtemp[j]= data.px[i];
+ ytemp[j]= data.py[i];
+ ztemp[j]= data.pz[i];
+ bitemp[j]= data.pbi[i];
+ }
+ }
+
+ /* irngf is not used (NGF function not implemented) */
+ if( matpar.imat == 0)
+ fblock( netcx.npeq, netcx.neq, iresrv, data.ipsym);
+
+ /* label 42 */
+ /* frequency do loop */
+ do
+ {
+ jmp_floop = FALSE;
+
+ if( mhz != 1)
+ {
+ if( ifrq == 1)
+ save.fmhz *= delfrq;
+ else
+ save.fmhz += delfrq;
+ }
+
+ fr= save.fmhz/ CVEL;
+ data.wlam= CVEL/ save.fmhz;
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "--------- FREQUENCY --------\n"
+ " "
+ "FREQUENCY :%11.4LE MHz\n"
+ " "
+ "WAVELENGTH:%11.4LE Mtr", save.fmhz, data.wlam );
+
+ fprintf( output_fp, "\n\n"
+ " "
+ "APPROXIMATE INTEGRATION EMPLOYED FOR SEGMENTS \n"
+ " "
+ "THAT ARE MORE THAN %.3LF WAVELENGTHS APART", rkh );
+
+ if( iexk == 1)
+ fprintf( output_fp, "\n"
+ " "
+ "THE EXTENDED THIN WIRE KERNEL WILL BE USED" );
+
+ /* frequency scaling of geometric parameters */
+ if( data.n != 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ data.x[i]= xtemp[i]* fr;
+ data.y[i]= ytemp[i]* fr;
+ data.z[i]= ztemp[i]* fr;
+ data.si[i]= sitemp[i]* fr;
+ data.bi[i]= bitemp[i]* fr;
+ }
+ }
+
+ if( data.m != 0)
+ {
+ fr2= fr* fr;
+ for( i = 0; i < data.m; i++ )
+ {
+ j = i+data.n;
+ data.px[i]= xtemp[j]* fr;
+ data.py[i]= ytemp[j]* fr;
+ data.pz[i]= ztemp[j]* fr;
+ data.pbi[i]= bitemp[j]* fr2;
+ }
+ }
+
+ igo = 2;
+
+ /* label 46 */
+ case 2: /* structure segment loading */
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "------ STRUCTURE IMPEDANCE LOADING ------" );
+
+ if( zload.nload != 0)
+ load( ldtyp, ldtag, ldtagf, ldtagt, zlr, zli, zlc );
+
+ if( zload.nload == 0 )
+ fprintf( output_fp, "\n"
+ " "
+ "THIS STRUCTURE IS NOT LOADED" );
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "-------- ANTENNA ENVIRONMENT --------" );
+
+ if( gnd.ksymp != 1)
+ {
+ gnd.frati=CPLX_10;
+
+ if( gnd.iperf != 1)
+ {
+ if( save.sig < 0.)
+ save.sig=- save.sig/(59.96*data.wlam);
+
+ epsc= cmplx( save.epsr, -save.sig*data.wlam*59.96);
+ gnd.zrati=1./ csqrtl( epsc);
+ gwav.u= gnd.zrati;
+ gwav.u2= gwav.u* gwav.u;
+
+ if( gnd.nradl != 0)
+ {
+ gnd.scrwl= save.scrwlt/ data.wlam;
+ gnd.scrwr= save.scrwrt/ data.wlam;
+ gnd.t1= CPLX_01*2367.067/ (long double)gnd.nradl;
+ gnd.t2= gnd.scrwr* (long double)gnd.nradl;
+
+ fprintf( output_fp, "\n"
+ " "
+ "RADIAL WIRE GROUND SCREEN\n"
+ " "
+ "%d WIRES\n"
+ " "
+ "WIRE LENGTH: %8.2LF METERS\n"
+ " "
+ "WIRE RADIUS: %10.3LE METERS",
+ gnd.nradl, save.scrwlt, save.scrwrt );
+
+ fprintf( output_fp, "\n"
+ " "
+ "MEDIUM UNDER SCREEN -" );
+
+ } /* if( gnd.nradl != 0) */
+
+ if( gnd.iperf != 2)
+ fprintf( output_fp, "\n"
+ " "
+ "FINITE GROUND - REFLECTION COEFFICIENT APPROXIMATION" );
+ else
+ {
+ somnec( save.epsr, save.sig, save.fmhz );
+ gnd.frati=( epsc-1.)/( epsc+1.);
+ if( cabsl(( ggrid.epscf- epsc)/ epsc) >= 1.0e-3 )
+ {
+ fprintf( output_fp,
+ "\n ERROR IN GROUND PARAMETERS -"
+ "\n COMPLEX DIELECTRIC CONSTANT FROM FILE IS: %12.5LE%+12.5LEj"
+ "\n REQUESTED: %12.5LE%+12.5LEj",
+ creall(ggrid.epscf), cimagl(ggrid.epscf), creall(epsc), cimagl(epsc) );
+ stop(-1);
+ }
+
+ fprintf( output_fp, "\n"
+ " "
+ "FINITE GROUND - SOMMERFELD SOLUTION" );
+
+ } /* if( gnd.iperf != 2) */
+
+ fprintf( output_fp, "\n"
+ " "
+ "RELATIVE DIELECTRIC CONST: %.3LF\n"
+ " "
+ "CONDUCTIVITY: %10.3LE MHOS/METER\n"
+ " "
+ "COMPLEX DIELECTRIC CONSTANT: %11.4LE%+11.4LEj",
+ save.epsr, save.sig, creall(epsc), cimagl(epsc) );
+
+ } /* if( gnd.iperf != 1) */
+ else
+ fprintf( output_fp, "\n"
+ " "
+ "PERFECT GROUND" );
+
+ } /* if( gnd.ksymp != 1) */
+ else
+ fprintf( output_fp, "\n"
+ " "
+ "FREE SPACE" );
+
+ /* label 50 */
+ /* fill and factor primary interaction matrix */
+ secnds( &tim1 );
+ cmset( netcx.neq, cm, rkh, iexk );
+ secnds( &tim2 );
+ tim= tim2- tim1;
+ factrs( netcx.npeq, netcx.neq, cm, save.ip );
+ secnds( &tim1 );
+ tim2= tim1- tim2;
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---------- MATRIX TIMING ----------\n"
+ " "
+ "FILL: %d msec FACTOR: %d msec",
+ (int)tim, (int)tim2 );
+
+ igo=3;
+ netcx.ntsol=0;
+
+ /* label 53 */
+ case 3: /* excitation set up (right hand side, -e inc.) */
+
+ nthic=1;
+ nphic=1;
+ inc=1;
+ netcx.nprint=0;
+
+ /* l_54 */
+ do
+ {
+ if( (fpat.ixtyp != 0) && (fpat.ixtyp != 5) )
+ {
+ if( (iptflg <= 0) || (fpat.ixtyp == 4) )
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---------- EXCITATION ----------" );
+
+ tmp5= TA* xpr5;
+ tmp4= TA* xpr4;
+
+ if( fpat.ixtyp == 4)
+ {
+ tmp1= xpr1/ data.wlam;
+ tmp2= xpr2/ data.wlam;
+ tmp3= xpr3/ data.wlam;
+ tmp6= fpat.xpr6/( data.wlam* data.wlam);
+
+ fprintf( output_fp, "\n"
+ " "
+ " CURRENT SOURCE\n"
+ " -- POSITION (METERS) -- "
+ " ORIENTATION (DEG)\n"
+ " X Y Z "
+ " ALPHA BETA DIPOLE MOMENT\n"
+ " %10.5LF %10.5LF %10.5LF "
+ " %7.2LF %7.2LF %8.3LF",
+ xpr1, xpr2, xpr3, xpr4, xpr5, fpat.xpr6 );
+ }
+ else
+ {
+ tmp1= TA* xpr1;
+ tmp2= TA* xpr2;
+ tmp3= TA* xpr3;
+ tmp6= fpat.xpr6;
+
+ if( iptflg <= 0)
+ fprintf( output_fp,
+ "\n PLANE WAVE - THETA: %7.2LF deg, PHI: %7.2LF deg,"
+ " ETA=%7.2LF DEG, TYPE - %s AXIAL RATIO: %6.3LF",
+ xpr1, xpr2, xpr3, hpol[fpat.ixtyp-1], fpat.xpr6 );
+
+ } /* if( fpat.ixtyp == 4) */
+
+ } /* if( (fpat.ixtyp != 0) && (fpat.ixtyp <= 4) ) */
+
+ /* fills e field right-hand matrix */
+ etmns( tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, fpat.ixtyp, crnt.cur);
+
+ /* matrix solving (netwk calls solves) */
+ if( (netcx.nonet != 0) && (inc <= 1) )
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---------- NETWORK DATA ----------" );
+
+ itmp3=0;
+ itmp1= netcx.ntyp[0];
+
+ for( i = 0; i < 2; i++ )
+ {
+ if( itmp1 == 3)
+ itmp1=2;
+
+ if( itmp1 == 2)
+ fprintf( output_fp, "\n"
+ " -- FROM - --- TO -- TRANSMISSION LINE "
+ " --------- SHUNT ADMITTANCES (MHOS) --------- LINE\n"
+ " TAG SEG TAG SEG IMPEDANCE LENGTH "
+ " ----- END ONE ----- ----- END TWO ----- TYPE\n"
+ " No: No: No: No: OHMS METERS "
+ " REAL IMAGINARY REAL IMAGINARY" );
+ else
+ if( itmp1 == 1)
+ fprintf( output_fp, "\n"
+ " -- FROM - --- TO -- --------"
+ " ADMITTANCE MATRIX ELEMENTS (MHOS) ---------\n"
+ " TAG SEG TAG SEG ----- (ONE,ONE) ------ "
+ " ----- (ONE,TWO) ----- ----- (TWO,TWO) -------\n"
+ " No: No: No: No: REAL IMAGINARY "
+ " REAL IMAGINARY REAL IMAGINARY" );
+
+ for( j = 0; j < netcx.nonet; j++)
+ {
+ itmp2= netcx.ntyp[j];
+
+ if( (itmp2/itmp1) != 1 )
+ itmp3 = itmp2;
+ else
+ {
+ int idx4, idx5;
+
+ itmp4= netcx.iseg1[j];
+ itmp5= netcx.iseg2[j];
+ idx4 = itmp4-1;
+ idx5 = itmp5-1;
+
+ if( (itmp2 >= 2) && (netcx.x11i[j] <= 0.) )
+ {
+ long double xx, yy, zz;
+
+ xx = data.x[idx5]- data.x[idx4];
+ yy = data.y[idx5]- data.y[idx4];
+ zz = data.z[idx5]- data.z[idx4];
+ netcx.x11i[j]= data.wlam* sqrtl( xx*xx + yy*yy + zz*zz );
+ }
+
+ fprintf( output_fp, "\n"
+ " %4d %5d %4d %5d %11.4LE %11.4LE "
+ "%11.4LE %11.4LE %11.4LE %11.4LE %s",
+ data.itag[idx4], itmp4, data.itag[idx5], itmp5,
+ netcx.x11r[j], netcx.x11i[j], netcx.x12r[j], netcx.x12i[j],
+ netcx.x22r[j], netcx.x22i[j], pnet[itmp2-1] );
+
+ } /* if(( itmp2/ itmp1) == 1) */
+
+ } /* for( j = 0; j < netcx.nonet; j++) */
+
+ if( itmp3 == 0)
+ break;
+
+ itmp1= itmp3;
+
+ } /* for( j = 0; j < netcx.nonet; j++) */
+
+ } /* if( (netcx.nonet != 0) && (inc <= 1) ) */
+
+ if( (inc > 1) && (iptflg > 0) )
+ netcx.nprint=1;
+
+ netwk( cm, save.ip, crnt.cur );
+ netcx.ntsol=1;
+
+ if( iped != 0)
+ {
+ itmp1= 4*( mhz-1);
+
+ fnorm[itmp1 ]= creall( netcx.zped);
+ fnorm[itmp1+1]= cimagl( netcx.zped);
+ fnorm[itmp1+2]= cabsl( netcx.zped);
+ fnorm[itmp1+3]= cang( netcx.zped);
+
+ if( iped != 2 )
+ {
+ if( fnorm[itmp1+2] > zpnorm)
+ zpnorm= fnorm[itmp1+2];
+ }
+
+ } /* if( iped != 0) */
+
+ /* printing structure currents */
+ if( data.n != 0)
+ {
+ if( iptflg != -1)
+ {
+ if( iptflg <= 0)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "-------- CURRENTS AND LOCATION --------\n"
+ " "
+ "DISTANCES IN WAVELENGTHS" );
+
+ fprintf( output_fp, "\n\n"
+ " SEG TAG COORDINATES OF SEGM CENTER SEGM"
+ " ------------- CURRENT (AMPS) -------------\n"
+ " No: No: X Y Z LENGTH"
+ " REAL IMAGINARY MAGN PHASE" );
+ }
+ else
+ {
+ if( (iptflg != 3) && (inc <= 1) )
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "-------- RECEIVING PATTERN PARAMETERS --------\n"
+ " "
+ " ETA: %7.2LF DEGREES\n"
+ " "
+ " TYPE: %s\n"
+ " "
+ " AXIAL RATIO: %6.3LF\n\n"
+ " "
+ "THETA PHI ----- CURRENT ---- SEG\n"
+ " "
+ "(DEG) (DEG) MAGNITUDE PHASE No:",
+ xpr3, hpol[fpat.ixtyp-1], fpat.xpr6 );
+
+ } /* if( iptflg <= 0) */
+
+ } /* if( iptflg != -1) */
+
+ fpat.ploss=0.;
+ itmp1=0;
+
+ for( i = 0; i < data.n; i++ )
+ {
+ curi= crnt.cur[i]* data.wlam;
+ cmag= cabsl( curi);
+ ph= cang( curi);
+
+ if( (zload.nload != 0) && (fabsl(creall(zload.zarray[i])) >= 1.e-20) )
+ fpat.ploss += 0.5* cmag* cmag* creall( zload.zarray[i])* data.si[i];
+
+ if( iptflg == -1 )
+ continue;
+
+ if( iptflg >= 0 )
+ {
+ if( (iptag != 0) && (data.itag[i] != iptag) )
+ continue;
+
+ itmp1++;
+ if( (itmp1 < iptagf) || (itmp1 > iptagt) )
+ continue;
+
+ if( iptflg != 0)
+ {
+ if( iptflg >= 2 )
+ {
+ fnorm[inc-1]= cmag;
+ isave= (i+1);
+ }
+
+ if( iptflg != 3)
+ {
+ fprintf( output_fp, "\n"
+ " "
+ "%7.2LF %7.2LF %11.4LE %7.2LF %5d",
+ xpr1, xpr2, cmag, ph, i+1 );
+ continue;
+ }
+
+ } /* if( iptflg != 0) */
+ else
+ fprintf( output_fp, "\n"
+ " %5d %4d %9.4LF %9.4LF %9.4LF %9.5LF"
+ " %11.4LE %11.4LE %11.4LE %8.3LF",
+ i+1, data.itag[i], data.x[i], data.y[i], data.z[i],
+ data.si[i], creall(curi), cimagl(curi), cmag, ph );
+
+ } /* if( iptflg >= 0 ) */
+ else
+ {
+ fprintf( output_fp, "\n"
+ " %5d %4d %9.4LF %9.4LF %9.4LF %9.5LF"
+ " %11.4LE %11.4LE %11.4LE %8.3LF",
+ i+1, data.itag[i], data.x[i], data.y[i], data.z[i],
+ data.si[i], creall(curi), cimagl(curi), cmag, ph );
+
+ if( plot.iplp1 != 1 )
+ continue;
+
+ if( plot.iplp2 == 1)
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", creall(curi), cimagl(curi) );
+ else
+ if( plot.iplp2 == 2)
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", cmag, ph );
+ }
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ if( iptflq != -1)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "------ CHARGE DENSITIES ------\n"
+ " "
+ " DISTANCES IN WAVELENGTHS\n\n"
+ " SEG TAG COORDINATES OF SEG CENTER SEG "
+ " CHARGE DENSITY (COULOMBS/METER)\n"
+ " No: No: X Y Z LENGTH "
+ " REAL IMAGINARY MAGN PHASE" );
+
+ itmp1 = 0;
+ fr = 1.e-6/save.fmhz;
+
+ for( i = 0; i < data.n; i++ )
+ {
+ if( iptflq != -2 )
+ {
+ if( (iptaq != 0) && (data.itag[i] != iptaq) )
+ continue;
+
+ itmp1++;
+ if( (itmp1 < iptaqf) || (itmp1 > iptaqt) )
+ continue;
+
+ } /* if( iptflq == -2) */
+
+ curi= fr* cmplx(- crnt.bii[i], crnt.bir[i]);
+ cmag= cabsl( curi);
+ ph= cang( curi);
+
+ fprintf( output_fp, "\n"
+ " %5d %4d %9.4LF %9.4LF %9.4LF %9.5LF"
+ " %11.4LE %11.4LE %11.4LE %8.3LF",
+ i+1, data.itag[i], data.x[i], data.y[i], data.z[i],
+ data.si[i], creall(curi), cimagl(curi), cmag, ph );
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ } /* if( iptflq != -1) */
+
+ } /* if( n != 0) */
+
+ if( data.m != 0)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ " --------- SURFACE PATCH CURRENTS ---------\n"
+ " "
+ " DISTANCE IN WAVELENGTHS\n"
+ " "
+ " CURRENT IN AMPS/METER\n\n"
+ " ---------"
+ " SURFACE COMPONENTS -------- "
+ " ---------------- RECTANGULAR COMPONENTS ----------------\n"
+ " PCH --- PATCH CENTER --- TANGENT VECTOR 1 "
+ " TANGENT VECTOR 2 ------- X ------ ------- Y ------ "
+ " ------- Z ------\n No: X Y Z MAG. "
+ " PHASE MAG. PHASE REAL IMAGINARY REAL "
+ " IMAGINARY REAL IMAGINARY" );
+
+ j= data.n-3;
+ itmp1= -1;
+
+ for( i = 0; i <data. m; i++ )
+ {
+ j += 3;
+ itmp1++;
+ ex= crnt.cur[j];
+ ey= crnt.cur[j+1];
+ ez= crnt.cur[j+2];
+ eth= ex* data.t1x[itmp1]+ ey* data.t1y[itmp1]+ ez* data.t1z[itmp1];
+ eph= ex* data.t2x[itmp1]+ ey* data.t2y[itmp1]+ ez* data.t2z[itmp1];
+ ethm= cabsl( eth);
+ etha= cang( eth);
+ ephm= cabsl( eph);
+ epha= cang( eph);
+
+ fprintf( output_fp, "\n"
+ " %4d %7.3LF %7.3LF %7.3LF %11.4LE %8.2LF %11.4LE %8.2LF"
+ " %9.2LE %9.2LE %9.2LE %9.2LE %9.2LE %9.2LE",
+ i+1, data.px[itmp1], data.py[itmp1], data.pz[itmp1],
+ ethm, etha, ephm, epha, creall(ex), cimagl(ex),
+ creall(ey), cimagl(ey), creall(ez), cimagl(ez) );
+
+ if( plot.iplp1 != 1)
+ continue;
+
+ if( plot.iplp3 == 1)
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", creall(ex), cimagl(ex) );
+ if( plot.iplp3 == 2)
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", creall(ey), cimagl(ey) );
+ if( plot.iplp3 == 3)
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", creall(ez), cimagl(ez) );
+ if( plot.iplp3 == 4)
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE %12.4LE %12.4LE %12.4LE\n",
+ creall(ex),cimagl(ex),creall(ey),cimagl(ey),creall(ez),cimagl(ez) );
+
+ } /* for( i=0; i<m; i++ ) */
+
+ } /* if( m != 0) */
+
+ if( (fpat.ixtyp == 0) || (fpat.ixtyp == 5) )
+ {
+ tmp1= netcx.pin- netcx.pnls- fpat.ploss;
+ tmp2= 100.* tmp1/ netcx.pin;
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---------- POWER BUDGET ---------\n"
+ " "
+ "INPUT POWER = %11.4LE Watts\n"
+ " "
+ "RADIATED POWER= %11.4LE Watts\n"
+ " "
+ "STRUCTURE LOSS= %11.4LE Watts\n"
+ " "
+ "NETWORK LOSS = %11.4LE Watts\n"
+ " "
+ "EFFICIENCY = %7.2LF Percent",
+ netcx.pin, tmp1, fpat.ploss, netcx.pnls, tmp2 );
+
+ } /* if( (fpat.ixtyp == 0) || (fpat.ixtyp == 5) ) */
+
+ igo = 4;
+
+ if( yparm.ncoup > 0)
+ couple( crnt.cur, data.wlam );
+
+ if( iflow == 7)
+ {
+ if( (fpat.ixtyp > 0) && (fpat.ixtyp < 4) )
+ {
+ nthic++;
+ inc++;
+ xpr1 += xpr4;
+
+ if( nthic <= nthi )
+ continue; /* continue excitation loop */
+
+ nthic=1;
+ xpr1= thetis;
+ xpr2= xpr2+ xpr5;
+ nphic++;
+
+ if( nphic <= nphi )
+ continue; /* continue excitation loop */
+
+ break;
+
+ } /* if( (fpat.ixtyp >= 1) && (fpat.ixtyp <= 3) ) */
+
+ if( nfrq != 1)
+ {
+ jmp_floop = TRUE;
+ break; /* continue the freq loop */
+ }
+
+ fprintf( output_fp, "\n\n\n" );
+ jmp_iloop = TRUE;
+
+ break; /* continue card input loop */
+
+ } /*if( iflow == 7) */
+
+
+ case 4: /* label_71 */
+ igo = 5;
+
+ /* label_72 */
+ case 5: /* near field calculation */
+
+ if( fpat.near != -1)
+ {
+ nfpat();
+
+ if( mhz == nfrq)
+ fpat.near=-1;
+
+ if( nfrq == 1)
+ {
+ fprintf( output_fp, "\n\n\n" );
+ jmp_iloop = TRUE;
+ break; /* continue card input loop */
+ }
+
+ } /* if( fpat.near != -1) */
+
+
+ /* label_78 */
+ case 6: /* standard far field calculation */
+
+ if( gnd.ifar != -1)
+ {
+ fpat.pinr= netcx.pin;
+ fpat.pnlr= netcx.pnls;
+ rdpat();
+ }
+
+ if( (fpat.ixtyp == 0) || (fpat.ixtyp >= 4) )
+ {
+ if( mhz == nfrq )
+ gnd.ifar=-1;
+
+ if( nfrq != 1)
+ {
+ jmp_floop = TRUE;
+ break;
+ }
+
+ fprintf( output_fp, "\n\n\n" );
+ jmp_iloop = TRUE;
+ break;
+
+ } /* if( (fpat.ixtyp == 0) || (fpat.ixtyp >= 4) ) */
+
+ nthic++;
+ inc++;
+ xpr1 += xpr4;
+
+ if( nthic <= nthi )
+ continue; /* continue excitation loop */
+
+ nthic = 1;
+ xpr1 = thetis;
+ xpr2 += xpr5;
+ nphic++;
+
+ if( nphic > nphi )
+ break;
+
+ } /* do (l_54) */
+ while( TRUE );
+
+ /* jump to freq. or input loop */
+ if( jmp_iloop )
+ break;
+
+ if( jmp_floop )
+ continue;
+
+ nphic = 1;
+ xpr2 = phiss;
+
+ /* normalized receiving pattern printed */
+ if( iptflg >= 2)
+ {
+ itmp1= nthi* nphi;
+
+ tmp1= fnorm[0];
+ for( j = 1; j < itmp1; j++ )
+ if( fnorm[j] > tmp1)
+ tmp1= fnorm[j];
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---- NORMALIZED RECEIVING PATTERN ----\n"
+ " "
+ "NORMALIZATION FACTOR: %11.4LE\n"
+ " "
+ "ETA: %7.2LF DEGREES\n"
+ " "
+ "TYPE: %s\n"
+ " AXIAL RATIO: %6.3LF\n"
+ " SEGMENT No: %d\n\n"
+ " "
+ "THETA PHI ---- PATTERN ----\n"
+ " "
+ "(DEG) (DEG) DB MAGNITUDE",
+ tmp1, xpr3, hpol[fpat.ixtyp-1], fpat.xpr6, isave );
+
+ for( j = 0; j < nphi; j++ )
+ {
+ itmp2= nthi*j;
+
+ for( i = 0; i < nthi; i++ )
+ {
+ itmp3= i + itmp2;
+
+ if( itmp3 < itmp1)
+ {
+ tmp2= fnorm[itmp3]/ tmp1;
+ tmp3= db20( tmp2);
+
+ fprintf( output_fp, "\n"
+ " %7.2LF %7.2LF %7.2LF %11.4LE",
+ xpr1, xpr2, tmp3, tmp2 );
+
+ xpr1 += xpr4;
+ }
+
+ } /* for( i = 0; i < nthi; i++ ) */
+
+ xpr1= thetis;
+ xpr2 += xpr5;
+
+ } /* for( j = 0; j < nphi; j++ ) */
+
+ xpr2= phiss;
+
+ } /* if( iptflg >= 2) */
+
+ if( mhz == nfrq)
+ gnd.ifar=-1;
+
+ if( nfrq == 1)
+ {
+ fprintf( output_fp, "\n\n\n" );
+ jmp_iloop = TRUE;
+ break; /* continue card input loop */
+ }
+
+ } /*** do (frequency loop) (l_42) ***/
+ while( (++mhz <= nfrq) );
+
+ /* Jump to card input loop */
+ if( jmp_iloop )
+ break;
+
+ if( iped != 0)
+ {
+ int iss;
+
+ if( vsorc.nvqd > 0)
+ iss = vsorc.ivqd[vsorc.nvqd-1];
+ else
+ iss = vsorc.isant[vsorc.nsant-1];
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ " -------- INPUT IMPEDANCE DATA --------\n"
+ " "
+ " SOURCE SEGMENT No: %d\n"
+ " "
+ " NORMALIZATION FACTOR:%12.5LE\n\n"
+ " ----------- UNNORMALIZED IMPEDANCE ---------- "
+ " ------------ NORMALIZED IMPEDANCE -----------\n"
+ " FREQ RESISTANCE REACTANCE MAGNITUDE PHASE "
+ " RESISTANCE REACTANCE MAGNITUDE PHASE\n"
+ " MHz OHMS OHMS OHMS DEGREES "
+ " OHMS OHMS OHMS DEGREES",
+ iss, zpnorm );
+
+ itmp1= nfrq;
+ if( ifrq == 0)
+ tmp1= save.fmhz-( nfrq-1)* delfrq;
+ else
+ if( ifrq == 1)
+ tmp1= save.fmhz/( powl(delfrq, (nfrq-1)) );
+
+ for( i = 0; i < itmp1; i++ )
+ {
+ itmp2= 4*i;
+ tmp2= fnorm[itmp2 ]/ zpnorm;
+ tmp3= fnorm[itmp2+1]/ zpnorm;
+ tmp4= fnorm[itmp2+2]/ zpnorm;
+ tmp5= fnorm[itmp2+3];
+
+ fprintf( output_fp, "\n"
+ " %9.3LF %11.4LE %11.4LE %11.4LE %7.2LF "
+ " %11.4LE %11.4LE %11.4LE %7.2LF",
+ tmp1, fnorm[itmp2], fnorm[itmp2+1], fnorm[itmp2+2],
+ fnorm[itmp2+3], tmp2, tmp3, tmp4, tmp5 );
+
+ if( ifrq == 0)
+ tmp1 += delfrq;
+ else
+ if( ifrq == 1)
+ tmp1 *= delfrq;
+
+ } /* for( i = 0; i < itmp1; i++ ) */
+
+ fprintf( output_fp, "\n\n\n" );
+
+ } /* if( iped != 0) */
+
+ nfrq=1;
+ mhz=1;
+
+ } /* switch( igox ) */
+
+ } /* while( ! next_job ): Main input section (l_14) */
+
+ } /* while(TRUE): Main execution loop (l_1) */
+
+ return(0);
+
+} /* end of main() */
+
+/*-----------------------------------------------------------------------*/
+
+/* Null_Pointers()
+ *
+ * Nulls pointers used in mem_realloc
+ */
+ void
+Null_Pointers( void )
+{
+ crnt.air = crnt.aii = NULL;
+ crnt.bir = crnt.bii = NULL;
+ crnt.cir = crnt.cii = NULL;
+ crnt.cur = NULL;
+
+ data.x = data.y = data.z = NULL;
+ data.x1 = data.y1 = data.z1 = NULL;
+ data.x2 = data.y2 = data.z2 = NULL;
+ data.si = data.bi = data.sab = NULL;
+ data.cab = data.salp = NULL;
+ data.itag = data.icon1 = data.icon2 = NULL;
+ data.px = data.py = data.pz = NULL;
+ data.t1x = data.t1y = data.t1z = NULL;
+ data.t2x = data.t2y = data.t2z = NULL;
+ data.pbi = data.psalp = NULL;
+
+ netcx.ntyp = netcx.iseg1 = netcx.iseg2 = NULL;
+ netcx.x11r = netcx.x11i = NULL;
+ netcx.x12r = netcx.x12i = NULL;
+ netcx.x22r = netcx.x22i = NULL;
+
+ save.ip = NULL;
+
+ segj.jco = NULL;
+ segj.ax = segj.bx = segj.cx = NULL;
+
+ smat.ssx = NULL;
+
+ vsorc.isant = vsorc.ivqd = vsorc.iqds = NULL;
+ vsorc.vqd = vsorc.vqds = vsorc.vsant = NULL;
+
+ yparm.y11a = yparm.y12a = NULL;
+ yparm.ncseg = yparm.nctag = NULL;
+
+ zload.zarray = NULL;
+
+} /* Null_Pointers() */
+
+/*-----------------------------------------------------------------------*/
+
+/* prnt sets up the print formats for impedance loading */
+void prnt( int in1, int in2, int in3, long double fl1, long double fl2,
+ long double fl3, long double fl4, long double fl5,
+ long double fl6, char *ia, int ichar )
+{
+ /* record to be output and buffer used to make it */
+ char record[101+ichar*4], buff[15];
+ int in[3], i1, i;
+ long double fl[6];
+
+ in[0]= in1;
+ in[1]= in2;
+ in[2]= in3;
+ fl[0]= fl1;
+ fl[1]= fl2;
+ fl[2]= fl3;
+ fl[3]= fl4;
+ fl[4]= fl5;
+ fl[5]= fl6;
+
+ /* integer format */
+ i1=0;
+ strcpy( record, "\n " );
+
+ if( (in1 == 0) && (in2 == 0) && (in3 == 0) )
+ {
+ strcat( record, " ALL" );
+ i1=1;
+ }
+
+ for( i = i1; i < 3; i++ )
+ {
+ if( in[i] == 0)
+ strcat( record, " " );
+ else
+ {
+ snprintf( buff, 6, "%5d", in[i] );
+ strcat( record, buff );
+ }
+ }
+
+ /* floating point format */
+ for( i = 0; i < 6; i++ )
+ {
+ if( fabsl( fl[i]) >= 1.0e-20 )
+ {
+ snprintf( buff, 15, " %11.4LE", fl[i] );
+ strcat( record, buff );
+ }
+ else
+ strcat( record, " " );
+ }
+
+ strcat( record, " " );
+ strcat( record, ia );
+ fprintf( output_fp, "%s", record );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+static void sig_handler( int signal )
+{
+ fprintf( stderr, "\n" );
+ switch( signal )
+ {
+ case SIGINT :
+ fprintf( stderr, "%s\n", "nec2c: exiting via user interrupt" );
+ exit( signal );
+
+ case SIGSEGV :
+ fprintf( stderr, "%s\n", "nec2c: segmentation fault" );
+ exit( signal );
+
+ case SIGFPE :
+ fprintf( stderr, "%s\n", "nec2c: floating point exception" );
+ exit( signal );
+
+ case SIGABRT :
+ fprintf( stderr, "%s\n", "nec2c: abort signal received" );
+ exit( signal );
+
+ case SIGTERM :
+ fprintf( stderr, "%s\n", "nec2c: termination request received" );
+
+ stop( signal );
+ }
+
+} /* end of sig_handler() */
+
+/*------------------------------------------------------------------------*/
+
diff --git a/matrix.c b/matrix.c
new file mode 100644
index 0000000..e25fdfb
--- /dev/null
+++ b/matrix.c
@@ -0,0 +1,1497 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+*******************************************************************/
+
+#include "nec2c.h"
+
+/* common /data/ */
+extern data_t data;
+
+/* common /dataj/ */
+extern dataj_t dataj;
+
+/* common /matpar/ */
+extern matpar_t matpar;
+
+/* common /segj/ */
+extern segj_t segj;
+
+/* common /zload/ */
+extern zload_t zload;
+
+/* common /smat/ */
+extern smat_t smat;
+
+/* common /gnd/ */
+extern gnd_t gnd;
+
+/* common /vsorc/ */
+extern vsorc_t vsorc;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/*-------------------------------------------------------------------*/
+
+/* cmset sets up the complex structure matrix in the array cm */
+void cmset( int nrow, complex long double *cm, long double rkhx, int iexkx )
+{
+ int mp2, neq, npeq, iout, it, i, j, i1, i2, in2;
+ int im1, im2, ist, ij, ipr, jss, jm1, jm2, jst, k, ka, kk;
+ complex long double zaj, deter, *scm = NULL;
+
+ mp2=2* data.mp;
+ npeq= data.np+ mp2;
+ neq= data.n+2* data.m;
+ smat.nop = neq/npeq;
+
+ dataj.rkh= rkhx;
+ dataj.iexk= iexkx;
+ iout=2* matpar.npblk* nrow;
+ it= matpar.nlast;
+
+ for( i = 0; i < nrow; i++ )
+ for( j = 0; j < it; j++ )
+ cm[i+j*nrow]= CPLX_00;
+
+ i1= 1;
+ i2= it;
+ in2= i2;
+
+ if( in2 > data.np)
+ in2= data.np;
+
+ im1= i1- data.np;
+ im2= i2- data.np;
+
+ if( im1 < 1)
+ im1=1;
+
+ ist=1;
+ if( i1 <= data.np)
+ ist= data.np- i1+2;
+
+ /* wire source loop */
+ if( data.n != 0)
+ {
+ for( j = 1; j <= data.n; j++ )
+ {
+ trio(j);
+ for( i = 0; i < segj.jsno; i++ )
+ {
+ ij= segj.jco[i];
+ segj.jco[i]=(( ij-1)/ data.np)* mp2+ ij;
+ }
+
+ if( i1 <= in2)
+ cmww( j, i1, in2, cm, nrow, cm, nrow,1);
+
+ if( im1 <= im2)
+ cmws( j, im1, im2, &cm[(ist-1)*nrow], nrow, cm, nrow, 1);
+
+ /* matrix elements modified by loading */
+ if( zload.nload == 0)
+ continue;
+
+ if( j > data.np)
+ continue;
+
+ ipr= j;
+ if( (ipr < 1) || (ipr > it) )
+ continue;
+
+ zaj= zload.zarray[j-1];
+
+ for( i = 0; i < segj.jsno; i++ )
+ {
+ jss= segj.jco[i];
+ cm[(jss-1)+(ipr-1)*nrow] -= ( segj.ax[i]+ segj.cx[i])* zaj;
+ }
+
+ } /* for( j = 1; j <= n; j++ ) */
+
+ } /* if( n != 0) */
+
+ if( data.m != 0)
+ {
+ /* matrix elements for patch current sources */
+ jm1=1- data.mp;
+ jm2=0;
+ jst=1- mp2;
+
+ for( i = 0; i < smat.nop; i++ )
+ {
+ jm1 += data.mp;
+ jm2 += data.mp;
+ jst += npeq;
+
+ if( i1 <= in2)
+ cmsw( jm1, jm2, i1, in2, &cm[(jst-1)], cm, 0, nrow, 1);
+
+ if( im1 <= im2)
+ cmss( jm1, jm2, im1, im2, &cm[(jst-1)+(ist-1)*nrow], nrow, 1);
+ }
+
+ } /* if( m != 0) */
+
+ if( matpar.icase == 1)
+ return;
+
+ /* Allocate to scratch memory */
+ mem_alloc( (void *)&scm, data.np2m * sizeof(complex long double) );
+
+ /* combine elements for symmetry modes */
+ for( i = 0; i < it; i++ )
+ {
+ for( j = 0; j < npeq; j++ )
+ {
+ for( k = 0; k < smat.nop; k++ )
+ {
+ ka= j+ k*npeq;
+ scm[k]= cm[ka+i*nrow];
+ }
+
+ deter= scm[0];
+
+ for( kk = 1; kk < smat.nop; kk++ )
+ deter += scm[kk];
+
+ cm[j+i*nrow]= deter;
+
+ for( k = 1; k < smat.nop; k++ )
+ {
+ ka= j+ k*npeq;
+ deter= scm[0];
+
+ for( kk = 1; kk < smat.nop; kk++ )
+ {
+ deter += scm[kk]* smat.ssx[k+kk*smat.nop];
+ cm[ka+i*nrow]= deter;
+ }
+
+ } /* for( k = 1; k < smat.nop; k++ ) */
+
+ } /* for( j = 0; j < npeq; j++ ) */
+
+ } /* for( i = 0; i < it; i++ ) */
+
+ free_ptr( (void *)&scm );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* cmss computes matrix elements for surface-surface interactions. */
+void cmss( int j1, int j2, int im1, int im2,
+ complex long double *cm, int nrow, int itrp )
+{
+ int i1, i2, icomp, ii1, i, il, ii2, jj1, j, jl, jj2;
+ long double t1xi, t1yi, t1zi, t2xi, t2yi, t2zi, xi, yi, zi;
+ complex long double g11, g12, g21, g22;
+
+ i1=( im1+1)/2;
+ i2=( im2+1)/2;
+ icomp= i1*2-3;
+ ii1=-2;
+ if( icomp+2 < im1)
+ ii1=-3;
+
+ /* loop over observation patches */
+ il = -1;
+ for( i = i1; i <= i2; i++ )
+ {
+ il++;
+ icomp += 2;
+ ii1 += 2;
+ ii2 = ii1+1;
+
+ t1xi= data.t1x[il]* data.psalp[il];
+ t1yi= data.t1y[il]* data.psalp[il];
+ t1zi= data.t1z[il]* data.psalp[il];
+ t2xi= data.t2x[il]* data.psalp[il];
+ t2yi= data.t2y[il]* data.psalp[il];
+ t2zi= data.t2z[il]* data.psalp[il];
+ xi= data.px[il];
+ yi= data.py[il];
+ zi= data.pz[il];
+
+ /* loop over source patches */
+ jj1=-2;
+ for( j = j1; j <= j2; j++ )
+ {
+ jl=j-1;
+ jj1 += 2;
+ jj2 = jj1+1;
+
+ dataj.s= data.pbi[jl];
+ dataj.xj= data.px[jl];
+ dataj.yj= data.py[jl];
+ dataj.zj= data.pz[jl];
+ dataj.t1xj= data.t1x[jl];
+ dataj.t1yj= data.t1y[jl];
+ dataj.t1zj= data.t1z[jl];
+ dataj.t2xj= data.t2x[jl];
+ dataj.t2yj= data.t2y[jl];
+ dataj.t2zj= data.t2z[jl];
+
+ hintg( xi, yi, zi);
+
+ g11=-( t2xi* dataj.exk+ t2yi* dataj.eyk+ t2zi* dataj.ezk);
+ g12=-( t2xi* dataj.exs+ t2yi* dataj.eys+ t2zi* dataj.ezs);
+ g21=-( t1xi* dataj.exk+ t1yi* dataj.eyk+ t1zi* dataj.ezk);
+ g22=-( t1xi* dataj.exs+ t1yi* dataj.eys+ t1zi* dataj.ezs);
+
+ if( i == j )
+ {
+ g11 -= .5;
+ g22 += .5;
+ }
+
+ /* normal fill */
+ if( itrp == 0)
+ {
+ if( icomp >= im1 )
+ {
+ cm[ii1+jj1*nrow]= g11;
+ cm[ii1+jj2*nrow]= g12;
+ }
+
+ if( icomp >= im2 )
+ continue;
+
+ cm[ii2+jj1*nrow]= g21;
+ cm[ii2+jj2*nrow]= g22;
+ continue;
+
+ } /* if( itrp == 0) */
+
+ /* transposed fill */
+ if( icomp >= im1 )
+ {
+ cm[jj1+ii1*nrow]= g11;
+ cm[jj2+ii1*nrow]= g12;
+ }
+
+ if( icomp >= im2 )
+ continue;
+
+ cm[jj1+ii2*nrow]= g21;
+ cm[jj2+ii2*nrow]= g22;
+
+ } /* for( j = j1; j <= j2; j++ ) */
+
+ } /* for( i = i1; i <= i2; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* computes matrix elements for e along wires due to patch current */
+void cmsw( int j1, int j2, int i1, int i2, complex long double *cm,
+ complex long double *cw, int ncw, int nrow, int itrp )
+{
+ int neqs, k, icgo, i, ipch, jl, j, js, il, ip;
+ int jsnox; /* -1 offset to "jsno" for array indexing */
+ long double xi, yi, zi, cabi, sabi, salpi, fsign=1., pyl, pxl;
+ complex long double emel[9];
+
+ neqs= data.np2m;
+ jsnox = segj.jsno-1;
+
+ if( itrp >= 0)
+ {
+ k=-1;
+ icgo=0;
+
+ /* observation loop */
+ for( i = i1-1; i < i2; i++ )
+ {
+ k++;
+ xi= data.x[i];
+ yi= data.y[i];
+ zi= data.z[i];
+ cabi= data.cab[i];
+ sabi= data.sab[i];
+ salpi= data.salp[i];
+ ipch=0;
+
+ if( data.icon1[i] >= PCHCON)
+ {
+ ipch= data.icon1[i]-PCHCON;
+ fsign=-1.;
+ }
+
+ if( data.icon2[i] >= PCHCON)
+ {
+ ipch= data.icon2[i]-PCHCON;
+ fsign=1.;
+ }
+
+ /* source loop */
+ jl = -1;
+ for( j = j1; j <= j2; j++ )
+ {
+ jl += 2;
+ js = j-1;
+ dataj.t1xj= data.t1x[js];
+ dataj.t1yj= data.t1y[js];
+ dataj.t1zj= data.t1z[js];
+ dataj.t2xj= data.t2x[js];
+ dataj.t2yj= data.t2y[js];
+ dataj.t2zj= data.t2z[js];
+ dataj.xj= data.px[js];
+ dataj.yj= data.py[js];
+ dataj.zj= data.pz[js];
+ dataj.s= data.pbi[js];
+
+ /* ground loop */
+ for( ip = 1; ip <= gnd.ksymp; ip++ )
+ {
+ dataj.ipgnd= ip;
+
+ if( ((ipch == j) || (icgo != 0)) && (ip != 2) )
+ {
+ if( icgo <= 0 )
+ {
+ pcint( xi, yi, zi, cabi, sabi, salpi, emel);
+
+ pyl= PI* data.si[i]* fsign;
+ pxl= sinl( pyl);
+ pyl= cosl( pyl);
+ dataj.exc= emel[8]* fsign;
+
+ trio(i+1);
+
+ il= i-ncw;
+ if( i < data.np)
+ il += (il/data.np)*2*data.mp;
+
+ if( itrp == 0 )
+ cw[k+il*nrow] +=
+ dataj.exc*( segj.ax[jsnox]+ segj.bx[jsnox]* pxl+ segj.cx[jsnox]* pyl);
+ else
+ cw[il+k*nrow] +=
+ dataj.exc*( segj.ax[jsnox]+ segj.bx[jsnox]* pxl+ segj.cx[jsnox]* pyl);
+
+ } /* if( icgo <= 0 ) */
+
+ if( itrp == 0)
+ {
+ cm[k+(jl-1)*nrow]= emel[icgo];
+ cm[k+jl*nrow] = emel[icgo+4];
+ }
+ else
+ {
+ cm[(jl-1)+k*nrow]= emel[icgo];
+ cm[jl+k*nrow] = emel[icgo+4];
+ }
+
+ icgo++;
+ if( icgo == 4)
+ icgo=0;
+
+ continue;
+
+ } /* if( ((ipch == (j+1)) || (icgo != 0)) && (ip != 2) ) */
+
+ unere( xi, yi, zi);
+
+ /* normal fill */
+ if( itrp == 0)
+ {
+ cm[k+(jl-1)*nrow] += dataj.exk* cabi+ dataj.eyk* sabi+ dataj.ezk* salpi;
+ cm[k+jl*nrow] += dataj.exs* cabi+ dataj.eys* sabi+ dataj.ezs* salpi;
+ continue;
+ }
+
+ /* transposed fill */
+ cm[(jl-1)+k*nrow] += dataj.exk* cabi+ dataj.eyk* sabi+ dataj.ezk* salpi;
+ cm[jl+k*nrow] += dataj.exs* cabi+ dataj.eys* sabi+ dataj.ezs* salpi;
+
+ } /* for( ip = 1; ip <= gnd.ksymp; ip++ ) */
+
+ } /* for( j = j1; j <= j2; j++ ) */
+
+ } /* for( i = i1-1; i < i2; i++ ) */
+
+ } /* if( itrp >= 0) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* cmws computes matrix elements for wire-surface interactions */
+void cmws( int j, int i1, int i2, complex long double *cm,
+ int nr, complex long double *cw, int nw, int itrp )
+{
+ int ipr, i, ipatch, ik, js=0, ij, jx;
+ long double xi, yi, zi, tx, ty, tz;
+ complex long double etk, ets, etc;
+
+ j--;
+ dataj.s= data.si[j];
+ dataj.b= data.bi[j];
+ dataj.xj= data.x[j];
+ dataj.yj= data.y[j];
+ dataj.zj= data.z[j];
+ dataj.cabj= data.cab[j];
+ dataj.sabj= data.sab[j];
+ dataj.salpj= data.salp[j];
+
+ /* observation loop */
+ ipr= -1;
+ for( i = i1; i <= i2; i++ )
+ {
+ ipr++;
+ ipatch=(i+1)/2;
+ ik= i-( i/2)*2;
+
+ if( (ik != 0) || (ipr == 0) )
+ {
+ js= ipatch-1;
+ xi= data.px[js];
+ yi= data.py[js];
+ zi= data.pz[js];
+ hsfld( xi, yi, zi,0.);
+
+ if( ik != 0 )
+ {
+ tx= data.t2x[js];
+ ty= data.t2y[js];
+ tz= data.t2z[js];
+ }
+ else
+ {
+ tx= data.t1x[js];
+ ty= data.t1y[js];
+ tz= data.t1z[js];
+ }
+
+ } /* if( (ik != 0) || (ipr == 0) ) */
+ else
+ {
+ tx= data.t1x[js];
+ ty= data.t1y[js];
+ tz= data.t1z[js];
+
+ } /* if( (ik != 0) || (ipr == 0) ) */
+
+ etk=-( dataj.exk* tx+ dataj.eyk* ty+ dataj.ezk* tz)* data.psalp[js];
+ ets=-( dataj.exs* tx+ dataj.eys* ty+ dataj.ezs* tz)* data.psalp[js];
+ etc=-( dataj.exc* tx+ dataj.eyc* ty+ dataj.ezc* tz)* data.psalp[js];
+
+ /* fill matrix elements. element locations */
+ /* determined by connection data. */
+
+ /* normal fill */
+ if( itrp == 0)
+ {
+ for( ij = 0; ij < segj.jsno; ij++ )
+ {
+ jx= segj.jco[ij]-1;
+ cm[ipr+jx*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ }
+
+ continue;
+ } /* if( itrp == 0) */
+
+ /* transposed fill */
+ if( itrp != 2)
+ {
+ for( ij = 0; ij < segj.jsno; ij++ )
+ {
+ jx= segj.jco[ij]-1;
+ cm[jx+ipr*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ }
+
+ continue;
+ } /* if( itrp != 2) */
+
+ /* transposed fill - c(ws) and d(ws)prime (=cw) */
+ for( ij = 0; ij < segj.jsno; ij++ )
+ {
+ jx= segj.jco[ij]-1;
+ if( jx < nr)
+ cm[jx+ipr*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ else
+ {
+ jx -= nr;
+ cw[jx+ipr*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ }
+ } /* for( ij = 0; ij < segj.jsno; ij++ ) */
+
+ } /* for( i = i1; i <= i2; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* cmww computes matrix elements for wire-wire interactions */
+void cmww( int j, int i1, int i2, complex long double *cm,
+ int nr, complex long double *cw, int nw, int itrp)
+{
+ int ipr, iprx, i, ij, jx;
+ long double xi, yi, zi, ai, cabi, sabi, salpi;
+ complex long double etk, ets, etc;
+
+ /* set source segment parameters */
+ jx = j;
+ j--;
+ dataj.s= data.si[j];
+ dataj.b= data.bi[j];
+ dataj.xj= data.x[j];
+ dataj.yj= data.y[j];
+ dataj.zj= data.z[j];
+ dataj.cabj= data.cab[j];
+ dataj.sabj= data.sab[j];
+ dataj.salpj= data.salp[j];
+
+ /* decide whether ext. t.w. approx. can be used */
+ if( dataj.iexk != 0)
+ {
+ ipr = data.icon1[j];
+ if (ipr > PCHCON) dataj.ind1 = 0;
+ else if( ipr < 0 )
+ {
+ ipr= -ipr;
+ iprx= ipr-1;
+
+ if( -data.icon1[iprx] != jx ) dataj.ind1 = 2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+
+ } /* if( -data.icon1[iprx] != jx ) */
+
+ } /* if( ipr < 0 ) */
+ else
+ {
+ iprx = ipr-1;
+ if( ipr == 0 ) dataj.ind1=1;
+ else
+ {
+ if( ipr != jx )
+ {
+ if( data.icon2[iprx] != jx ) dataj.ind1=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.e-6) )
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+
+ } /* if( data.icon2[iprx] != jx ) */
+
+ } /* if( ipr != jx ) */
+ else
+ if( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj > 1.e-8)
+ dataj.ind1=2;
+ else
+ dataj.ind1=0;
+
+ } /* if( ipr == 0 ) */
+
+ } /* if( ipr < 0 ) */
+
+ ipr = data.icon2[j];
+ if (ipr > PCHCON) dataj.ind2 = 2;
+ else if( ipr < 0 )
+ {
+ ipr= -ipr;
+ iprx = ipr-1;
+ if( -data.icon2[iprx] != jx )
+ dataj.ind2=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.e-6) )
+ dataj.ind2=2;
+ else
+ dataj.ind2=0;
+
+ } /* if( -data.icon1[iprx] != jx ) */
+
+ } /* if( ipr < 0 ) */
+ else
+ {
+ iprx = ipr-1;
+ if( ipr == 0 )
+ dataj.ind2=1;
+ else
+ {
+ if( ipr != jx )
+ {
+ if( data.icon1[iprx] != jx )
+ dataj.ind2=2;
+ else
+ {
+ xi= fabsl( dataj.cabj* data.cab[iprx]+ dataj.sabj*
+ data.sab[iprx]+ dataj.salpj* data.salp[iprx]);
+ if( (xi < 0.999999) || (fabsl(data.bi[iprx]/dataj.b-1.) > 1.e-6) )
+ dataj.ind2=2;
+ else
+ dataj.ind2=0;
+
+ } /* if( data.icon2[iprx] != jx ) */
+
+ } /* if( ipr != jx ) */
+ else
+ if( dataj.cabj* dataj.cabj+ dataj.sabj* dataj.sabj > 1.e-8)
+ dataj.ind2=2;
+ else
+ dataj.ind2=0;
+
+ } /* if( ipr == 0 ) */
+
+ } /* if( ipr < 0 ) */
+
+ } /* if( dataj.iexk != 0) */
+
+ /* observation loop */
+ ipr=-1;
+ for( i = i1-1; i < i2; i++ )
+ {
+ ipr++;
+ ij= i-j;
+ xi= data.x[i];
+ yi= data.y[i];
+ zi= data.z[i];
+ ai= data.bi[i];
+ cabi= data.cab[i];
+ sabi= data.sab[i];
+ salpi= data.salp[i];
+
+ efld( xi, yi, zi, ai, ij);
+
+ etk= dataj.exk* cabi+ dataj.eyk* sabi+ dataj.ezk* salpi;
+ ets= dataj.exs* cabi+ dataj.eys* sabi+ dataj.ezs* salpi;
+ etc= dataj.exc* cabi+ dataj.eyc* sabi+ dataj.ezc* salpi;
+
+ /* fill matrix elements. element locations */
+ /* determined by connection data. */
+
+ /* normal fill */
+ if( itrp == 0)
+ {
+ for( ij = 0; ij < segj.jsno; ij++ )
+ {
+ jx = segj.jco[ij]-1;
+ cm[ipr+jx*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ }
+ continue;
+ }
+
+ /* transposed fill */
+ if( itrp != 2)
+ {
+ for( ij = 0; ij < segj.jsno; ij++ )
+ {
+ jx= segj.jco[ij]-1;
+ cm[jx+ipr*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ }
+ continue;
+ }
+
+ /* trans. fill for c(ww) - test for elements for d(ww)prime. (=cw) */
+ for( ij = 0; ij < segj.jsno; ij++ )
+ {
+ jx= segj.jco[ij]-1;
+ if( jx < nr)
+ cm[jx+ipr*nr] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ else
+ {
+ jx -= nr;
+ cw[jx*ipr*nw] += etk* segj.ax[ij]+ ets* segj.bx[ij]+ etc* segj.cx[ij];
+ }
+
+ } /* for( ij = 0; ij < segj.jsno; ij++ ) */
+
+ } /* for( i = i1-1; i < i2; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* etmns fills the array e with the negative of the */
+/* electric field incident on the structure. e is the */
+/* right hand side of the matrix equation. */
+void etmns( long double p1, long double p2, long double p3, long double p4,
+ long double p5, long double p6, int ipr, complex long double *e )
+{
+ int i, is, i1, i2=0, neq;
+ long double cth, sth, cph, sph, cet, set, pxl, pyl, pzl, wx;
+ long double wy, wz, qx, qy, qz, arg, ds, dsh, rs, r;
+ complex long double cx, cy, cz, er, et, ezh, erh, rrv=CPLX_00, rrh=CPLX_00, tt1, tt2;
+
+ neq= data.n+2*data.m;
+ vsorc.nqds=0;
+
+ /* applied field of voltage sources for transmitting case */
+ if( (ipr == 0) || (ipr == 5) )
+ {
+ for( i = 0; i < neq; i++ )
+ e[i]=CPLX_00;
+
+ if( vsorc.nsant != 0)
+ {
+ for( i = 0; i < vsorc.nsant; i++ )
+ {
+ is= vsorc.isant[i]-1;
+ e[is]= -vsorc.vsant[i]/( data.si[is]* data.wlam);
+ }
+ }
+
+ if( vsorc.nvqd == 0)
+ return;
+
+ for( i = 0; i < vsorc.nvqd; i++ )
+ {
+ is= vsorc.ivqd[i];
+ qdsrc( is, vsorc.vqd[i], e);
+ }
+ return;
+
+ } /* if( (ipr == 0) || (ipr == 5) ) */
+
+ /* incident plane wave, linearly polarized. */
+ if( ipr <= 3)
+ {
+ cth= cosl( p1);
+ sth= sinl( p1);
+ cph= cosl( p2);
+ sph= sinl( p2);
+ cet= cosl( p3);
+ set= sinl( p3);
+ pxl= cth* cph* cet- sph* set;
+ pyl= cth* sph* cet+ cph* set;
+ pzl=- sth* cet;
+ wx=- sth* cph;
+ wy=- sth* sph;
+ wz=- cth;
+ qx= wy* pzl- wz* pyl;
+ qy= wz* pxl- wx* pzl;
+ qz= wx* pyl- wy* pxl;
+
+ if( gnd.ksymp != 1)
+ {
+ if( gnd.iperf != 1)
+ {
+ rrv= csqrtl(1.- gnd.zrati* gnd.zrati* sth* sth);
+ rrh= gnd.zrati* cth;
+ rrh=( rrh- rrv)/( rrh+ rrv);
+ rrv= gnd.zrati* rrv;
+ rrv=-( cth- rrv)/( cth+ rrv);
+ }
+ else
+ {
+ rrv=-CPLX_10;
+ rrh=-CPLX_10;
+ } /* if( gnd.iperf != 1) */
+
+ } /* if( gnd.ksymp != 1) */
+
+ if( ipr == 1)
+ {
+ if( data.n != 0)
+ {
+ for( i = 0; i < data.n; i++ )
+ {
+ arg=- TP*( wx* data.x[i]+ wy* data.y[i]+ wz* data.z[i]);
+ e[i]=-( pxl* data.cab[i]+ pyl* data.sab[i]+ pzl*
+ data.salp[i])* cmplx( cosl( arg), sinl( arg));
+ }
+
+ if( gnd.ksymp != 1)
+ {
+ tt1=( pyl* cph- pxl* sph)*( rrh- rrv);
+ cx= rrv* pxl- tt1* sph;
+ cy= rrv* pyl+ tt1* cph;
+ cz=- rrv* pzl;
+
+ for( i = 0; i < data.n; i++ )
+ {
+ arg=- TP*( wx* data.x[i]+ wy* data.y[i]- wz* data.z[i]);
+ e[i]= e[i]-( cx* data.cab[i]+ cy* data.sab[i]+
+ cz* data.salp[i])* cmplx(cosl( arg), sinl( arg));
+ }
+
+ } /* if( gnd.ksymp != 1) */
+
+ } /* if( data.n != 0) */
+
+ if( data.m == 0)
+ return;
+
+ i= -1;
+ i1= data.n-2;
+ for( is = 0; is < data.m; is++ )
+ {
+ i++;
+ i1 += 2;
+ i2 = i1+1;
+ arg=- TP*( wx* data.px[i]+ wy* data.py[i]+ wz* data.pz[i]);
+ tt1= cmplx( cosl( arg), sinl( arg))* data.psalp[i]* RETA;
+ e[i2]=( qx* data.t1x[i]+ qy* data.t1y[i]+ qz* data.t1z[i])* tt1;
+ e[i1]=( qx* data.t2x[i]+ qy* data.t2y[i]+ qz* data.t2z[i])* tt1;
+ }
+
+ if( gnd.ksymp == 1)
+ return;
+
+ tt1=( qy* cph- qx* sph)*( rrv- rrh);
+ cx=-( rrh* qx- tt1* sph);
+ cy=-( rrh* qy+ tt1* cph);
+ cz= rrh* qz;
+
+ i= -1;
+ i1= data.n-2;
+ for( is = 0; is < data.m; is++ )
+ {
+ i++;
+ i1 += 2;
+ i2 = i1+1;
+ arg=- TP*( wx* data.px[i]+ wy* data.py[i]- wz* data.pz[i]);
+ tt1= cmplx( cosl( arg), sinl( arg))* data.psalp[i]* RETA;
+ e[i2]= e[i2]+( cx* data.t1x[i]+ cy* data.t1y[i]+ cz* data.t1z[i])* tt1;
+ e[i1]= e[i1]+( cx* data.t2x[i]+ cy* data.t2y[i]+ cz* data.t2z[i])* tt1;
+ }
+ return;
+
+ } /* if( ipr == 1) */
+
+ /* incident plane wave, elliptic polarization. */
+ tt1=-(CPLX_01)* p6;
+ if( ipr == 3)
+ tt1=- tt1;
+
+ if( data.n != 0)
+ {
+ cx= pxl+ tt1* qx;
+ cy= pyl+ tt1* qy;
+ cz= pzl+ tt1* qz;
+
+ for( i = 0; i < data.n; i++ )
+ {
+ arg=- TP*( wx* data.x[i]+ wy* data.y[i]+ wz* data.z[i]);
+ e[i]=-( cx* data.cab[i]+ cy* data.sab[i]+ cz*
+ data.salp[i])* cmplx( cosl( arg), sinl( arg));
+ }
+
+ if( gnd.ksymp != 1)
+ {
+ tt2=( cy* cph- cx* sph)*( rrh- rrv);
+ cx= rrv* cx- tt2* sph;
+ cy= rrv* cy+ tt2* cph;
+ cz=- rrv* cz;
+
+ for( i = 0; i < data.n; i++ )
+ {
+ arg=- TP*( wx* data.x[i]+ wy* data.y[i]- wz* data.z[i]);
+ e[i]= e[i]-( cx* data.cab[i]+ cy* data.sab[i]+
+ cz* data.salp[i])* cmplx(cosl( arg), sinl( arg));
+ }
+
+ } /* if( gnd.ksymp != 1) */
+
+ } /* if( n != 0) */
+
+ if( data.m == 0)
+ return;
+
+ cx= qx- tt1* pxl;
+ cy= qy- tt1* pyl;
+ cz= qz- tt1* pzl;
+
+ i= -1;
+ i1= data.n-2;
+ for( is = 0; is < data.m; is++ )
+ {
+ i++;
+ i1 += 2;
+ i2 = i1+1;
+ arg=- TP*( wx* data.px[i]+ wy* data.py[i]+ wz* data.pz[i]);
+ tt2= cmplx( cosl( arg), sinl( arg))* data.psalp[i]* RETA;
+ e[i2]=( cx* data.t1x[i]+ cy* data.t1y[i]+ cz* data.t1z[i])* tt2;
+ e[i1]=( cx* data.t2x[i]+ cy* data.t2y[i]+ cz* data.t2z[i])* tt2;
+ }
+
+ if( gnd.ksymp == 1)
+ return;
+
+ tt1=( cy* cph- cx* sph)*( rrv- rrh);
+ cx=-( rrh* cx- tt1* sph);
+ cy=-( rrh* cy+ tt1* cph);
+ cz= rrh* cz;
+
+ i= -1;
+ i1= data.n-2;
+ for( is=0; is < data.m; is++ )
+ {
+ i++;
+ i1 += 2;
+ i2 = i1+1;
+ arg=- TP*( wx* data.px[i]+ wy* data.py[i]- wz* data.pz[i]);
+ tt1= cmplx( cosl( arg), sinl( arg))* data.psalp[i]* RETA;
+ e[i2]= e[i2]+( cx* data.t1x[i]+ cy* data.t1y[i]+ cz* data.t1z[i])* tt1;
+ e[i1]= e[i1]+( cx* data.t2x[i]+ cy* data.t2y[i]+ cz* data.t2z[i])* tt1;
+ }
+
+ return;
+
+ } /* if( ipr <= 3) */
+
+ /* incident field of an elementary current source. */
+ wz= cosl( p4);
+ wx= wz* cosl( p5);
+ wy= wz* sinl( p5);
+ wz= sinl( p4);
+ ds= p6*59.958;
+ dsh= p6/(2.* TP);
+
+ is= 0;
+ i1= data.n-2;
+ for( i = 0; i < data.npm; i++ )
+ {
+ if( i >= data.n )
+ {
+ i1 += 2;
+ i2 = i1+1;
+ pxl= data.px[is]- p1;
+ pyl= data.py[is]- p2;
+ pzl= data.pz[is]- p3;
+ }
+ else
+ {
+ pxl= data.x[i]- p1;
+ pyl= data.y[i]- p2;
+ pzl= data.z[i]- p3;
+ }
+
+ rs= pxl* pxl+ pyl* pyl+ pzl* pzl;
+ if( rs < 1.0e-30)
+ continue;
+
+ r= sqrtl( rs);
+ pxl= pxl/ r;
+ pyl= pyl/ r;
+ pzl= pzl/ r;
+ cth= pxl* wx+ pyl* wy+ pzl* wz;
+ sth= sqrtl(1.- cth* cth);
+ qx= pxl- wx* cth;
+ qy= pyl- wy* cth;
+ qz= pzl- wz* cth;
+
+ arg= sqrtl( qx* qx+ qy* qy+ qz* qz);
+ if( arg >= 1.e-30)
+ {
+ qx= qx/ arg;
+ qy= qy/ arg;
+ qz= qz/ arg;
+ }
+ else
+ {
+ qx=1.;
+ qy=0.;
+ qz=0.;
+
+ } /* if( arg >= 1.e-30) */
+
+ arg=- TP* r;
+ tt1= cmplx( cosl( arg), sinl( arg));
+
+ if( i < data.n )
+ {
+ tt2= cmplx(1.0,-1.0/( r* TP))/ rs;
+ er= ds* tt1* tt2* cth;
+ et=.5* ds* tt1*((CPLX_01)* TP/ r+ tt2)* sth;
+ ezh= er* cth- et* sth;
+ erh= er* sth+ et* cth;
+ cx= ezh* wx+ erh* qx;
+ cy= ezh* wy+ erh* qy;
+ cz= ezh* wz+ erh* qz;
+ e[i]=-( cx* data.cab[i]+ cy* data.sab[i]+ cz* data.salp[i]);
+ }
+ else
+ {
+ pxl= wy* qz- wz* qy;
+ pyl= wz* qx- wx* qz;
+ pzl= wx* qy- wy* qx;
+ tt2= dsh* tt1* cmplx(1./ r, TP)/ r* sth* data.psalp[is];
+ cx= tt2* pxl;
+ cy= tt2* pyl;
+ cz= tt2* pzl;
+ e[i2]= cx* data.t1x[is]+ cy* data.t1y[is]+ cz* data.t1z[is];
+ e[i1]= cx* data.t2x[is]+ cy* data.t2y[is]+ cz* data.t2z[is];
+ is++;
+ } /* if( i < data.n) */
+
+ } /* for( i = 0; i < npm; i++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* subroutine to factor a matrix into a unit lower triangular matrix */
+/* and an upper triangular matrix using the gauss-doolittle algorithm */
+/* presented on pages 411-416 of a. ralston--a first course in */
+/* numerical analysis. comments below refer to comments in ralstons */
+/* text. (matrix transposed.) */
+
+void factr( int n, complex long double *a, int *ip, int ndim)
+{
+ int r, rm1, rp1, pj, pr, iflg, k, j, jp1, i;
+ long double dmax, elmag;
+ complex long double arj, *scm = NULL;
+
+ /* Allocate to scratch memory */
+ mem_alloc( (void *)&scm, data.np2m * sizeof(complex long double) );
+
+ /* Un-transpose the matrix for Gauss elimination */
+ for( i = 1; i < n; i++ )
+ for( j = 0; j < i; j++ )
+ {
+ arj = a[i+j*ndim];
+ a[i+j*ndim] = a[j+i*ndim];
+ a[j+i*ndim] = arj;
+ }
+
+ iflg=FALSE;
+ /* step 1 */
+ for( r = 0; r < n; r++ )
+ {
+ for( k = 0; k < n; k++ )
+ scm[k]= a[k+r*ndim];
+
+ /* steps 2 and 3 */
+ rm1= r;
+ if( rm1 > 0)
+ {
+ for( j = 0; j < rm1; j++ )
+ {
+ pj= ip[j]-1;
+ arj= scm[pj];
+ a[j+r*ndim]= arj;
+ scm[pj]= scm[j];
+ jp1= j+1;
+
+ for( i = jp1; i < n; i++ )
+ scm[i] -= a[i+j*ndim]* arj;
+
+ } /* for( j = 0; j < rm1; j++ ) */
+
+ } /* if( rm1 >= 0.) */
+
+ /* step 4 */
+ dmax= creal( scm[r]*conjl(scm[r]) );
+
+ rp1= r+1;
+ ip[r]= rp1;
+ if( rp1 < n)
+ {
+ for( i = rp1; i < n; i++ )
+ {
+ elmag= creal( scm[i]* conjl(scm[i]) );
+ if( elmag >= dmax)
+ {
+ dmax= elmag;
+ ip[r]= i+1;
+ }
+ }
+ } /* if( rp1 < n) */
+
+ if( dmax < 1.e-10)
+ iflg=TRUE;
+
+ pr= ip[r]-1;
+ a[r+r*ndim]= scm[pr];
+ scm[pr]= scm[r];
+
+ /* step 5 */
+ if( rp1 < n)
+ {
+ arj=1./ a[r+r*ndim];
+
+ for( i = rp1; i < n; i++ )
+ a[i+r*ndim]= scm[i]* arj;
+ }
+
+ if( iflg == TRUE )
+ {
+ fprintf( output_fp,
+ "\n PIVOT(%d)= %16.8LE", r, dmax );
+ iflg=FALSE;
+ }
+
+ } /* for( r=0; r < n; r++ ) */
+
+ free_ptr( (void *)&scm );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* factrs, for symmetric structure, transforms submatricies to form */
+/* matricies of the symmetric modes and calls routine to factor */
+/* matricies. if no symmetry, the routine is called to factor the */
+/* complete matrix. */
+void factrs( int np, int nrow, complex long double *a, int *ip )
+{
+ int kk, ka;
+
+ smat.nop = nrow/np;
+ for( kk = 0; kk < smat.nop; kk++ )
+ {
+ ka= kk* np;
+ factr( np, &a[ka], &ip[ka], nrow );
+ }
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* fblock sets parameters for out-of-core */
+/* solution for the primary matrix (a) */
+void fblock( int nrow, int ncol, int imax, int ipsym )
+{
+ int i, j, k, ka, kk;
+ long double phaz, arg;
+ complex long double deter;
+
+ if( nrow*ncol <= imax)
+ {
+ matpar.npblk= nrow;
+ matpar.nlast= nrow;
+ matpar.imat= nrow* ncol;
+
+ if( nrow == ncol)
+ {
+ matpar.icase=1;
+ return;
+ }
+ else
+ matpar.icase=2;
+
+ } /* if( nrow*ncol <= imax) */
+
+ smat.nop = ncol/nrow;
+ if( smat.nop*nrow != ncol)
+ {
+ fprintf( output_fp,
+ "\n SYMMETRY ERROR - NROW: %d NCOL: %d", nrow, ncol );
+ stop(-1);
+ }
+
+ /* set up smat.ssx matrix for rotational symmetry. */
+ if( ipsym <= 0)
+ {
+ phaz = TP/smat.nop;
+
+ for( i = 1; i < smat.nop; i++ )
+ {
+ for( j= i; j < smat.nop; j++ )
+ {
+ arg= phaz* (long double)i * (long double)j;
+ smat.ssx[i+j*smat.nop]= cmplx( cosl( arg), sinl( arg));
+ smat.ssx[j+i*smat.nop]= smat.ssx[i+j*smat.nop];
+ }
+ }
+ return;
+
+ } /* if( ipsym <= 0) */
+
+ /* set up smat.ssx matrix for plane symmetry */
+ kk=1;
+ smat.ssx[0]=CPLX_10;
+
+ k = 2;
+ for( ka = 1; k != smat.nop; ka++ )
+ k *= 2;
+
+ for( k = 0; k < ka; k++ )
+ {
+ for( i = 0; i < kk; i++ )
+ {
+ for( j = 0; j < kk; j++ )
+ {
+ deter= smat.ssx[i+j*smat.nop];
+ smat.ssx[i+(j+kk)*smat.nop]= deter;
+ smat.ssx[i+kk+(j+kk)*smat.nop]=- deter;
+ smat.ssx[i+kk+j*smat.nop]= deter;
+ }
+ }
+ kk *= 2;
+
+ } /* for( k = 0; k < ka; k++ ) */
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+
+/* subroutine to solve the matrix equation lu*x=b where l is a unit */
+/* lower triangular matrix and u is an upper triangular matrix both */
+/* of which are stored in a. the rhs vector b is input and the */
+/* solution is returned through vector b. (matrix transposed. */
+void solve( int n, complex long double *a, int *ip,
+ complex long double *b, int ndim )
+{
+ int i, ip1, j, k, pia;
+ complex long double sum, *scm = NULL;
+
+ /* Allocate to scratch memory */
+ mem_alloc( (void *)&scm, data.np2m * sizeof(complex long double) );
+
+ /* forward substitution */
+ for( i = 0; i < n; i++ )
+ {
+ pia= ip[i]-1;
+ scm[i]= b[pia];
+ b[pia]= b[i];
+ ip1= i+1;
+
+ if( ip1 < n)
+ for( j = ip1; j < n; j++ )
+ b[j] -= a[j+i*ndim]* scm[i];
+ }
+
+ /* backward substitution */
+ for( k = 0; k < n; k++ )
+ {
+ i= n-k-1;
+ sum=CPLX_00;
+ ip1= i+1;
+
+ if( ip1 < n)
+ for( j = ip1; j < n; j++ )
+ sum += a[i+j*ndim]* b[j];
+
+ b[i]=( scm[i]- sum)/ a[i+i*ndim];
+ }
+
+ free_ptr( (void *)&scm );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* subroutine solves, for symmetric structures, handles the */
+/* transformation of the right hand side vector and solution */
+/* of the matrix eq. */
+void solves( complex long double *a, int *ip, complex long double *b,
+ int neq, int nrh, int np, int n, int mp, int m)
+{
+ int npeq, nrow, ic, i, kk, ia, ib, j, k;
+ long double fnop, fnorm;
+ complex long double sum, *scm = NULL;
+
+ npeq= np+ 2*mp;
+ smat.nop = neq/npeq;
+ fnop= smat.nop;
+ fnorm=1./ fnop;
+ nrow= neq;
+
+ /* Allocate to scratch memory */
+ mem_alloc( (void *)&scm, data.np2m * sizeof(complex long double) );
+
+ if( smat.nop != 1)
+ {
+ for( ic = 0; ic < nrh; ic++ )
+ {
+ if( (n != 0) && (m != 0) )
+ {
+ for( i = 0; i < neq; i++ )
+ scm[i]= b[i+ic*neq];
+
+ kk=2* mp;
+ ia= np-1;
+ ib= n-1;
+ j= np-1;
+
+ for( k = 0; k < smat.nop; k++ )
+ {
+ if( k != 0 )
+ {
+ for( i = 0; i < np; i++ )
+ {
+ ia++;
+ j++;
+ b[j+ic*neq]= scm[ia];
+ }
+
+ if( k == (smat.nop-1) )
+ continue;
+
+ } /* if( k != 0 ) */
+
+ for( i = 0; i < kk; i++ )
+ {
+ ib++;
+ j++;
+ b[j+ic*neq]= scm[ib];
+ }
+
+ } /* for( k = 0; k < smat.nop; k++ ) */
+
+ } /* if( (n != 0) && (m != 0) ) */
+
+ /* transform matrix eq. rhs vector according to symmetry modes */
+ for( i = 0; i < npeq; i++ )
+ {
+ for( k = 0; k < smat.nop; k++ )
+ {
+ ia= i+ k* npeq;
+ scm[k]= b[ia+ic*neq];
+ }
+
+ sum= scm[0];
+ for( k = 1; k < smat.nop; k++ )
+ sum += scm[k];
+
+ b[i+ic*neq]= sum* fnorm;
+
+ for( k = 1; k < smat.nop; k++ )
+ {
+ ia= i+ k* npeq;
+ sum= scm[0];
+
+ for( j = 1; j < smat.nop; j++ )
+ sum += scm[j]* conjl( smat.ssx[k+j*smat.nop]);
+
+ b[ia+ic*neq]= sum* fnorm;
+ }
+
+ } /* for( i = 0; i < npeq; i++ ) */
+
+ } /* for( ic = 0; ic < nrh; ic++ ) */
+
+ } /* if( smat.nop != 1) */
+
+ /* solve each mode equation */
+ for( kk = 0; kk < smat.nop; kk++ )
+ {
+ ia= kk* npeq;
+ ib= ia;
+
+ for( ic = 0; ic < nrh; ic++ )
+ solve( npeq, &a[ib], &ip[ia], &b[ia+ic*neq], nrow );
+
+ } /* for( kk = 0; kk < smat.nop; kk++ ) */
+
+ if( smat.nop == 1)
+ {
+ free_ptr( (void *)&scm );
+ return;
+ }
+
+ /* inverse transform the mode solutions */
+ for( ic = 0; ic < nrh; ic++ )
+ {
+ for( i = 0; i < npeq; i++ )
+ {
+ for( k = 0; k < smat.nop; k++ )
+ {
+ ia= i+ k* npeq;
+ scm[k]= b[ia+ic*neq];
+ }
+
+ sum= scm[0];
+ for( k = 1; k < smat.nop; k++ )
+ sum += scm[k];
+
+ b[i+ic*neq]= sum;
+ for( k = 1; k < smat.nop; k++ )
+ {
+ ia= i+ k* npeq;
+ sum= scm[0];
+
+ for( j = 1; j < smat.nop; j++ )
+ sum += scm[j]* smat.ssx[k+j*smat.nop];
+
+ b[ia+ic*neq]= sum;
+ }
+
+ } /* for( i = 0; i < npeq; i++ ) */
+
+ if( (n == 0) || (m == 0) )
+ continue;
+
+ for( i = 0; i < neq; i++ )
+ scm[i]= b[i+ic*neq];
+
+ kk=2* mp;
+ ia= np-1;
+ ib= n-1;
+ j= np-1;
+
+ for( k = 0; k < smat.nop; k++ )
+ {
+ if( k != 0 )
+ {
+ for( i = 0; i < np; i++ )
+ {
+ ia++;
+ j++;
+ b[ia+ic*neq]= scm[j];
+ }
+
+ if( k == smat.nop)
+ continue;
+
+ } /* if( k != 0 ) */
+
+ for( i = 0; i < kk; i++ )
+ {
+ ib++;
+ j++;
+ b[ib+ic*neq]= scm[j];
+ }
+
+ } /* for( k = 0; k < smat.nop; k++ ) */
+
+ } /* for( ic = 0; ic < nrh; ic++ ) */
+
+ free_ptr( (void *)&scm );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/misc.c b/misc.c
new file mode 100644
index 0000000..2be1c95
--- /dev/null
+++ b/misc.c
@@ -0,0 +1,214 @@
+/*
+ * Miscellaneous support functions for nec2c.c
+ */
+
+#include "nec2c.h"
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/*------------------------------------------------------------------------*/
+
+/* usage()
+ *
+ * prints usage information
+ */
+
+void usage(void)
+{
+ fprintf( stderr,
+ "usage: nec2c [-i<input-file-name>] [-o<output-file-name>]"
+ "\n -h: print this usage information and exit."
+ "\n -v: print nec2c version number and exit.\n");
+
+} /* end of usage() */
+
+/*------------------------------------------------------------------------*/
+
+/* abort_on_error()
+ *
+ * prints an error message and exits
+ */
+
+void abort_on_error( int why )
+{
+ switch( why )
+ {
+ case -1 : /* abort if input file name too long */
+ fprintf( stderr, "%s\n",
+ "nec2c: Input file name too long - aborting" );
+ break;
+
+ case -2 : /* abort if output file name too long */
+ fprintf( stderr, "%s\n",
+ "nec2c: Output file name too long - aborting" );
+ break;
+
+ case -3 : /* abort on input file read error */
+ fprintf( stderr, "%s\n",
+ "nec2c: Error reading input file - aborting" );
+ break;
+
+ case -4 : /* Abort on malloc failure */
+ fprintf( stderr, "%s\n",
+ "nec2c: A memory allocation request has failed - aborting" );
+ break;
+
+ case -5 : /* Abort if a GF card is read */
+ fprintf( stderr, "%s\n",
+ "nec2c: NGF solution option not supported - aborting" );
+ break;
+
+ case -6: /* No convergence in gshank() */
+ fprintf( stderr, "%s\n",
+ "nec2c: No convergence in gshank() - aborting" );
+ break;
+
+ case -7: /* Error in hankel() */
+ fprintf( stderr, "%s\n",
+ "nec2c: Hankel not valid for z=0. - aborting" );
+
+ } /* switch( why ) */
+
+ /* clean up and quit */
+ stop( why );
+
+} /* end of abort_on_error() */
+
+/*------------------------------------------------------------------------*/
+
+/* Returns process time (user+system) BUT in _msec_ */
+void secnds( long double *x)
+{
+ struct tms buffer;
+
+ times(&buffer);
+ *x = 1000. * ( (long double)(buffer.tms_utime + buffer.tms_stime) ) /
+ ( (long double) sysconf(_SC_CLK_TCK) );
+
+ return;
+}
+
+/*------------------------------------------------------------------------*/
+
+/* Does the STOP function of fortran but with return value */
+int stop( int flag )
+{
+ if( input_fp != NULL )
+ fclose( input_fp );
+ if( output_fp != NULL )
+ fclose( output_fp );
+ if( plot_fp != NULL )
+ fclose( plot_fp );
+
+ exit( flag );
+}
+
+/*------------------------------------------------------------------*/
+
+/* load_line()
+ *
+ * loads a line from a file, aborts on failure. lines beginning
+ * with a '#' are ignored as comments. at the end of file EOF is
+ * returned.
+ */
+
+int load_line( char *buff, FILE *pfile )
+{
+ int
+ num_chr, /* number of characters read, excluding lf/cr */
+ eof = 0, /* EOF flag */
+ chr; /* character read by getc */
+
+ num_chr = 0;
+
+ /* clear buffer at start */
+ buff[0] = '\0';
+
+ /* ignore commented lines, white spaces and eol/cr */
+ if( (chr = fgetc(pfile)) == EOF )
+ return( EOF );
+
+ while( (chr == '#') ||
+ (chr == ' ') ||
+ (chr == CR ) ||
+ (chr == LF ) )
+ {
+ /* go to the end of line (look for lf or cr) */
+ while( (chr != CR) && (chr != LF) )
+ if( (chr = fgetc(pfile)) == EOF )
+ return( EOF );
+
+ /* dump any cr/lf remaining */
+ while( (chr == CR) || (chr == LF) )
+ if( (chr = fgetc(pfile)) == EOF )
+ return( EOF );
+
+ } /* end of while( (chr == '#') || ... */
+
+ while( num_chr < LINE_LEN )
+ {
+ /* if lf/cr reached before filling buffer, return */
+ if( (chr == CR) || (chr == LF) )
+ break;
+
+ /* enter new char to buffer */
+ buff[num_chr++] = chr;
+
+ /* terminate buffer as a string on EOF */
+ if( (chr = fgetc(pfile)) == EOF )
+ {
+ buff[num_chr] = '\0';
+ eof = EOF;
+ }
+
+ } /* end of while( num_chr < max_chr ) */
+
+ /* Capitalize first two characters (mnemonics) */
+ if( (buff[0] > 0x60) && (buff[0] < 0x79) )
+ buff[0] -= 0x20;
+ if( (buff[1] > 0x60) && (buff[1] < 0x79) )
+ buff[1] -= 0x20;
+
+ /* terminate buffer as a string */
+ buff[num_chr] = '\0';
+
+ return( eof );
+
+} /* end of load_line() */
+
+/*------------------------------------------------------------------------*/
+
+/*** Memory allocation/freeing utils ***/
+
+void mem_alloc( void **ptr, int req )
+{
+ free_ptr( ptr );
+ *ptr = malloc( req );
+ if( *ptr == NULL )
+ abort_on_error( -4 );
+
+} /* End of void mem_alloc() */
+
+/*------------------------------------------------------------------------*/
+
+void mem_realloc( void **ptr, int req )
+{
+ *ptr = realloc( *ptr, req );
+ if( *ptr == NULL )
+ abort_on_error( -4 );
+
+} /* End of void mem_realloc() */
+
+/*------------------------------------------------------------------------*/
+
+void free_ptr( void **ptr )
+{
+ if( *ptr != NULL )
+ free( *ptr );
+ *ptr = NULL;
+
+} /* End of void free_ptr() */
+
+/*------------------------------------------------------------------------*/
+
diff --git a/nec2c.h b/nec2c.h
new file mode 100644
index 0000000..0ed8a7a
--- /dev/null
+++ b/nec2c.h
@@ -0,0 +1,548 @@
+#ifndef NEC2C_H
+#define NEC2C_H 1
+
+#include <complex.h>
+#include <stdio.h>
+#include <signal.h>
+#include <math.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <string.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <time.h>
+#include <sys/types.h>
+#include <sys/times.h>
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+/* commonly used complex constants */
+#define CPLX_00 (0.0+0.0fj)
+#define CPLX_01 (0.0+1.0fj)
+#define CPLX_10 (1.0+0.0fj)
+#define CPLX_11 (1.0+1.0fj)
+
+/* common constants */
+#define PI 3.141592654
+#define POT 1.570796327
+#define TP 6.283185308
+#define PTP .6283185308
+#define TPJ (0.0+6.283185308fj)
+#define PI8 25.13274123
+#define PI10 31.41592654
+#define TA 1.745329252E-02
+#define TD 57.29577951
+#define ETA 376.73
+#define CVEL 299.8
+#define RETA 2.654420938E-3
+#define TOSP 1.128379167
+#define ACCS 1.E-12
+#define SP 1.772453851
+#define FPI 12.56637062
+#define CCJ (0.0-0.01666666667fj)
+#define CONST1 (0.0+4.771341189fj)
+#define CONST2 4.771341188
+#define CONST3 (0.0-29.97922085fj)
+#define CONST4 (0.0+188.365fj)
+#define GAMMA .5772156649
+#define C1 -.02457850915
+#define C2 .3674669052
+#define C3 .7978845608
+#define P10 .0703125
+#define P20 .1121520996
+#define Q10 .125
+#define Q20 .0732421875
+#define P11 .1171875
+#define P21 .1441955566
+#define Q11 .375
+#define Q21 .1025390625
+#define POF .7853981635
+#define MAXH 20
+#define CRIT 1.0E-4
+#define NM 131072
+#define NTS 4
+#define SMIN 1.e-3
+
+/* Replaces the "10000" limit used to */
+/* identify segment/patch connections */
+#define PCHCON 100000
+
+/* carriage return and line feed */
+#define CR 0x0d
+#define LF 0x0a
+
+/* max length of a line read from input file */
+#define LINE_LEN 132
+/* version of fortran source for the -v option */
+#define version "nec2c 0.7"
+
+/*** Structs encapsulating global ("common") variables ***/
+/* common /crnt/ */
+typedef struct
+{
+ long double
+ *air, /* Ai/lambda, real part */
+ *aii, /* Ai/lambda, imaginary part */
+ *bir, /* Bi/lambda, real part */
+ *bii, /* Bi/lambda, imaginary part */
+ *cir, /* Ci/lambda, real part */
+ *cii; /* Ci/lambda, imaginary part */
+
+ complex long double *cur; /* Amplitude of basis function */
+
+} crnt_t;
+
+/* common /data/ (geometry data) */
+typedef struct
+{
+ int
+ n, /* Number of wire segments */
+ np, /* Number of wire segments in symmetry cell */
+ m, /* Number of surface patches */
+ mp, /* Number of surface patches in symmetry cell */
+ npm, /* = n+m */
+ np2m, /* = n+2m */
+ np3m, /* = n+3m */
+ ipsym, /* Symmetry flag */
+ *icon1, /* Segments end 1 connection */
+ *icon2, /* Segments end 2 connection */
+ *itag; /* Segments tag number */
+
+ /* Wire segment data */
+ long double
+ *x1, *y1, *z1, /* End 1 coordinates of wire segments */
+ *x2, *y2, *z2, /* End 2 coordinates of wire segments */
+ *x, *y, *z, /* Coordinates of segment centers */
+ *si, *bi, /* Length and radius of segments */
+ *cab, /* cos(a)*cos(b) */
+ *sab, /* cos(a)*sin(b) */
+ *salp, /* Z component - sin(a) */
+
+ /* Surface patch data */
+ *px, *py, *pz, /* Coordinates of patch center */
+ *t1x, *t1y, *t1z, /* Coordinates of t1 vector */
+ *t2x, *t2y, *t2z, /* Coordinates of t2 vector */
+ *pbi, /* Patch surface area */
+ *psalp, /* Z component - sin(a) */
+
+ /* Wavelength in meters */
+ wlam;
+
+} data_t;
+
+/* common /dataj/ */
+typedef struct
+{
+ int
+ iexk,
+ ind1,
+ indd1,
+ ind2,
+ indd2,
+ ipgnd;
+
+ long double
+ s,
+ b,
+ xj,
+ yj,
+ zj,
+ cabj,
+ sabj,
+ salpj,
+ rkh,
+ t1xj,
+ t1yj,
+ t1zj,
+ t2xj,
+ t2yj,
+ t2zj;
+
+ complex long double
+ exk,
+ eyk,
+ ezk,
+ exs,
+ eys,
+ ezs,
+ exc,
+ eyc,
+ ezc;
+
+} dataj_t;
+
+/* common /fpat/ */
+typedef struct
+{
+ int
+ near,
+ nfeh,
+ nrx,
+ nry,
+ nrz,
+ nth,
+ nph,
+ ipd,
+ iavp,
+ inor,
+ iax,
+ ixtyp;
+
+ long double
+ thets,
+ phis,
+ dth,
+ dph,
+ rfld,
+ gnor,
+ clt,
+ cht,
+ epsr2,
+ sig2,
+ xpr6,
+ pinr,
+ pnlr,
+ ploss,
+ xnr,
+ ynr,
+ znr,
+ dxnr,
+ dynr,
+ dznr;
+
+} fpat_t;
+
+/*common /ggrid/ */
+typedef struct
+{
+ int
+ nxa[3],
+ nya[3];
+
+ long double
+ dxa[3],
+ dya[3],
+ xsa[3],
+ ysa[3];
+
+ complex long double
+ epscf,
+ *ar1,
+ *ar2,
+ *ar3;
+
+} ggrid_t;
+
+/* common /gnd/ */
+typedef struct
+{
+ int
+ ksymp, /* Ground flag */
+ ifar, /* Int flag in RP card, for far field calculations */
+ iperf, /* Type of ground flag */
+ nradl; /* Number of radials in ground screen */
+
+ long double
+ t2, /* Const for radial wire ground impedance */
+ cl, /* Distance in wavelengths of cliff edge from origin */
+ ch, /* Cliff height in wavelengths */
+ scrwl, /* Wire length in radial ground screen normalized to w/length */
+ scrwr; /* Radius of wires in screen in wavelengths */
+
+ complex long double
+ zrati, /* Ground medium [Er-js/wE0]^-1/2 */
+ zrati2, /* As above for 2nd ground medium */
+ t1, /* Const for radial wire ground impedance */
+ frati; /* (k1^2-k2^2)/(k1^2+k2^2), k1=w(E0Mu0)^1/2, k1=k2/ZRATI */
+
+} gnd_t;
+
+/* common /gwav/ */
+typedef struct
+{
+ long double
+ r1, /* Distance from current element to point where field is evaluated */
+ r2, /* Distance from image of element to point where field is evaluated */
+ zmh, /* Z-Z', Z is height of field evaluation point */
+ zph; /* Z+Z', Z' is height of current element */
+
+ complex long double
+ u, /* (Er-jS/WE0)^-1/2 */
+ u2, /* u^2 */
+ xx1, /* G1*exp(jkR1.r[i]) */
+ xx2; /* G2*exp(jkR2.r'[i]) */
+
+} gwav_t;
+
+/* common /incom/ */
+typedef struct
+{
+ int isnor;
+
+ long double
+ xo,
+ yo,
+ zo,
+ sn,
+ xsn,
+ ysn;
+
+} incom_t;
+
+/* common /matpar/ (matrix parameters) */
+typedef struct
+{
+ int
+ icase, /* Storage mode of primary matrix */
+ npblk, /* Num of blocks in first (NBLOKS-1) blocks */
+ nlast, /* Num of blocks in last block */
+ imat; /* Storage reserved in CM for primary NGF matrix A */
+
+} matpar_t;
+
+/* common /netcx/ */
+typedef struct
+{
+ int
+ masym, /* Matrix symmetry flags */
+ neq,
+ npeq,
+ neq2,
+ nonet, /* Number of two-port networks */
+ ntsol, /* "Network equations are solved" flag */
+ nprint, /* Print control flag */
+ *iseg1, /* Num of seg to which port 1 of network is connected */
+ *iseg2, /* Num of seg to which port 2 of network is connected */
+ *ntyp; /* Type of networks */
+
+ long double
+ *x11r, /* Real and imaginary parts of network impedances */
+ *x11i,
+ *x12r,
+ *x12i,
+ *x22r,
+ *x22i,
+ pin, /* Total input power from sources */
+ pnls; /* Power lost in networks */
+
+ complex long double zped;
+
+} netcx_t;
+
+/* common /plot/ */
+typedef struct
+{
+ int
+ /* Plot control flags */
+ iplp1,
+ iplp2,
+ iplp3,
+ iplp4;
+
+} plot_t;
+
+/* common /save/ */
+typedef struct
+{
+ int *ip; /* Vector of indices of pivot elements used to factor matrix */
+
+ long double
+ epsr, /* Relative dielectric constant of ground */
+ sig, /* Conductivity of ground */
+ scrwlt, /* Length of radials in ground screen approximation */
+ scrwrt, /* Radius of wires in ground screen approximation */
+ fmhz; /* Frequency in MHz */
+
+} save_t;
+
+/* common /segj/ */
+typedef struct
+{
+ int
+ *jco, /* Stores connection data */
+ jsno, /* Total number of entries in ax, bx, cx */
+ maxcon; /* Max. no. connections */
+
+ long double
+ *ax, *bx, *cx; /* Store constants A, B, C used in current expansion */
+
+} segj_t;
+
+/* common /smat/ */
+typedef struct
+{
+ int nop; /* My addition */
+
+ complex long double *ssx;
+
+} smat_t;
+
+/* common /tmi/ */
+typedef struct
+{
+ int ij;
+
+ long double
+ zpk,
+ rkb2;
+
+} tmi_t;
+
+/*common /tmh/ */
+typedef struct
+{
+ long double
+ zpka,
+ rhks;
+
+} tmh_t;
+
+/* common /vsorc/ */
+typedef struct
+{
+ int
+ *isant, /* Num of segs on which an aplied field source is located */
+ *ivqd, /* Num of segs on which a current-slope discontinuity source is located */
+ *iqds, /* Same as above (?) */
+ nsant, /* Number of applied field voltage sources */
+ nvqd, /* Number of applied current-slope discontinuity sources */
+ nqds; /* Same as above (?) */
+
+ complex long double
+ *vqd, /* Voltage of applied-current slope discontinuity sources */
+ *vqds, /* Same as above (?) */
+ *vsant; /* Voltages of applied field voltage sources */
+
+} vsorc_t;
+
+/* common /yparm/ */
+typedef struct
+{
+ int
+ ncoup, /* Num of segs between which coupling will be computed */
+ icoup, /* Num of segs in the coupling array that have been excited */
+ *nctag, /* Tag number of segments */
+ *ncseg; /* Num of segs in set of segs that have same tag number */
+
+ complex long double
+ *y11a, /* Self admittance of segments */
+ *y12a; /* Mutual admittances stored in order 1,2 1,3 2,3 2,4 etc */
+
+} yparm_t;
+
+/* common /zload/ */
+typedef struct
+{
+ int nload; /* Number of loading networks */
+
+ complex long double *zarray; /* = Zi/(Di/lambda) */
+
+} zload_t;
+
+/* Returns the complex long double of the arguments */
+#define cmplx(r, i) ((r)+(i)*CPLX_01)
+
+/*------------------------------------------------------------------------*/
+
+/* Function prototypes produced by cproto */
+/* calculations.c */
+void cabc(complex long double *curx);
+void couple(complex long double *cur, long double wlam);
+void load(int *ldtyp, int *ldtag, int *ldtagf, int *ldtagt, long double *zlr, long double *zli, long double *zlc);
+void gf(long double zk, long double *co, long double *si);
+long double db10(long double x);
+long double db20(long double x);
+void intrp(long double x, long double y, complex long double *f1, complex long double *f2, complex long double *f3, complex long double *f4);
+void intx(long double el1, long double el2, long double b, int ij, long double *sgr, long double *sgi);
+int min(int a, int b);
+void test(long double f1r, long double f2r, long double *tr, long double f1i, long double f2i, long double *ti, long double dmin);
+void sbf(int i, int is, long double *aa, long double *bb, long double *cc);
+void tbf(int i, int icap);
+void trio(int j);
+void zint(long double sigl, long double rolam, complex long double *zt);
+long double cang(complex long double z);
+/* fields.c */
+void efld(long double xi, long double yi, long double zi, long double ai, int ij);
+void eksc(long double s, long double z, long double rh, long double xk, int ij, complex long double *ezs, complex long double *ers, complex long double *ezc, complex long double *erc, complex long double *ezk, complex long double *erk);
+void ekscx(long double bx, long double s, long double z, long double rhx, long double xk, int ij, int inx1, int inx2, complex long double *ezs, complex long double *ers, complex long double *ezc, complex long double *erc, complex long double *ezk, complex long double *erk);
+void gh(long double zk, long double *hr, long double *hi);
+void gwave(complex long double *erv, complex long double *ezv, complex long double *erh, complex long double *ezh, complex long double *eph);
+void gx(long double zz, long double rh, long double xk, complex long double *gz, complex long double *gzp);
+void gxx(long double zz, long double rh, long double a, long double a2, long double xk, int ira, complex long double *g1, complex long double *g1p, complex long double *g2, complex long double *g2p, complex long double *g3, complex long double *gzp);
+void hfk(long double el1, long double el2, long double rhk, long double zpkx, long double *sgr, long double *sgi);
+void hintg(long double xi, long double yi, long double zi);
+void hsfld(long double xi, long double yi, long double zi, long double ai);
+void hsflx(long double s, long double rh, long double zpx, complex long double *hpk, complex long double *hps, complex long double *hpc);
+void nefld(long double xob, long double yob, long double zob, complex long double *ex, complex long double *ey, complex long double *ez);
+void nfpat(void);
+void nhfld(long double xob, long double yob, long double zob, complex long double *hx, complex long double *hy, complex long double *hz);
+void pcint(long double xi, long double yi, long double zi, long double cabi, long double sabi, long double salpi, complex long double *e);
+void unere(long double xob, long double yob, long double zob);
+/* geometry.c */
+void arc(int itg, int ns, long double rada, long double ang1, long double ang2, long double rad);
+void conect(int ignd);
+void datagn(void);
+void helix(long double s, long double hl, long double a1, long double b1, long double a2, long double b2, long double rad, int ns, int itg);
+int isegno(int itagi, int mx);
+void move(long double rox, long double roy, long double roz, long double xs, long double ys, long double zs, int its, int nrpt, int itgi);
+void patch(int nx, int ny, long double ax1, long double ay1, long double az1, long double ax2, long double ay2, long double az2, long double ax3, long double ay3, long double az3, long double ax4, long double ay4, long double az4);
+void subph(int nx, int ny);
+void readgm(char *gm, int *i1, int *i2, long double *x1, long double *y1, long double *z1, long double *x2, long double *y2, long double *z2, long double *rad);
+void reflc(int ix, int iy, int iz, int itx, int nop);
+void wire(long double xw1, long double yw1, long double zw1, long double xw2, long double yw2, long double zw2, long double rad, long double rdel, long double rrad, int ns, int itg);
+/* ground.c */
+void rom2(long double a, long double b, complex long double *sum, long double dmin);
+void sflds(long double t, complex long double *e);
+/* input.c */
+void qdsrc(int is, complex long double v, complex long double *e);
+void readmn(char *gm, int *i1, int *i2, int *i3, int *i4, long double *f1, long double *f2, long double *f3, long double *f4, long double *f5, long double *f6);
+/* main.c */
+int main(int argc, char **argv);
+void Null_Pointers(void);
+void prnt(int in1, int in2, int in3, long double fl1, long double fl2, long double fl3, long double fl4, long double fl5, long double fl6, char *ia, int ichar);
+/* matrix.c */
+void cmset(int nrow, complex long double *cm, long double rkhx, int iexkx);
+void cmss(int j1, int j2, int im1, int im2, complex long double *cm, int nrow, int itrp);
+void cmsw(int j1, int j2, int i1, int i2, complex long double *cm, complex long double *cw, int ncw, int nrow, int itrp);
+void cmws(int j, int i1, int i2, complex long double *cm, int nr, complex long double *cw, int nw, int itrp);
+void cmww(int j, int i1, int i2, complex long double *cm, int nr, complex long double *cw, int nw, int itrp);
+void etmns(long double p1, long double p2, long double p3, long double p4, long double p5, long double p6, int ipr, complex long double *e);
+void factr(int n, complex long double *a, int *ip, int ndim);
+void factrs(int np, int nrow, complex long double *a, int *ip);
+void fblock(int nrow, int ncol, int imax, int ipsym);
+void solve(int n, complex long double *a, int *ip, complex long double *b, int ndim);
+void solves(complex long double *a, int *ip, complex long double *b, int neq, int nrh, int np, int n, int mp, int m);
+/* misc.c */
+void usage(void);
+void abort_on_error(int why);
+void secnds(long double *x);
+int stop(int flag);
+int load_line(char *buff, FILE *pfile);
+void mem_alloc(void **ptr, int req);
+void mem_realloc(void **ptr, int req);
+void free_ptr(void **ptr);
+/* network.c */
+void netwk(complex long double *cm, int *ip, complex long double *einc);
+/* radiation.c */
+void ffld(long double thet, long double phi, complex long double *eth, complex long double *eph);
+void fflds(long double rox, long double roy, long double roz, complex long double *scur, complex long double *ex, complex long double *ey, complex long double *ez);
+void gfld(long double rho, long double phi, long double rz, complex long double *eth, complex long double *epi, complex long double *erd, complex long double ux, int ksymp);
+void rdpat(void);
+/* somnec.c */
+void somnec(long double epr, long double sig, long double fmhz);
+void bessel(complex long double z, complex long double *j0, complex long double *j0p);
+void evlua(complex long double *erv, complex long double *ezv, complex long double *erh, complex long double *eph);
+void fbar(complex long double p, complex long double *r);
+void gshank(complex long double start, complex long double dela, complex long double *sum, int nans, complex long double *seed, int ibk, complex long double bk, complex long double delb);
+void hankel(complex long double z, complex long double *h0, complex long double *h0p);
+void lambda(long double t, complex long double *xlam, complex long double *dxlam);
+void rom1(int n, complex long double *sum, int nx);
+void saoa(long double t, complex long double *ans);
+#endif
+
diff --git a/network.c b/network.c
new file mode 100755
index 0000000..884123c
--- /dev/null
+++ b/network.c
@@ -0,0 +1,636 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+*******************************************************************/
+
+#include "nec2c.h"
+
+/* common /netcx/ */
+extern netcx_t netcx;
+
+/* common /vsorc/ */
+extern vsorc_t vsorc;
+
+/* common /data/ */
+extern data_t data;
+
+/* common /crnt/ */
+extern crnt_t crnt;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/*-------------------------------------------------------------------*/
+
+
+/* subroutine netwk solves for structure currents for a given */
+/* excitation including the effect of non-radiating networks if */
+/* present. */
+void netwk( complex long double *cm, int *ip, complex long double *einc )
+{
+ int *ipnt = NULL, *nteqa = NULL, *ntsca = NULL;
+ int jump1, jump2, nteq=0, ntsc=0, nseg2, irow2=0, j, ndimn;
+ int neqz2, neqt, irow1=0, i, nseg1, isc1=0, isc2=0;
+ long double asmx, asa, pwr, y11r, y11i, y12r, y12i, y22r, y22i;
+ complex long double *vsrc = NULL, *rhs = NULL, *cmn = NULL;
+ complex long double *rhnt = NULL, *rhnx = NULL, ymit, vlt, cux;
+
+ neqz2= netcx.neq2;
+ if( neqz2 == 0)
+ neqz2=1;
+
+ netcx.pin=0.;
+ netcx.pnls=0.;
+ neqt= netcx.neq+ netcx.neq2;
+ ndimn = j = (2*netcx.nonet + vsorc.nsant);
+
+ /* Allocate network buffers */
+ if( netcx.nonet != 0 )
+ {
+ mem_alloc( (void *)&rhs, data.np3m * sizeof(complex long double) );
+
+ i = j * sizeof(complex long double);
+ mem_alloc( (void *)&rhnt, i );
+ mem_alloc( (void *)&rhnx, i );
+ mem_alloc( (void *)&cmn, i * j );
+
+ i = j * sizeof(int);
+ mem_alloc( (void *)&ntsca, i );
+ mem_alloc( (void *)&nteqa, i );
+ mem_alloc( (void *)&ipnt, i );
+
+ mem_alloc( (void *)&vsrc, vsorc.nsant * sizeof(complex long double) );
+ }
+ else
+ if( netcx.masym != 0)
+ {
+ i = j * sizeof(int);
+ mem_alloc( (void *)&ipnt, i );
+ }
+
+ if( netcx.ntsol == 0)
+ {
+ /* compute relative matrix asymmetry */
+ if( netcx.masym != 0)
+ {
+ irow1=0;
+ if( netcx.nonet != 0)
+ {
+ for( i = 0; i < netcx.nonet; i++ )
+ {
+ nseg1= netcx.iseg1[i];
+ for( isc1 = 0; isc1 < 2; isc1++ )
+ {
+ if( irow1 == 0)
+ {
+ ipnt[irow1]= nseg1;
+ nseg1= netcx.iseg2[i];
+ irow1++;
+ continue;
+ }
+
+ for( j = 0; j < irow1; j++ )
+ if( nseg1 == ipnt[j])
+ break;
+
+ if( j == irow1 )
+ {
+ ipnt[irow1]= nseg1;
+ irow1++;
+ }
+
+ nseg1= netcx.iseg2[i];
+
+ } /* for( isc1 = 0; isc1 < 2; isc1++ ) */
+
+ } /* for( i = 0; i < netcx.nonet; i++ ) */
+
+ } /* if( netcx.nonet != 0) */
+
+ if( vsorc.nsant != 0)
+ {
+ for( i = 0; i < vsorc.nsant; i++ )
+ {
+ nseg1= vsorc.isant[i];
+ if( irow1 == 0)
+ {
+ ipnt[irow1]= nseg1;
+ irow1++;
+ continue;
+ }
+
+ for( j = 0; j < irow1; j++ )
+ if( nseg1 == ipnt[j])
+ break;
+
+ if( j == irow1 )
+ {
+ ipnt[irow1]= nseg1;
+ irow1++;
+ }
+
+ } /* for( i = 0; i < vsorc.nsant; i++ ) */
+
+ } /* if( vsorc.nsant != 0) */
+
+ if( irow1 >= 2)
+ {
+ for( i = 0; i < irow1; i++ )
+ {
+ isc1= ipnt[i]-1;
+ asmx= data.si[isc1];
+
+ for( j = 0; j < neqt; j++ )
+ rhs[j] = CPLX_00;
+
+ rhs[isc1] = CPLX_10;
+ solves( cm, ip, rhs, netcx.neq, 1, data.np, data.n, data.mp, data.m);
+ cabc( rhs);
+
+ for( j = 0; j < irow1; j++ )
+ {
+ isc1= ipnt[j]-1;
+ cmn[j+i*ndimn]= rhs[isc1]/ asmx;
+ }
+
+ } /* for( i = 0; i < irow1; i++ ) */
+
+ asmx=0.;
+ asa=0.;
+
+ for( i = 1; i < irow1; i++ )
+ {
+ isc1= i;
+ for( j = 0; j < isc1; j++ )
+ {
+ cux= cmn[i+j*ndimn];
+ pwr= cabsl(( cux- cmn[j+i*ndimn])/ cux);
+ asa += pwr* pwr;
+
+ if( pwr < asmx)
+ continue;
+
+ asmx= pwr;
+ nteq= ipnt[i];
+ ntsc= ipnt[j];
+
+ } /* for( j = 0; j < isc1; j++ ) */
+
+ } /* for( i = 1; i < irow1; i++ ) */
+
+ asa= sqrtl( asa*2./ (long double)( irow1*( irow1-1)));
+ fprintf( output_fp, "\n\n"
+ " MAXIMUM RELATIVE ASYMMETRY OF THE DRIVING POINT ADMITTANCE\n"
+ " MATRIX IS %10.3LE FOR SEGMENTS %d AND %d\n"
+ " RMS RELATIVE ASYMMETRY IS %10.3LE",
+ asmx, nteq, ntsc, asa );
+
+ } /* if( irow1 >= 2) */
+
+ } /* if( netcx.masym != 0) */
+
+ /* solution of network equations */
+ if( netcx.nonet != 0)
+ {
+ for( i = 0; i < ndimn; i++ )
+ {
+ rhnx[i]=CPLX_00;
+ for( j = 0; j < ndimn; j++ )
+ cmn[j+i*ndimn]=CPLX_00;
+ }
+
+ /* sort network and source data and */
+ /* assign equation numbers to segments */
+ nteq=0;
+ ntsc=0;
+
+ for( j = 0; j < netcx.nonet; j++ )
+ {
+ nseg1= netcx.iseg1[j];
+ nseg2= netcx.iseg2[j];
+
+ if( netcx.ntyp[j] <= 1)
+ {
+ y11r= netcx.x11r[j];
+ y11i= netcx.x11i[j];
+ y12r= netcx.x12r[j];
+ y12i= netcx.x12i[j];
+ y22r= netcx.x22r[j];
+ y22i= netcx.x22i[j];
+ }
+ else
+ {
+ y22r= TP* netcx.x11i[j]/ data.wlam;
+ y12r=0.;
+ y12i=1./( netcx.x11r[j]* sinl( y22r));
+ y11r= netcx.x12r[j];
+ y11i=- y12i* cosl( y22r);
+ y22r= netcx.x22r[j];
+ y22i= y11i+ netcx.x22i[j];
+ y11i= y11i+ netcx.x12i[j];
+
+ if( netcx.ntyp[j] != 2)
+ {
+ y12r=- y12r;
+ y12i=- y12i;
+ }
+
+ } /* if( netcx.ntyp[j] <= 1) */
+
+ jump1 = FALSE;
+ if( vsorc.nsant != 0)
+ {
+ for( i = 0; i < vsorc.nsant; i++ )
+ if( nseg1 == vsorc.isant[i])
+ {
+ isc1 = i;
+ jump1 = TRUE;
+ break;
+ }
+ } /* if( vsorc.nsant != 0) */
+
+ jump2 = FALSE;
+ if( ! jump1 )
+ {
+ isc1=-1;
+
+ if( nteq != 0)
+ {
+ for( i = 0; i < nteq; i++ )
+ if( nseg1 == nteqa[i])
+ {
+ irow1 = i;
+ jump2 = TRUE;
+ break;
+ }
+
+ } /* if( nteq != 0) */
+
+ if( ! jump2 )
+ {
+ irow1= nteq;
+ nteqa[nteq]= nseg1;
+ nteq++;
+ }
+
+ } /* if( ! jump1 ) */
+ else
+ {
+ if( ntsc != 0)
+ {
+ for( i = 0; i < ntsc; i++ )
+ {
+ if( nseg1 == ntsca[i])
+ {
+ irow1 = ndimn- (i+1);
+ jump2 = TRUE;
+ break;
+ }
+ }
+
+ } /* if( ntsc != 0) */
+
+ if( ! jump2 )
+ {
+ irow1= ndimn- (ntsc+1);
+ ntsca[ntsc]= nseg1;
+ vsrc[ntsc]= vsorc.vsant[isc1];
+ ntsc++;
+ }
+
+ } /* if( ! jump1 ) */
+
+ jump1 = FALSE;
+ if( vsorc.nsant != 0)
+ {
+ for( i = 0; i < vsorc.nsant; i++ )
+ {
+ if( nseg2 == vsorc.isant[i])
+ {
+ isc2= i;
+ jump1 = TRUE;
+ break;
+ }
+ }
+
+ } /* if( vsorc.nsant != 0) */
+
+ jump2 = FALSE;
+ if( ! jump1 )
+ {
+ isc2=-1;
+
+ if( nteq != 0)
+ {
+ for( i = 0; i < nteq; i++ )
+ if( nseg2 == nteqa[i])
+ {
+ irow2= i;
+ jump2 = TRUE;
+ break;
+ }
+
+ } /* if( nteq != 0) */
+
+ if( ! jump2 )
+ {
+ irow2= nteq;
+ nteqa[nteq]= nseg2;
+ nteq++;
+ }
+
+ } /* if( ! jump1 ) */
+ else
+ {
+ if( ntsc != 0)
+ {
+ for( i = 0; i < ntsc; i++ )
+ if( nseg2 == ntsca[i])
+ {
+ irow2 = ndimn- (i+1);
+ jump2 = TRUE;
+ break;
+ }
+
+ } /* if( ntsc != 0) */
+
+ if( ! jump2 )
+ {
+ irow2= ndimn- (ntsc+1);
+ ntsca[ntsc]= nseg2;
+ vsrc[ntsc]= vsorc.vsant[isc2];
+ ntsc++;
+ }
+
+ } /* if( ! jump1 ) */
+
+ /* fill network equation matrix and right hand side vector with */
+ /* network short-circuit admittance matrix coefficients. */
+ if( isc1 == -1)
+ {
+ cmn[irow1+irow1*ndimn] -= cmplx( y11r, y11i)* data.si[nseg1-1];
+ cmn[irow1+irow2*ndimn] -= cmplx( y12r, y12i)* data.si[nseg1-1];
+ }
+ else
+ {
+ rhnx[irow1] += cmplx( y11r, y11i)* vsorc.vsant[isc1]/data.wlam;
+ rhnx[irow2] += cmplx( y12r, y12i)* vsorc.vsant[isc1]/data.wlam;
+ }
+
+ if( isc2 == -1)
+ {
+ cmn[irow2+irow2*ndimn] -= cmplx( y22r, y22i)* data.si[nseg2-1];
+ cmn[irow2+irow1*ndimn] -= cmplx( y12r, y12i)* data.si[nseg2-1];
+ }
+ else
+ {
+ rhnx[irow1] += cmplx( y12r, y12i)* vsorc.vsant[isc2]/data.wlam;
+ rhnx[irow2] += cmplx( y22r, y22i)* vsorc.vsant[isc2]/data.wlam;
+ }
+
+ } /* for( j = 0; j < netcx.nonet; j++ ) */
+
+ /* add interaction matrix admittance */
+ /* elements to network equation matrix */
+ for( i = 0; i < nteq; i++ )
+ {
+ for( j = 0; j < neqt; j++ )
+ rhs[j] = CPLX_00;
+
+ irow1= nteqa[i]-1;
+ rhs[irow1]=CPLX_10;
+ solves( cm, ip, rhs, netcx.neq, 1, data.np, data.n, data.mp, data.m);
+ cabc( rhs);
+
+ for( j = 0; j < nteq; j++ )
+ {
+ irow1= nteqa[j]-1;
+ cmn[i+j*ndimn] += rhs[irow1];
+ }
+
+ } /* for( i = 0; i < nteq; i++ ) */
+
+ /* factor network equation matrix */
+ factr( nteq, cmn, ipnt, ndimn);
+
+ } /* if( netcx.nonet != 0) */
+
+ } /* if( netcx.ntsol != 0) */
+
+ if( netcx.nonet != 0)
+ {
+ /* add to network equation right hand side */
+ /* the terms due to element interactions */
+ for( i = 0; i < neqt; i++ )
+ rhs[i]= einc[i];
+
+ solves( cm, ip, rhs, netcx.neq, 1, data.np, data.n, data.mp, data.m);
+ cabc( rhs);
+
+ for( i = 0; i < nteq; i++ )
+ {
+ irow1= nteqa[i]-1;
+ rhnt[i]= rhnx[i]+ rhs[irow1];
+ }
+
+ /* solve network equations */
+ solve( nteq, cmn, ipnt, rhnt, ndimn);
+
+ /* add fields due to network voltages to electric fields */
+ /* applied to structure and solve for induced current */
+ for( i = 0; i < nteq; i++ )
+ {
+ irow1= nteqa[i]-1;
+ einc[irow1] -= rhnt[i];
+ }
+
+ solves( cm, ip, einc, netcx.neq, 1, data.np, data.n, data.mp, data.m);
+ cabc( einc);
+
+ if( netcx.nprint == 0)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "--------- STRUCTURE EXCITATION DATA AT NETWORK CONNECTION POINTS --------" );
+
+ fprintf( output_fp, "\n"
+ " TAG SEG VOLTAGE (VOLTS) CURRENT (AMPS) "
+ " IMPEDANCE (OHMS) ADMITTANCE (MHOS) POWER\n"
+ " No: No: REAL IMAGINARY REAL IMAGINARY "
+ " REAL IMAGINARY REAL IMAGINARY (WATTS)" );
+ }
+
+ for( i = 0; i < nteq; i++ )
+ {
+ irow1= nteqa[i]-1;
+ vlt= rhnt[i]* data.si[irow1]* data.wlam;
+ cux= einc[irow1]* data.wlam;
+ ymit= cux/ vlt;
+ netcx.zped= vlt/ cux;
+ irow2= data.itag[irow1];
+ pwr=.5* creall( vlt* conjl( cux));
+ netcx.pnls= netcx.pnls- pwr;
+
+ if( netcx.nprint == 0)
+ fprintf( output_fp, "\n"
+ " %4d %5d %11.4LE %11.4LE %11.4LE %11.4LE"
+ " %11.4LE %11.4LE %11.4LE %11.4LE %11.4LE",
+ irow2, irow1+1, creall(vlt), cimagl(vlt), creall(cux), cimagl(cux),
+ creall(netcx.zped), cimagl(netcx.zped), creall(ymit), cimagl(ymit), pwr );
+ }
+
+ if( ntsc != 0)
+ {
+ for( i = 0; i < ntsc; i++ )
+ {
+ irow1= ntsca[i]-1;
+ vlt= vsrc[i];
+ cux= einc[irow1]* data.wlam;
+ ymit= cux/ vlt;
+ netcx.zped= vlt/ cux;
+ irow2= data.itag[irow1];
+ pwr=.5* creall( vlt* conjl( cux));
+ netcx.pnls= netcx.pnls- pwr;
+
+ if( netcx.nprint == 0)
+ fprintf( output_fp, "\n"
+ " %4d %5d %11.4LE %11.4LE %11.4LE %11.4LE"
+ " %11.4LE %11.4LE %11.4LE %11.4LE %11.4LE",
+ irow2, irow1+1, creall(vlt), cimagl(vlt), creall(cux), cimagl(cux),
+ creall(netcx.zped), cimagl(netcx.zped), creall(ymit), cimagl(ymit), pwr );
+
+ } /* for( i = 0; i < ntsc; i++ ) */
+
+ } /* if( ntsc != 0) */
+
+ } /* if( netcx.nonet != 0) */
+ else
+ {
+ /* solve for currents when no networks are present */
+ solves( cm, ip, einc, netcx.neq, 1, data.np, data.n, data.mp, data.m);
+ cabc( einc);
+ ntsc=0;
+ }
+
+ if( (vsorc.nsant+vsorc.nvqd) == 0)
+ return;
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "--------- ANTENNA INPUT PARAMETERS ---------" );
+
+ fprintf( output_fp, "\n"
+ " TAG SEG VOLTAGE (VOLTS) "
+ "CURRENT (AMPS) IMPEDANCE (OHMS) "
+ " ADMITTANCE (MHOS) POWER\n"
+ " No: No: REAL IMAGINARY"
+ " REAL IMAGINARY REAL "
+ "IMAGINARY REAL IMAGINARY (WATTS)" );
+
+ if( vsorc.nsant != 0)
+ {
+ for( i = 0; i < vsorc.nsant; i++ )
+ {
+ isc1= vsorc.isant[i]-1;
+ vlt= vsorc.vsant[i];
+
+ if( ntsc == 0)
+ {
+ cux= einc[isc1]* data.wlam;
+ irow1=0;
+ }
+ else
+ {
+ for( j = 0; j < ntsc; j++ )
+ if( ntsca[j] == isc1+1)
+ break;
+
+ irow1= ndimn- (j+1);
+ cux= rhnx[irow1];
+ for( j = 0; j < nteq; j++ )
+ cux -= cmn[j+irow1*ndimn]*rhnt[j];
+ cux=(einc[isc1]+ cux)* data.wlam;
+ irow1++;
+
+ } /* if( ntsc == 0) */
+
+ ymit= cux/ vlt;
+ netcx.zped= vlt/ cux;
+ pwr=.5* creall( vlt* conjl( cux));
+ netcx.pin= netcx.pin+ pwr;
+
+ if( irow1 != 0)
+ netcx.pnls= netcx.pnls+ pwr;
+
+ irow2= data.itag[isc1];
+ fprintf( output_fp, "\n"
+ " %4d %5d %11.4LE %11.4LE %11.4LE %11.4LE"
+ " %11.4LE %11.4LE %11.4LE %11.4LE %11.4LE",
+ irow2, isc1+1, creall(vlt), cimagl(vlt), creall(cux), cimagl(cux),
+ creall(netcx.zped), cimagl(netcx.zped), creall(ymit), cimagl(ymit), pwr );
+
+ } /* for( i = 0; i < vsorc.nsant; i++ ) */
+
+ } /* if( vsorc.nsant != 0) */
+
+ if( vsorc.nvqd == 0)
+ return;
+
+ for( i = 0; i < vsorc.nvqd; i++ )
+ {
+ isc1= vsorc.ivqd[i]-1;
+ vlt= vsorc.vqd[i];
+ cux= cmplx( crnt.air[isc1], crnt.aii[isc1]);
+ ymit= cmplx( crnt.bir[isc1], crnt.bii[isc1]);
+ netcx.zped= cmplx( crnt.cir[isc1], crnt.cii[isc1]);
+ pwr= data.si[isc1]* TP*.5;
+ cux=( cux- ymit* sinl( pwr)+ netcx.zped* cosl( pwr))* data.wlam;
+ ymit= cux/ vlt;
+ netcx.zped= vlt/ cux;
+ pwr=.5* creall( vlt* conjl( cux));
+ netcx.pin= netcx.pin+ pwr;
+ irow2= data.itag[isc1];
+
+ fprintf( output_fp, "\n"
+ " %4d %5d %11.4LE %11.4LE %11.4LE %11.4LE"
+ " %11.4LE %11.4LE %11.4LE %11.4LE %11.4LE",
+ irow2, isc1+1, creall(vlt), cimagl(vlt), creall(cux), cimagl(cux),
+ creall(netcx.zped), cimagl(netcx.zped), creall(ymit), cimagl(ymit), pwr );
+
+ } /* for( i = 0; i < vsorc.nvqd; i++ ) */
+
+ /* Free network buffers */
+ free_ptr( (void *)&ipnt );
+ free_ptr( (void *)&nteqa );
+ free_ptr( (void *)&ntsca );
+ free_ptr( (void *)&vsrc );
+ free_ptr( (void *)&rhs );
+ free_ptr( (void *)&cmn );
+ free_ptr( (void *)&rhnt );
+ free_ptr( (void *)&rhnx );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/radiation.c b/radiation.c
new file mode 100644
index 0000000..0a3a7a0
--- /dev/null
+++ b/radiation.c
@@ -0,0 +1,1043 @@
+/*** Translated to the C language by N. Kyriazis 20 Aug 2003 ***
+
+ Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14,
+ tape15,tape16,tape20,tape21)
+
+ Numerical Electromagnetics Code (NEC2) developed at Lawrence
+ Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414
+ for problems with the NEC code. For problems with the vax implem-
+ entation, contact J. Breakall at 415-422-8196 or E. Domning at 415
+ 422-5936)
+ file created 4/11/80.
+
+ ***********Notice**********
+ This computer code material was prepared as an account of work
+ sponsored by the United States government. Neither the United
+ States nor the United States Department Of Energy, nor any of
+ their employees, nor any of their contractors, subcontractors,
+ or their employees, makes any warranty, express or implied, or
+ assumes any legal liability or responsibility for the accuracy,
+ completeness or usefulness of any information, apparatus, product
+ or process disclosed, or represents that its use would not infringe
+ privately-owned rights.
+
+ ******************************************************************/
+
+#include "nec2c.h"
+
+/* common /data/ */
+extern data_t data;
+
+/* common /gnd/ */
+extern gnd_t gnd;
+
+/* common /crnt/ */
+extern crnt_t crnt;
+
+/* common /gwav/ */
+extern gwav_t gwav;
+
+/* common /fpat/ */
+extern fpat_t fpat;
+
+/* pointers to input/output files */
+extern FILE *input_fp, *output_fp, *plot_fp;
+
+/* common /save/ */
+extern save_t save;
+
+/* common /plot/ */
+extern plot_t plot;
+
+
+/*-----------------------------------------------------------------------*/
+
+/* ffld calculates the far zone radiated electric fields, */
+/* the factor exp(j*k*r)/(r/lamda) not included */
+void ffld( long double thet, long double phi,
+ complex long double *eth, complex long double *eph )
+{
+ int k, i, ip, jump;
+ long double phx, phy, roz, rozs, thx, thy, thz, rox, roy;
+ long double tthet=0., darg=0., omega, el, sill, top, bot, a;
+ long double too, boo, b, c, d, rr, ri, arg, dr, rfl, rrz;
+ complex long double cix=CPLX_00, ciy=CPLX_00, ciz=CPLX_00;
+ complex long double exa, ccx=CPLX_00, ccy=CPLX_00, ccz=CPLX_00, cdp;
+ complex long double zrsin, rrv=CPLX_00, rrh=CPLX_00, rrv1=CPLX_00;
+ complex long double rrh1=CPLX_00, rrv2=CPLX_00, rrh2=CPLX_00;
+ complex long double tix, tiy, tiz, zscrn, ex=CPLX_00, ey=CPLX_00, ez=CPLX_00, gx, gy, gz;
+
+ phx=- sinl( phi);
+ phy= cosl( phi);
+ roz= cosl( thet);
+ rozs= roz;
+ thx= roz* phy;
+ thy=- roz* phx;
+ thz=- sinl( thet);
+ rox=- thz* phy;
+ roy= thz* phx;
+
+ jump = FALSE;
+ if( data.n != 0)
+ {
+ /* loop for structure image if any */
+ /* calculation of reflection coeffecients */
+ for( k = 0; k < gnd.ksymp; k++ )
+ {
+ if( k != 0 )
+ {
+ /* for perfect ground */
+ if( gnd.iperf == 1)
+ {
+ rrv=-CPLX_10;
+ rrh=-CPLX_10;
+ }
+ else
+ {
+ /* for infinite planar ground */
+ zrsin= csqrtl(1.- gnd.zrati* gnd.zrati* thz* thz);
+ rrv=-( roz- gnd.zrati* zrsin)/( roz+ gnd.zrati* zrsin);
+ rrh=( gnd.zrati* roz- zrsin)/( gnd.zrati* roz+ zrsin);
+
+ } /* if( gnd.iperf == 1) */
+
+ /* for the cliff problem, two reflction coefficients calculated */
+ if( gnd.ifar > 1)
+ {
+ rrv1= rrv;
+ rrh1= rrh;
+ tthet= tanl( thet);
+
+ if( gnd.ifar != 4)
+ {
+ zrsin= csqrtl(1.- gnd.zrati2* gnd.zrati2* thz* thz);
+ rrv2=-( roz- gnd.zrati2* zrsin)/( roz+ gnd.zrati2* zrsin);
+ rrh2=( gnd.zrati2* roz- zrsin)/( gnd.zrati2* roz+ zrsin);
+ darg=- TP*2.* gnd.ch* roz;
+ }
+ } /* if( gnd.ifar > 1) */
+
+ roz=- roz;
+ ccx= cix;
+ ccy= ciy;
+ ccz= ciz;
+
+ } /* if( k != 0 ) */
+
+ cix=CPLX_00;
+ ciy=CPLX_00;
+ ciz=CPLX_00;
+
+ /* loop over structure segments */
+ for( i = 0; i < data.n; i++ )
+ {
+ omega=-( rox* data.cab[i]+ roy* data.sab[i]+ roz* data.salp[i]);
+ el= PI* data.si[i];
+ sill= omega* el;
+ top= el+ sill;
+ bot= el- sill;
+
+ if( fabsl( omega) >= 1.0e-7)
+ a=2.* sinl( sill)/ omega;
+ else
+ a=(2.- omega* omega* el* el/3.)* el;
+
+ if( fabsl( top) >= 1.0e-7)
+ too= sinl( top)/ top;
+ else
+ too=1.- top* top/6.;
+
+ if( fabsl( bot) >= 1.0e-7)
+ boo= sinl( bot)/ bot;
+ else
+ boo=1.- bot* bot/6.;
+
+ b= el*( boo- too);
+ c= el*( boo+ too);
+ rr= a* crnt.air[i]+ b* crnt.bii[i]+ c* crnt.cir[i];
+ ri= a* crnt.aii[i]- b* crnt.bir[i]+ c* crnt.cii[i];
+ arg= TP*( data.x[i]* rox+ data.y[i]* roy+ data.z[i]* roz);
+
+ if( (k != 1) || (gnd.ifar < 2) )
+ {
+ /* summation for far field integral */
+ exa= cmplx( cosl( arg), sinl( arg))* cmplx( rr, ri);
+ cix= cix+ exa* data.cab[i];
+ ciy= ciy+ exa* data.sab[i];
+ ciz= ciz+ exa* data.salp[i];
+ continue;
+ }
+
+ /* calculation of image contribution */
+ /* in cliff and ground screen problems */
+
+ /* specular point distance */
+ dr= data.z[i]* tthet;
+
+ d= dr* phy+ data.x[i];
+ if( gnd.ifar == 2)
+ {
+ if(( gnd.cl- d) > 0.)
+ {
+ rrv= rrv1;
+ rrh= rrh1;
+ }
+ else
+ {
+ rrv= rrv2;
+ rrh= rrh2;
+ arg= arg+ darg;
+ }
+ } /* if( gnd.ifar == 2) */
+ else
+ {
+ d= sqrtl( d*d + (data.y[i]-dr*phx)*(data.y[i]-dr*phx) );
+ if( gnd.ifar == 3)
+ {
+ if(( gnd.cl- d) > 0.)
+ {
+ rrv= rrv1;
+ rrh= rrh1;
+ }
+ else
+ {
+ rrv= rrv2;
+ rrh= rrh2;
+ arg= arg+ darg;
+ }
+ } /* if( gnd.ifar == 3) */
+ else
+ {
+ if(( gnd.scrwl- d) >= 0.)
+ {
+ /* radial wire ground screen reflection coefficient */
+ d= d+ gnd.t2;
+ zscrn= gnd.t1* d* logl( d/ gnd.t2);
+ zscrn=( zscrn* gnd.zrati)/( ETA* gnd.zrati+ zscrn);
+ zrsin= csqrtl(1.- zscrn* zscrn* thz* thz);
+ rrv=( roz+ zscrn* zrsin)/(- roz+ zscrn* zrsin);
+ rrh=( zscrn* roz+ zrsin)/( zscrn* roz- zrsin);
+ } /* if(( gnd.scrwl- d) < 0.) */
+ else
+ {
+ if( gnd.ifar == 4)
+ {
+ rrv= rrv1;
+ rrh= rrh1;
+ } /* if( gnd.ifar == 4) */
+ else
+ {
+ if( gnd.ifar == 5)
+ d= dr* phy+ data.x[i];
+
+ if(( gnd.cl- d) > 0.)
+ {
+ rrv= rrv1;
+ rrh= rrh1;
+ }
+ else
+ {
+ rrv= rrv2;
+ rrh= rrh2;
+ arg= arg+ darg;
+ } /* if(( gnd.cl- d) > 0.) */
+
+ } /* if( gnd.ifar == 4) */
+
+ } /* if(( gnd.scrwl- d) < 0.) */
+
+ } /* if( gnd.ifar == 3) */
+
+ } /* if( gnd.ifar == 2) */
+
+ /* contribution of each image segment modified by */
+ /* reflection coef, for cliff and ground screen problems */
+ exa= cmplx( cosl( arg), sinl( arg))* cmplx( rr, ri);
+ tix= exa* data.cab[i];
+ tiy= exa* data.sab[i];
+ tiz= exa* data.salp[i];
+ cdp=( tix* phx+ tiy* phy)*( rrh- rrv);
+ cix= cix+ tix* rrv+ cdp* phx;
+ ciy= ciy+ tiy* rrv+ cdp* phy;
+ ciz= ciz- tiz* rrv;
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ if( k == 0 )
+ continue;
+
+ /* calculation of contribution of structure image for infinite ground */
+ if( gnd.ifar < 2)
+ {
+ cdp=( cix* phx+ ciy* phy)*( rrh- rrv);
+ cix= ccx+ cix* rrv+ cdp* phx;
+ ciy= ccy+ ciy* rrv+ cdp* phy;
+ ciz= ccz- ciz* rrv;
+ }
+ else
+ {
+ cix= cix+ ccx;
+ ciy= ciy+ ccy;
+ ciz= ciz+ ccz;
+ }
+
+ } /* for( k=0; k < gnd.ksymp; k++ ) */
+
+ if( data.m > 0)
+ jump = TRUE;
+ else
+ {
+ *eth=( cix* thx+ ciy* thy+ ciz* thz)* CONST3;
+ *eph=( cix* phx+ ciy* phy)* CONST3;
+ return;
+ }
+
+ } /* if( n != 0) */
+
+ if( ! jump )
+ {
+ cix=CPLX_00;
+ ciy=CPLX_00;
+ ciz=CPLX_00;
+ }
+
+ /* electric field components */
+ roz= rozs;
+ rfl=-1.;
+ for( ip = 0; ip < gnd.ksymp; ip++ )
+ {
+ rfl=- rfl;
+ rrz= roz* rfl;
+ fflds( rox, roy, rrz, &crnt.cur[data.n], &gx, &gy, &gz);
+
+ if( ip != 1 )
+ {
+ ex= gx;
+ ey= gy;
+ ez= gz;
+ continue;
+ }
+
+ if( gnd.iperf == 1)
+ {
+ gx=- gx;
+ gy=- gy;
+ gz=- gz;
+ }
+ else
+ {
+ rrv= csqrtl(1.- gnd.zrati* gnd.zrati* thz* thz);
+ rrh= gnd.zrati* roz;
+ rrh=( rrh- rrv)/( rrh+ rrv);
+ rrv= gnd.zrati* rrv;
+ rrv=-( roz- rrv)/( roz+ rrv);
+ *eth=( gx* phx+ gy* phy)*( rrh- rrv);
+ gx= gx* rrv+ *eth* phx;
+ gy= gy* rrv+ *eth* phy;
+ gz= gz* rrv;
+
+ } /* if( gnd.iperf == 1) */
+
+ ex= ex+ gx;
+ ey= ey+ gy;
+ ez= ez- gz;
+
+ } /* for( ip = 0; ip < gnd.ksymp; ip++ ) */
+
+ ex= ex+ cix* CONST3;
+ ey= ey+ ciy* CONST3;
+ ez= ez+ ciz* CONST3;
+ *eth= ex* thx+ ey* thy+ ez* thz;
+ *eph= ex* phx+ ey* phy;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* calculates the xyz components of the electric */
+/* field due to surface currents */
+void fflds( long double rox, long double roy, long double roz,
+ complex long double *scur, complex long double *ex,
+ complex long double *ey, complex long double *ez )
+{
+ long double *xs, *ys, *zs, *s;
+ int j, i, k;
+ long double arg;
+ complex long double ct;
+
+ xs = data.px;
+ ys = data.py;
+ zs = data.pz;
+ s = data.pbi;
+
+ *ex=CPLX_00;
+ *ey=CPLX_00;
+ *ez=CPLX_00;
+
+ i= -1;
+ for( j = 0; j < data.m; j++ )
+ {
+ i++;
+ arg= TP*( rox* xs[i]+ roy* ys[i]+ roz* zs[i]);
+ ct= cmplx( cosl( arg)* s[i], sinl( arg)* s[i]);
+ k=3*j;
+ *ex += scur[k ]* ct;
+ *ey += scur[k+1]* ct;
+ *ez += scur[k+2]* ct;
+ }
+
+ ct= rox* *ex+ roy* *ey+ roz* *ez;
+ *ex= CONST4*( ct* rox- *ex);
+ *ey= CONST4*( ct* roy- *ey);
+ *ez= CONST4*( ct* roz- *ez);
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* gfld computes the radiated field including ground wave. */
+void gfld( long double rho, long double phi, long double rz,
+ complex long double *eth, complex long double *epi,
+ complex long double *erd, complex long double ux, int ksymp )
+{
+ int i, k;
+ long double b, r, thet, arg, phx, phy, rx, ry, dx, dy, dz, rix, riy, rhs, rhp;
+ long double rhx, rhy, calp, cbet, sbet, cph, sph, el, rfl, riz, thx, thy, thz;
+ long double rxyz, rnx, rny, rnz, omega, sill, top, bot, a, too, boo, c, rr, ri;
+ complex long double cix, ciy, ciz, exa, erv;
+ complex long double ezv, erh, eph, ezh, ex, ey;
+
+ r= sqrtl( rho*rho+ rz*rz );
+ if( (ksymp == 1) || (cabs(ux) > .5) || (r > 1.e5) )
+ {
+ /* computation of space wave only */
+ if( rz >= 1.0e-20)
+ thet= atanl( rho/ rz);
+ else
+ thet= PI*.5;
+
+ ffld( thet, phi, eth, epi);
+ arg=- TP* r;
+ exa= cmplx( cosl( arg), sinl( arg))/ r;
+ *eth= *eth* exa;
+ *epi= *epi* exa;
+ *erd=CPLX_00;
+ return;
+ } /* if( (ksymp == 1) && (cabs(ux) > .5) && (r > 1.e5) ) */
+
+ /* computation of space and ground waves. */
+ gwav.u= ux;
+ gwav.u2= gwav.u* gwav.u;
+ phx=- sinl( phi);
+ phy= cosl( phi);
+ rx= rho* phy;
+ ry=- rho* phx;
+ cix=CPLX_00;
+ ciy=CPLX_00;
+ ciz=CPLX_00;
+
+ /* summation of field from individual segments */
+ for( i = 0; i < data.n; i++ )
+ {
+ dx= data.cab[i];
+ dy= data.sab[i];
+ dz= data.salp[i];
+ rix= rx- data.x[i];
+ riy= ry- data.y[i];
+ rhs= rix* rix+ riy* riy;
+ rhp= sqrtl( rhs);
+
+ if( rhp >= 1.0e-6)
+ {
+ rhx= rix/ rhp;
+ rhy= riy/ rhp;
+ }
+ else
+ {
+ rhx=1.;
+ rhy=0.;
+ }
+
+ calp=1.- dz* dz;
+ if( calp >= 1.0e-6)
+ {
+ calp= sqrtl( calp);
+ cbet= dx/ calp;
+ sbet= dy/ calp;
+ cph= rhx* cbet+ rhy* sbet;
+ sph= rhy* cbet- rhx* sbet;
+ }
+ else
+ {
+ cph= rhx;
+ sph= rhy;
+ }
+
+ el= PI* data.si[i];
+ rfl=-1.;
+
+ /* integration of (current)*(phase factor) over segment and image for */
+ /* constant, sine, and cosine current distributions */
+ for( k = 0; k < 2; k++ )
+ {
+ rfl=- rfl;
+ riz= rz- data.z[i]* rfl;
+ rxyz= sqrtl( rix* rix+ riy* riy+ riz* riz);
+ rnx= rix/ rxyz;
+ rny= riy/ rxyz;
+ rnz= riz/ rxyz;
+ omega=-( rnx* dx+ rny* dy+ rnz* dz* rfl);
+ sill= omega* el;
+ top= el+ sill;
+ bot= el- sill;
+
+ if( fabsl( omega) >= 1.0e-7)
+ a=2.* sinl( sill)/ omega;
+ else
+ a=(2.- omega* omega* el* el/3.)* el;
+
+ if( fabsl( top) >= 1.0e-7)
+ too= sinl( top)/ top;
+ else
+ too=1.- top* top/6.;
+
+ if( fabsl( bot) >= 1.0e-7)
+ boo= sinl( bot)/ bot;
+ else
+ boo=1.- bot* bot/6.;
+
+ b= el*( boo- too);
+ c= el*( boo+ too);
+ rr= a* crnt.air[i]+ b* crnt.bii[i]+ c* crnt.cir[i];
+ ri= a* crnt.aii[i]- b* crnt.bir[i]+ c* crnt.cii[i];
+ arg= TP*( data.x[i]* rnx+ data.y[i]* rny+ data.z[i]* rnz* rfl);
+ exa= cmplx( cosl( arg), sinl( arg))* cmplx( rr, ri)/ TP;
+
+ if( k != 1 )
+ {
+ gwav.xx1= exa;
+ gwav.r1= rxyz;
+ gwav.zmh= riz;
+ continue;
+ }
+
+ gwav.xx2= exa;
+ gwav.r2= rxyz;
+ gwav.zph= riz;
+
+ } /* for( k = 0; k < 2; k++ ) */
+
+ /* call subroutine to compute the field */
+ /* of segment including ground wave. */
+ gwave( &erv, &ezv, &erh, &ezh, &eph);
+ erh= erh* cph* calp+ erv* dz;
+ eph= eph* sph* calp;
+ ezh= ezh* cph* calp+ ezv* dz;
+ ex= erh* rhx- eph* rhy;
+ ey= erh* rhy+ eph* rhx;
+ cix= cix+ ex;
+ ciy= ciy+ ey;
+ ciz= ciz+ ezh;
+
+ } /* for( i = 0; i < n; i++ ) */
+
+ arg=- TP* r;
+ exa= cmplx( cosl( arg), sinl( arg));
+ cix= cix* exa;
+ ciy= ciy* exa;
+ ciz= ciz* exa;
+ rnx= rx/ r;
+ rny= ry/ r;
+ rnz= rz/ r;
+ thx= rnz* phy;
+ thy=- rnz* phx;
+ thz=- rho/ r;
+ *eth= cix* thx+ ciy* thy+ ciz* thz;
+ *epi= cix* phx+ ciy* phy;
+ *erd= cix* rnx+ ciy* rny+ ciz* rnz;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute radiation pattern, gain, normalized gain */
+void rdpat( void )
+{
+ char *hpol[3] = { "LINEAR", "RIGHT ", "LEFT " };
+ char *igtp[2] = { "----- POWER GAINS ----- ", "--- DIRECTIVE GAINS ---" };
+ char *igax[4] = { " MAJOR", " MINOR", " VERTC", " HORIZ" };
+ char *igntp[5] = { " MAJOR AXIS", " MINOR AXIS",
+ " VERTICAL", " HORIZONTAL", " TOTAL " };
+
+ char *hclif=NULL, *isens;
+ int i, j, jump, itmp1, itmp2, kth, kph, itmp3, itmp4;
+ long double exrm=0., exra=0., prad, gcon, gcop, gmax, pint, tmp1, tmp2;
+ long double phi, pha, thet, tha, erdm=0., erda=0., ethm2, ethm, *gain = NULL;
+ long double etha, ephm2, ephm, epha, tilta, emajr2, eminr2, axrat;
+ long double dfaz, dfaz2, cdfaz, tstor1=0., tstor2, stilta, gnmj;
+ long double gnmn, gnv, gnh, gtot, tmp3, tmp4, da, tmp5, tmp6;
+ complex long double eth, eph, erd;
+
+ /* Allocate memory to gain buffer */
+ if( fpat.inor > 0 )
+ mem_alloc( (void *)&gain, fpat.nth*fpat.nph * sizeof(long double) );
+
+ if( gnd.ifar > 1)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "------ FAR FIELD GROUND PARAMETERS ------\n\n" );
+
+ jump = FALSE;
+ if( gnd.ifar > 3)
+ {
+ fprintf( output_fp, "\n"
+ " "
+ "--- RADIAL WIRE GROUND SCREEN ---\n"
+ " "
+ "NUM OF WIRES= %d\n"
+ " "
+ "WIRE LENGTH= %8.2LF METERS\n"
+ " "
+ "WIRE RADIUS= %10.3LE METERS",
+ gnd.nradl, save.scrwlt, save.scrwrt );
+
+ if( gnd.ifar == 4)
+ jump = TRUE;
+
+ } /* if( gnd.ifar > 3) */
+
+ if( ! jump )
+ {
+ if( (gnd.ifar == 2) || (gnd.ifar == 5) )
+ hclif= "LINEAR";
+ if( (gnd.ifar == 3) || (gnd.ifar == 6) )
+ hclif= "CIRCULAR";
+
+ gnd.cl= fpat.clt/ data.wlam;
+ gnd.ch= fpat.cht/ data.wlam;
+ gnd.zrati2= csqrtl(1./ cmplx( fpat.epsr2,- fpat.sig2* data.wlam*59.96));
+
+ fprintf( output_fp, "\n"
+ " "
+ "--- %s CLIFF ---\n"
+ " "
+ "EDGE DISTANCE= %9.2LF METERS\n"
+ " "
+ " HEIGHT= %9.2LF METERS\n"
+ " "
+ "--- SECOND MEDIUM ---\n"
+ " "
+ "RELATIVE DIELECTRIC CONST= %10.3LF\n"
+ " "
+ " GROUND CONDUCTIVITY= %10.3LF MHOS",
+ hclif, fpat.clt, fpat.cht, fpat.epsr2, fpat.sig2 );
+
+ } /* if( ! jump ) */
+
+ } /* if( gnd.ifar > 1) */
+
+ if( gnd.ifar == 1)
+ {
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "------- RADIATED FIELDS NEAR GROUND --------\n\n"
+ " ------- LOCATION ------- --- E(THETA) --- "
+ " ---- E(PHI) ---- --- E(RADIAL) ---\n"
+ " RHO PHI Z MAG PHASE "
+ " MAG PHASE MAG PHASE\n"
+ " METERS DEGREES METERS VOLTS/M DEGREES "
+ " VOLTS/M DEGREES VOLTS/M DEGREES" );
+ }
+ else
+ {
+ itmp1=2* fpat.iax;
+ itmp2= itmp1+1;
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ "---------- RADIATION PATTERNS -----------\n" );
+
+ if( fpat.rfld >= 1.0e-20)
+ {
+ exrm=1./ fpat.rfld;
+ exra= fpat.rfld/ data.wlam;
+ exra=-360.*( exra- floorl( exra));
+
+ fprintf( output_fp, "\n"
+ " "
+ "RANGE: %13.6LE METERS\n"
+ " "
+ "EXP(-JKR)/R: %12.5LE AT PHASE: %7.2LF DEGREES\n",
+ fpat.rfld, exrm, exra );
+ }
+
+ fprintf( output_fp, "\n"
+ " ---- ANGLES ----- %23s ---- POLARIZATION ---- "
+ " ---- E(THETA) ---- ----- E(PHI) ------\n"
+ " THETA PHI %6s %6s TOTAL AXIAL "
+ " TILT SENSE MAGNITUDE PHASE MAGNITUDE PHASE\n"
+ " DEGREES DEGREES DB DB DB RATIO "
+ " DEGREES VOLTS/M DEGREES VOLTS/M DEGREES",
+ igtp[fpat.ipd], igax[itmp1], igax[itmp2] );
+
+ } /* if( gnd.ifar == 1) */
+
+ if( (fpat.ixtyp == 0) || (fpat.ixtyp == 5) )
+ {
+ gcop= data.wlam* data.wlam*2.* PI/(376.73* fpat.pinr);
+ prad= fpat.pinr- fpat.ploss- fpat.pnlr;
+ gcon= gcop;
+ if( fpat.ipd != 0)
+ gcon= gcon* fpat.pinr/ prad;
+ }
+ else
+ if( fpat.ixtyp == 4)
+ {
+ fpat.pinr=394.51* fpat.xpr6* fpat.xpr6* data.wlam* data.wlam;
+ gcop= data.wlam* data.wlam*2.* PI/(376.73* fpat.pinr);
+ prad= fpat.pinr- fpat.ploss- fpat.pnlr;
+ gcon= gcop;
+ if( fpat.ipd != 0)
+ gcon= gcon* fpat.pinr/ prad;
+ }
+ else
+ {
+ prad=0.;
+ gcon=4.* PI/(1.+ fpat.xpr6* fpat.xpr6);
+ gcop= gcon;
+ }
+
+ i=0;
+ gmax=-1.e+10;
+ pint=0.;
+ tmp1= fpat.dph* TA;
+ tmp2=.5* fpat.dth* TA;
+ phi= fpat.phis- fpat.dph;
+
+ for( kph = 1; kph <= fpat.nph; kph++ )
+ {
+ phi += fpat.dph;
+ pha= phi* TA;
+ thet= fpat.thets- fpat.dth;
+
+ for( kth = 1; kth <= fpat.nth; kth++ )
+ {
+ thet += fpat.dth;
+ if( (gnd.ksymp == 2) && (thet > 90.01) && (gnd.ifar != 1) )
+ continue;
+
+ tha= thet* TA;
+ if( gnd.ifar != 1)
+ ffld( tha, pha, ð, &eph);
+ else
+ {
+ gfld( fpat.rfld/data.wlam, pha, thet/data.wlam,
+ ð, &eph, &erd, gnd.zrati, gnd.ksymp);
+ erdm= cabs( erd);
+ erda= cang( erd);
+ }
+
+ ethm2= creal( eth* conjl( eth));
+ ethm= sqrtl( ethm2);
+ etha= cang( eth);
+ ephm2= creal( eph* conjl( eph));
+ ephm= sqrtl( ephm2);
+ epha= cang( eph);
+
+ /* elliptical polarization calc. */
+ if( gnd.ifar != 1)
+ {
+ if( (ethm2 <= 1.0e-20) && (ephm2 <= 1.0e-20) )
+ {
+ tilta=0.;
+ emajr2=0.;
+ eminr2=0.;
+ axrat=0.;
+ isens= " ";
+ }
+ else
+ {
+ dfaz= epha- etha;
+ if( epha >= 0.)
+ dfaz2= dfaz-360.;
+ else
+ dfaz2= dfaz+360.;
+
+ if( fabsl(dfaz) > fabsl(dfaz2) )
+ dfaz= dfaz2;
+
+ cdfaz= cosl( dfaz* TA);
+ tstor1= ethm2- ephm2;
+ tstor2=2.* ephm* ethm* cdfaz;
+ tilta=.5* atan2l( tstor2, tstor1);
+ stilta= sinl( tilta);
+ tstor1= tstor1* stilta* stilta;
+ tstor2= tstor2* stilta* cosl( tilta);
+ emajr2=- tstor1+ tstor2+ ethm2;
+ eminr2= tstor1- tstor2+ ephm2;
+ if( eminr2 < 0.)
+ eminr2=0.;
+
+ axrat= sqrtl( eminr2/ emajr2);
+ tilta= tilta* TD;
+ if( axrat <= 1.0e-5)
+ isens= hpol[0];
+ else
+ if( dfaz <= 0.)
+ isens= hpol[1];
+ else
+ isens= hpol[2];
+
+ } /* if( (ethm2 <= 1.0e-20) && (ephm2 <= 1.0e-20) ) */
+
+ gnmj= db10( gcon* emajr2);
+ gnmn= db10( gcon* eminr2);
+ gnv = db10( gcon* ethm2);
+ gnh = db10( gcon* ephm2);
+ gtot= db10( gcon*(ethm2+ ephm2) );
+
+ if( fpat.inor > 0)
+ {
+ i++;
+ switch( fpat.inor )
+ {
+ case 1:
+ tstor1= gnmj;
+ break;
+
+ case 2:
+ tstor1= gnmn;
+ break;
+
+ case 3:
+ tstor1= gnv;
+ break;
+
+ case 4:
+ tstor1= gnh;
+ break;
+
+ case 5:
+ tstor1= gtot;
+ }
+
+ gain[i-1]= tstor1;
+ if( tstor1 > gmax)
+ gmax= tstor1;
+
+ } /* if( fpat.inor > 0) */
+
+ if( fpat.iavp != 0)
+ {
+ tstor1= gcop*( ethm2+ ephm2);
+ tmp3= tha- tmp2;
+ tmp4= tha+ tmp2;
+
+ if( kth == 1)
+ tmp3= tha;
+ else
+ if( kth == fpat.nth)
+ tmp4= tha;
+
+ da= fabsl( tmp1*( cosl( tmp3)- cosl( tmp4)));
+ if( (kph == 1) || (kph == fpat.nph) )
+ da *=.5;
+ pint += tstor1* da;
+
+ if( fpat.iavp == 2)
+ continue;
+ }
+
+ if( fpat.iax != 1)
+ {
+ tmp5= gnmj;
+ tmp6= gnmn;
+ }
+ else
+ {
+ tmp5= gnv;
+ tmp6= gnh;
+ }
+
+ ethm= ethm* data.wlam;
+ ephm= ephm* data.wlam;
+
+ if( fpat.rfld >= 1.0e-20 )
+ {
+ ethm= ethm* exrm;
+ etha= etha+ exra;
+ ephm= ephm* exrm;
+ epha= epha+ exra;
+ }
+
+ fprintf( output_fp, "\n"
+ " %7.2LF %9.2LF %8.2LF %8.2LF %8.2LF %11.4LF"
+ " %9.2LF %6s %11.4LE %9.2LF %11.4LE %9.2LF",
+ thet, phi, tmp5, tmp6, gtot, axrat,
+ tilta, isens, ethm, etha, ephm, epha );
+
+ if( plot.iplp1 != 3)
+ continue;
+
+ if( plot.iplp3 != 0)
+ {
+ if( plot.iplp2 == 1 )
+ {
+ if( plot.iplp3 == 1 )
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", thet, ethm, etha );
+ else
+ if( plot.iplp3 == 2 )
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", thet, ephm, epha );
+ }
+
+ if( plot.iplp2 == 2 )
+ {
+ if( plot.iplp3 == 1 )
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", phi, ethm, etha );
+ else
+ if( plot.iplp3 == 2 )
+ fprintf( plot_fp, "%12.4LE %12.4LE %12.4LE\n", phi, ephm, epha );
+ }
+ }
+
+ if( plot.iplp4 == 0 )
+ continue;
+
+ if( plot.iplp2 == 1 )
+ {
+ switch( plot.iplp4 )
+ {
+ case 1:
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", thet, tmp5 );
+ break;
+ case 2:
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", thet, tmp6 );
+ break;
+ case 3:
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", thet, gtot );
+ }
+ }
+
+ if( plot.iplp2 == 2 )
+ {
+ switch( plot.iplp4 )
+ {
+ case 1:
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", phi, tmp5 );
+ break;
+ case 2:
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", phi, tmp6 );
+ break;
+ case 3:
+ fprintf( plot_fp, "%12.4LE %12.4LE\n", phi, gtot );
+ }
+ }
+
+ continue;
+ } /* if( gnd.ifar != 1) */
+
+ fprintf( output_fp, "\n"
+ " %9.2LF %7.2LF %9.2LF %11.4LE %7.2LF %11.4LE %7.2LF %11.4LE %7.2LF",
+ fpat.rfld, phi, thet, ethm, etha, ephm, epha, erdm, erda );
+
+ } /* for( kth = 1; kth <= fpat.nth; kth++ ) */
+
+ } /* for( kph = 1; kph <= fpat.nph; kph++ ) */
+
+ if( fpat.iavp != 0)
+ {
+ tmp3= fpat.thets* TA;
+ tmp4= tmp3+ fpat.dth* TA* (long double)( fpat.nth-1);
+ tmp3= fabsl( fpat.dph* TA* (long double)( fpat.nph-1)*( cosl( tmp3)- cosl( tmp4)));
+ pint /= tmp3;
+ tmp3 /= PI;
+
+ fprintf( output_fp, "\n\n\n"
+ " AVERAGE POWER GAIN: %11.4LE - SOLID ANGLE"
+ " USED IN AVERAGING: (%+7.4LF)*PI STERADIANS",
+ pint, tmp3 );
+ }
+
+ if( fpat.inor == 0)
+ return;
+
+ if( fabsl( fpat.gnor) > 1.0e-20)
+ gmax= fpat.gnor;
+ itmp1=( fpat.inor-1);
+
+ fprintf( output_fp, "\n\n\n"
+ " "
+ " ---------- NORMALIZED GAIN ----------\n"
+ " %6s GAIN\n"
+ " "
+ " NORMALIZATION FACTOR: %.2LF db\n\n"
+ " ---- ANGLES ---- ---- ANGLES ----"
+ " ---- ANGLES ----\n"
+ " THETA PHI GAIN THETA PHI "
+ " GAIN THETA PHI GAIN\n"
+ " DEGREES DEGREES DB DEGREES DEGREES "
+ " DB DEGREES DEGREES DB",
+ igntp[itmp1], gmax );
+
+ itmp2= fpat.nph* fpat.nth;
+ itmp1=( itmp2+2)/3;
+ itmp2= itmp1*3- itmp2;
+ itmp3= itmp1;
+ itmp4=2* itmp1;
+
+ if( itmp2 == 2)
+ itmp4--;
+
+ for( i = 0; i < itmp1; i++ )
+ {
+ itmp3++;
+ itmp4++;
+ j= i/ fpat.nth;
+ tmp1= fpat.thets+ (long double)( i - j*fpat.nth )* fpat.dth;
+ tmp2= fpat.phis+ (long double)(j)* fpat.dph;
+ j=( itmp3-1)/ fpat.nth;
+ tmp3= fpat.thets+ (long double)( itmp3- j* fpat.nth-1)* fpat.dth;
+ tmp4= fpat.phis+ (long double)(j)* fpat.dph;
+ j=( itmp4-1)/ fpat.nth;
+ tmp5= fpat.thets+ (long double)( itmp4- j* fpat.nth-1)* fpat.dth;
+ tmp6= fpat.phis+ (long double)(j)* fpat.dph;
+ tstor1= gain[i]- gmax;
+
+ if( ((i+1) == itmp1) && (itmp2 != 0) )
+ {
+ if( itmp2 != 2)
+ {
+ tstor2= gain[itmp3-1]- gmax;
+ fprintf( output_fp, "\n"
+ " %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF ",
+ tmp1, tmp2, tstor1, tmp3, tmp4, tstor2 );
+ return;
+ }
+
+ fprintf( output_fp, "\n"
+ " %9.2LF %9.2LF %9.2LF ",
+ tmp1, tmp2, tstor1 );
+ return;
+
+ } /* if( ((i+1) == itmp1) && (itmp2 != 0) ) */
+
+ tstor2= gain[itmp3-1]- gmax;
+ pint= gain[itmp4-1]- gmax;
+
+ fprintf( output_fp, "\n"
+ " %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF %9.2LF",
+ tmp1, tmp2, tstor1, tmp3, tmp4, tstor2, tmp5, tmp6, pint );
+
+ } /* for( i = 0; i < itmp1; i++ ) */
+
+ free_ptr( (void *)&gain );
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
diff --git a/somnec.c b/somnec.c
new file mode 100644
index 0000000..2614e43
--- /dev/null
+++ b/somnec.c
@@ -0,0 +1,1026 @@
+/* last change: pgm 8 nov 2000 1:04 pm
+ program somnec(input,output,tape21)
+
+ program to generate nec interpolation grids for fields due to
+ ground. field components are computed by numerical evaluation
+ of modified sommerfeld integrals.
+
+ somnec2d is a long double precision version of somnec for use with
+ nec2d. an alternate version (somnec2sd) is also provided in which
+ computation is in single precision but the output file is written
+ in long double precision for use with nec2d. somnec2sd runs about twic
+ as fast as the full long double precision somnec2d. the difference
+ between nec2d results using a for021 file from this code rather
+ than from somnec2sd was insignficant in the cases tested.
+
+ changes made by j bergervoet, 31-5-95:
+ parameter 0. --> 0.d0 in calling of routine test
+ status of output files set to 'unknown' */
+
+#include "nec2c.h"
+
+/* common /evlcom/ */
+static int jh;
+static long double ck2, ck2sq, tkmag, tsmag, ck1r, zph, rho;
+static complex long double ct1, ct2, ct3, ck1, ck1sq, cksm;
+
+/* common /cntour/ */
+static complex long double a, b;
+
+/*common /ggrid/ */
+ggrid_t ggrid;
+
+/*-----------------------------------------------------------------------*/
+
+/* This is the "main" of somnec */
+void somnec( long double epr, long double sig, long double fmhz )
+{
+ int k, nth, ith, irs, ir, nr;
+ long double tim, wlam, tst, dr, dth, r, rk, thet, tfac1, tfac2;
+ complex long double erv, ezv, erh, eph, cl1, cl2, con;
+
+ if(sig >= 0.)
+ {
+ wlam=CVEL/fmhz;
+ ggrid.epscf=cmplx(epr,-sig*wlam*59.96);
+ }
+ else
+ ggrid.epscf=cmplx(epr,sig);
+
+ secnds(&tst);
+ ck2=TP;
+ ck2sq=ck2*ck2;
+
+ /* sommerfeld integral evaluation uses exp(-jwt), nec uses exp(+jwt), */
+ /* hence need conjg(ggrid.epscf). conjugate of fields occurs in subroutine */
+ /* evlua. */
+
+ ck1sq=ck2sq*conj(ggrid.epscf);
+ ck1=csqrtl(ck1sq);
+ ck1r=creal(ck1);
+ tkmag=100.*cabs(ck1);
+ tsmag=100.*ck1*conj(ck1);
+ cksm=ck2sq/(ck1sq+ck2sq);
+ ct1=.5*(ck1sq-ck2sq);
+ erv=ck1sq*ck1sq;
+ ezv=ck2sq*ck2sq;
+ ct2=.125*(erv-ezv);
+ erv *= ck1sq;
+ ezv *= ck2sq;
+ ct3=.0625*(erv-ezv);
+
+ /* loop over 3 grid regions */
+ for( k = 0; k < 3; k++ )
+ {
+ nr=ggrid.nxa[k];
+ nth=ggrid.nya[k];
+ dr=ggrid.dxa[k];
+ dth=ggrid.dya[k];
+ r=ggrid.xsa[k]-dr;
+ irs=1;
+ if(k == 0)
+ {
+ r=ggrid.xsa[k];
+ irs=2;
+ }
+
+ /* loop over r. (r=sqrtl(rho**2 + (z+h)**2)) */
+ for( ir = irs-1; ir < nr; ir++ )
+ {
+ r += dr;
+ thet = ggrid.ysa[k]-dth;
+
+ /* loop over theta. (theta=atan((z+h)/rho)) */
+ for( ith = 0; ith < nth; ith++ )
+ {
+ thet += dth;
+ rho=r*cosl(thet);
+ zph=r*sinl(thet);
+ if(rho < 1.e-7)
+ rho=1.e-8;
+ if(zph < 1.e-7)
+ zph=0.;
+
+ evlua( &erv, &ezv, &erh, &eph );
+
+ rk=ck2*r;
+ con=-CONST1*r/cmplx(cosl(rk),-sinl(rk));
+
+ switch( k )
+ {
+ case 0:
+ ggrid.ar1[ir+ith*11+ 0]=erv*con;
+ ggrid.ar1[ir+ith*11+110]=ezv*con;
+ ggrid.ar1[ir+ith*11+220]=erh*con;
+ ggrid.ar1[ir+ith*11+330]=eph*con;
+ break;
+
+ case 1:
+ ggrid.ar2[ir+ith*17+ 0]=erv*con;
+ ggrid.ar2[ir+ith*17+ 85]=ezv*con;
+ ggrid.ar2[ir+ith*17+170]=erh*con;
+ ggrid.ar2[ir+ith*17+255]=eph*con;
+ break;
+
+ case 2:
+ ggrid.ar3[ir+ith*9+ 0]=erv*con;
+ ggrid.ar3[ir+ith*9+ 72]=ezv*con;
+ ggrid.ar3[ir+ith*9+144]=erh*con;
+ ggrid.ar3[ir+ith*9+216]=eph*con;
+
+ } /* switch( k ) */
+
+ } /* for( ith = 0; ith < nth; ith++ ) */
+
+ } /* for( ir = irs-1; ir < nr; ir++; ) */
+
+ } /* for( k = 0; k < 3; k++; ) */
+
+ /* fill grid 1 for r equal to zero. */
+ cl2=-CONST4*(ggrid.epscf-1.)/(ggrid.epscf+1.);
+ cl1=cl2/(ggrid.epscf+1.);
+ ezv=ggrid.epscf*cl1;
+ thet=-dth;
+ nth=ggrid.nya[0];
+
+ for( ith = 0; ith < nth; ith++ )
+ {
+ thet += dth;
+ if( (ith+1) != nth )
+ {
+ tfac2=cosl(thet);
+ tfac1=(1.-sinl(thet))/tfac2;
+ tfac2=tfac1/tfac2;
+ erv=ggrid.epscf*cl1*tfac1;
+ erh=cl1*(tfac2-1.)+cl2;
+ eph=cl1*tfac2-cl2;
+ }
+ else
+ {
+ erv=0.;
+ erh=cl2-.5*cl1;
+ eph=-erh;
+ }
+
+ ggrid.ar1[0+ith*11+ 0]=erv;
+ ggrid.ar1[0+ith*11+110]=ezv;
+ ggrid.ar1[0+ith*11+220]=erh;
+ ggrid.ar1[0+ith*11+330]=eph;
+ }
+
+ secnds(&tim);
+ tim -= tst;
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* bessel evaluates the zero-order bessel function */
+/* and its derivative for complex argument z. */
+void bessel( complex long double z, complex long double *j0, complex long double *j0p )
+{
+ int k, i, ib, iz, miz;
+ static int m[101], init = FALSE;
+ static long double a1[25], a2[25];
+ long double tst, zms;
+ complex long double p0z, p1z, q0z, q1z, zi, zi2, zk, cz, sz, j0x=CPLX_00, j0px=CPLX_00;
+
+ /* initialization of constants */
+ if( ! init )
+ {
+ for( k = 1; k <= 25; k++ )
+ {
+ i = k-1;
+ a1[i]=-.25/(k*k);
+ a2[i]=1.0/(k+1.0);
+ }
+
+ for( i = 1; i <= 101; i++ )
+ {
+ tst=1.0;
+ for( k = 0; k < 24; k++ )
+ {
+ init = k;
+ tst *= -i*a1[k];
+ if( tst < 1.0e-6 )
+ break;
+ }
+
+ m[i-1] = init+1;
+ } /* for( i = 1; i<= 101; i++ ) */
+
+ init = TRUE;
+ } /* if(init == 0) */
+
+ zms=z*conj(z);
+ if(zms <= 1.e-12)
+ {
+ *j0=CPLX_10;
+ *j0p=-.5*z;
+ return;
+ }
+
+ ib=0;
+ if(zms <= 37.21)
+ {
+ if(zms > 36.)
+ ib=1;
+
+ /* series expansion */
+ iz=zms;
+ miz=m[iz];
+ *j0=CPLX_10;
+ *j0p=*j0;
+ zk=*j0;
+ zi=z*z;
+
+ for( k = 0; k < miz; k++ )
+ {
+ zk *= a1[k]*zi;
+ *j0 += zk;
+ *j0p += a2[k]*zk;
+ }
+ *j0p *= -.5*z;
+
+ if(ib == 0)
+ return;
+
+ j0x=*j0;
+ j0px=*j0p;
+ }
+
+ /* asymptotic expansion */
+ zi=1./z;
+ zi2=zi*zi;
+ p0z=1.+(P20*zi2-P10)*zi2;
+ p1z=1.+(P11-P21*zi2)*zi2;
+ q0z=(Q20*zi2-Q10)*zi;
+ q1z=(Q11-Q21*zi2)*zi;
+ zk=cexp(CPLX_01*(z-POF));
+ zi2=1./zk;
+ cz=.5*(zk+zi2);
+ sz=CPLX_01*.5*(zi2-zk);
+ zk=C3*csqrtl(zi);
+ *j0=zk*(p0z*cz-q0z*sz);
+ *j0p=-zk*(p1z*sz+q1z*cz);
+
+ if(ib == 0)
+ return;
+
+ zms=cosl((sqrtl(zms)-6.)*PI10);
+ *j0=.5*(j0x*(1.+zms)+ *j0*(1.-zms));
+ *j0p=.5*(j0px*(1.+zms)+ *j0p*(1.-zms));
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* evlua controls the integration contour in the complex */
+/* lambda plane for evaluation of the sommerfeld integrals */
+void evlua( complex long double *erv, complex long double *ezv,
+ complex long double *erh, complex long double *eph )
+{
+ int i, jump;
+ static long double del, slope, rmis;
+ static complex long double cp1, cp2, cp3, bk, delta, delta2, sum[6], ans[6];
+
+ del=zph;
+ if( rho > del )
+ del=rho;
+
+ if(zph >= 2.*rho)
+ {
+ /* bessel function form of sommerfeld integrals */
+ jh=0;
+ a=CPLX_00;
+ del=1./del;
+
+ if( del > tkmag)
+ {
+ b=cmplx(.1*tkmag,-.1*tkmag);
+ rom1(6,sum,2);
+ a=b;
+ b=cmplx(del,-del);
+ rom1 (6,ans,2);
+ for( i = 0; i < 6; i++ )
+ sum[i] += ans[i];
+ }
+ else
+ {
+ b=cmplx(del,-del);
+ rom1(6,sum,2);
+ }
+
+ delta=PTP*del;
+ gshank(b,delta,ans,6,sum,0,b,b);
+ ans[5] *= ck1;
+
+ /* conjugate since nec uses exp(+jwt) */
+ *erv=conj(ck1sq*ans[2]);
+ *ezv=conj(ck1sq*(ans[1]+ck2sq*ans[4]));
+ *erh=conj(ck2sq*(ans[0]+ans[5]));
+ *eph=-conj(ck2sq*(ans[3]+ans[5]));
+
+ return;
+
+ } /* if(zph >= 2.*rho) */
+
+ /* hankel function form of sommerfeld integrals */
+ jh=1;
+ cp1=cmplx(0.0,.4*ck2);
+ cp2=cmplx(.6*ck2,-.2*ck2);
+ cp3=cmplx(1.02*ck2,-.2*ck2);
+ a=cp1;
+ b=cp2;
+ rom1(6,sum,2);
+ a=cp2;
+ b=cp3;
+ rom1(6,ans,2);
+
+ for( i = 0; i < 6; i++ )
+ sum[i]=-(sum[i]+ans[i]);
+
+ /* path from imaginary axis to -infinity */
+ if(zph > .001*rho)
+ slope=rho/zph;
+ else
+ slope=1000.;
+
+ del=PTP/del;
+ delta=cmplx(-1.0,slope)*del/sqrtl(1.+slope*slope);
+ delta2=-conj(delta);
+ gshank(cp1,delta,ans,6,sum,0,bk,bk);
+ rmis=rho*(creal(ck1)-ck2);
+
+ jump = FALSE;
+ if( (rmis >= 2.*ck2) && (rho >= 1.e-10) )
+ {
+ if(zph >= 1.e-10)
+ {
+ bk=cmplx(-zph,rho)*(ck1-cp3);
+ rmis=-creal(bk)/fabsl(cimag(bk));
+ if(rmis > 4.*rho/zph)
+ jump = TRUE;
+ }
+
+ if( ! jump )
+ {
+ /* integrate up between branch cuts, then to + infinity */
+ cp1=ck1-(.1+.2fj);
+ cp2=cp1+.2;
+ bk=cmplx(0.,del);
+ gshank(cp1,bk,sum,6,ans,0,bk,bk);
+ a=cp1;
+ b=cp2;
+ rom1(6,ans,1);
+ for( i = 0; i < 6; i++ )
+ ans[i] -= sum[i];
+
+ gshank(cp3,bk,sum,6,ans,0,bk,bk);
+ gshank(cp2,delta2,ans,6,sum,0,bk,bk);
+ }
+
+ jump = TRUE;
+
+ } /* if( (rmis >= 2.*ck2) || (rho >= 1.e-10) ) */
+ else
+ jump = FALSE;
+
+ if( ! jump )
+ {
+ /* integrate below branch points, then to + infinity */
+ for( i = 0; i < 6; i++ )
+ sum[i]=-ans[i];
+
+ rmis=creal(ck1)*1.01;
+ if( (ck2+1.) > rmis )
+ rmis=ck2+1.;
+
+ bk=cmplx(rmis,.99*cimag(ck1));
+ delta=bk-cp3;
+ delta *= del/cabs(delta);
+ gshank(cp3,delta,ans,6,sum,1,bk,delta2);
+
+ } /* if( ! jump ) */
+
+ ans[5] *= ck1;
+
+ /* conjugate since nec uses exp(+jwt) */
+ *erv=conj(ck1sq*ans[2]);
+ *ezv=conj(ck1sq*(ans[1]+ck2sq*ans[4]));
+ *erh=conj(ck2sq*(ans[0]+ans[5]));
+ *eph=-conj(ck2sq*(ans[3]+ans[5]));
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* fbar is sommerfeld attenuation function for numerical distance p */
+void fbar( complex long double p, complex long double *fbar )
+{
+ int i, minus;
+ long double tms, sms;
+ complex long double z, zs, sum, pow, term;
+
+ z= CPLX_01* csqrtl( p);
+ if( cabs( z) <= 3.)
+ {
+ /* series expansion */
+ zs= z* z;
+ sum= z;
+ pow= z;
+
+ for( i = 1; i <= 100; i++ )
+ {
+ pow=- pow* zs/ (long double)i;
+ term= pow/(2.* i+1.);
+ sum= sum+ term;
+ tms= creal( term* conj( term));
+ sms= creal( sum* conj( sum));
+ if( tms/sms < ACCS)
+ break;
+ }
+
+ *fbar=1.-(1.- sum* TOSP)* z* cexp( zs)* SP;
+
+ } /* if( cabs( z) <= 3.) */
+
+ /* asymptotic expansion */
+ if( creal( z) < 0.)
+ {
+ minus=1;
+ z=- z;
+ }
+ else
+ minus=0;
+
+ zs=.5/( z* z);
+ sum=CPLX_00;
+ term=CPLX_10;
+
+ for( i = 1; i <= 6; i++ )
+ {
+ term =- term*(2.*i -1.)* zs;
+ sum += term;
+ }
+
+ if( minus == 1)
+ sum -= 2.* SP* z* cexp( z* z);
+ *fbar=- sum;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* gshank integrates the 6 sommerfeld integrals from start to */
+/* infinity (until convergence) in lambda. at the break point, bk, */
+/* the step increment may be changed from dela to delb. shank's */
+/* algorithm to accelerate convergence of a slowly converging series */
+/* is used */
+void gshank( complex long double start, complex long double dela,
+ complex long double *sum, int nans, complex long double *seed,
+ int ibk, complex long double bk, complex long double delb )
+{
+ int ibx, j, i, jm, intx, inx, brk=0;
+ static long double rbk, amg, den, denm;
+ complex long double a1, a2, as1, as2, del, aa;
+ complex long double q1[6][20], q2[6][20], ans1[6], ans2[6];
+
+ rbk=creal(bk);
+ del=dela;
+ if(ibk == 0)
+ ibx=1;
+ else
+ ibx=0;
+
+ for( i = 0; i < nans; i++ )
+ ans2[i]=seed[i];
+
+ b=start;
+ for( intx = 1; intx <= MAXH; intx++ )
+ {
+ inx=intx-1;
+ a=b;
+ b += del;
+
+ if( (ibx == 0) && (creal(b) >= rbk) )
+ {
+ /* hit break point. reset seed and start over. */
+ ibx=1;
+ b=bk;
+ del=delb;
+ rom1(nans,sum,2);
+ if( ibx != 2 )
+ {
+ for( i = 0; i < nans; i++ )
+ ans2[i] += sum[i];
+ intx = 0;
+ continue;
+ }
+
+ for( i = 0; i < nans; i++ )
+ ans2[i]=ans1[i]+sum[i];
+ intx = 0;
+ continue;
+
+ } /* if( (ibx == 0) && (creal(b) >= rbk) ) */
+
+ rom1(nans,sum,2);
+ for( i = 0; i < nans; i++ )
+ ans1[i] = ans2[i]+sum[i];
+ a=b;
+ b += del;
+
+ if( (ibx == 0) && (creal(b) >= rbk) )
+ {
+ /* hit break point. reset seed and start over. */
+ ibx=2;
+ b=bk;
+ del=delb;
+ rom1(nans,sum,2);
+ if( ibx != 2 )
+ {
+ for( i = 0; i < nans; i++ )
+ ans2[i] += sum[i];
+ intx = 0;
+ continue;
+ }
+
+ for( i = 0; i < nans; i++ )
+ ans2[i] = ans1[i]+sum[i];
+ intx = 0;
+ continue;
+
+ } /* if( (ibx == 0) && (creal(b) >= rbk) ) */
+
+ rom1(nans,sum,2);
+ for( i = 0; i < nans; i++ )
+ ans2[i]=ans1[i]+sum[i];
+
+ den=0.;
+ for( i = 0; i < nans; i++ )
+ {
+ as1=ans1[i];
+ as2=ans2[i];
+
+ if(intx >= 2)
+ {
+ for( j = 1; j < intx; j++ )
+ {
+ jm=j-1;
+ aa=q2[i][jm];
+ a1=q1[i][jm]+as1-2.*aa;
+
+ if( (creal(a1) != 0.) || (cimag(a1) != 0.) )
+ {
+ a2=aa-q1[i][jm];
+ a1=q1[i][jm]-a2*a2/a1;
+ }
+ else
+ a1=q1[i][jm];
+
+ a2=aa+as2-2.*as1;
+ if( (creal(a2) != 0.) || (cimag(a2) != 0.) )
+ a2=aa-(as1-aa)*(as1-aa)/a2;
+ else
+ a2=aa;
+
+ q1[i][jm]=as1;
+ q2[i][jm]=as2;
+ as1=a1;
+ as2=a2;
+
+ } /* for( j = 1; i < intx; i++ ) */
+
+ } /* if(intx >= 2) */
+
+ q1[i][intx-1]=as1;
+ q2[i][intx-1]=as2;
+ amg=fabsl(creal(as2))+fabsl(cimag(as2));
+ if(amg > den)
+ den=amg;
+
+ } /* for( i = 0; i < nans; i++ ) */
+
+ denm=1.e-3*den*CRIT;
+ jm=intx-3;
+ if(jm < 1)
+ jm=1;
+
+ for( j = jm-1; j < intx; j++ )
+ {
+ brk = FALSE;
+ for( i = 0; i < nans; i++ )
+ {
+ a1=q2[i][j];
+ den=(fabsl(creal(a1))+fabsl(cimag(a1)))*CRIT;
+ if(den < denm)
+ den=denm;
+ a1=q1[i][j]-a1;
+ amg=fabsl(creal(a1)+fabsl(cimag(a1)));
+ if(amg > den)
+ {
+ brk = TRUE;
+ break;
+ }
+
+ } /* for( i = 0; i < nans; i++ ) */
+
+ if( brk ) break;
+
+ } /* for( j = jm-1; j < intx; j++ ) */
+
+ if( ! brk )
+ {
+ for( i = 0; i < nans; i++ )
+ sum[i]=.5*(q1[i][inx]+q2[i][inx]);
+ return;
+ }
+
+ } /* for( intx = 1; intx <= maxh; intx++ ) */
+
+ /* No convergence */
+ abort_on_error(-6);
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* hankel evaluates hankel function of the first kind, */
+/* order zero, and its derivative for complex argument z */
+void hankel( complex long double z, complex long double *h0, complex long double *h0p )
+{
+ int i, k, ib, iz, miz;
+ static int m[101], init = FALSE;
+ static long double a1[25], a2[25], a3[25], a4[25], psi, tst, zms;
+ complex long double clogz, j0, j0p, p0z, p1z, q0z, q1z, y0=CPLX_00, y0p=CPLX_00, zi, zi2, zk;
+
+ /* initialization of constants */
+ if( ! init )
+ {
+ psi=-GAMMA;
+ for( k = 1; k <= 25; k++ )
+ {
+ i = k-1;
+ a1[i]=-.25/(k*k);
+ a2[i]=1.0/(k+1.0);
+ psi += 1.0/k;
+ a3[i]=psi+psi;
+ a4[i]=(psi+psi+1.0/(k+1.0))/(k+1.0);
+ }
+
+ for( i = 1; i <= 101; i++ )
+ {
+ tst=1.0;
+ for( k = 0; k < 24; k++ )
+ {
+ init = k;
+ tst *= -i*a1[k];
+ if(tst*a3[k] < 1.e-6)
+ break;
+ }
+ m[i-1]=init+1;
+ }
+
+ init = TRUE;
+
+ } /* if( ! init ) */
+
+ zms=z*conj(z);
+ if(zms == 0.)
+ abort_on_error(-7);
+
+ ib=0;
+ if(zms <= 16.81)
+ {
+ if(zms > 16.)
+ ib=1;
+
+ /* series expansion */
+ iz=zms;
+ miz=m[iz];
+ j0=CPLX_10;
+ j0p=j0;
+ y0=CPLX_00;
+ y0p=y0;
+ zk=j0;
+ zi=z*z;
+
+ for( k = 0; k < miz; k++ )
+ {
+ zk *= a1[k]*zi;
+ j0 += zk;
+ j0p += a2[k]*zk;
+ y0 += a3[k]*zk;
+ y0p += a4[k]*zk;
+ }
+
+ j0p *= -.5*z;
+ clogz=clogl(.5*z);
+ y0=(2.*j0*clogz-y0)/PI+C2;
+ y0p=(2./z+2.*j0p*clogz+.5*y0p*z)/PI+C1*z;
+ *h0=j0+CPLX_01*y0;
+ *h0p=j0p+CPLX_01*y0p;
+
+ if(ib == 0)
+ return;
+
+ y0=*h0;
+ y0p=*h0p;
+
+ } /* if(zms <= 16.81) */
+
+ /* asymptotic expansion */
+ zi=1./z;
+ zi2=zi*zi;
+ p0z=1.+(P20*zi2-P10)*zi2;
+ p1z=1.+(P11-P21*zi2)*zi2;
+ q0z=(Q20*zi2-Q10)*zi;
+ q1z=(Q11-Q21*zi2)*zi;
+ zk=cexp(CPLX_01*(z-POF))*csqrtl(zi)*C3;
+ *h0=zk*(p0z+CPLX_01*q0z);
+ *h0p=CPLX_01*zk*(p1z+CPLX_01*q1z);
+
+ if(ib == 0)
+ return;
+
+ zms=cosl((sqrtl(zms)-4.)*31.41592654);
+ *h0=.5*(y0*(1.+zms)+ *h0*(1.-zms));
+ *h0p=.5*(y0p*(1.+zms)+ *h0p*(1.-zms));
+
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* compute integration parameter xlam=lambda from parameter t. */
+void lambda( long double t, complex long double *xlam, complex long double *dxlam )
+{
+ *dxlam=b-a;
+ *xlam=a+*dxlam*t;
+ return;
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* rom1 integrates the 6 sommerfeld integrals from a to b in lambda. */
+/* the method of variable interval width romberg integration is used. */
+void rom1( int n, complex long double *sum, int nx )
+{
+ int jump, lstep, nogo, i, ns, nt;
+ static long double z, ze, s, ep, zend, dz=0., dzot=0., tr, ti;
+ static complex long double t00, t11, t02;
+ static complex long double g1[6], g2[6], g3[6], g4[6], g5[6], t01[6], t10[6], t20[6];
+
+ lstep=0;
+ z=0.;
+ ze=1.;
+ s=1.;
+ ep=s/(1.e4*NM);
+ zend=ze-ep;
+ for( i = 0; i < n; i++ )
+ sum[i]=CPLX_00;
+ ns=nx;
+ nt=0;
+ saoa(z,g1);
+
+ jump = FALSE;
+ while( TRUE )
+ {
+ if( ! jump )
+ {
+ dz=s/ns;
+ if( (z+dz) > ze )
+ {
+ dz=ze-z;
+ if( dz <= ep )
+ return;
+ }
+
+ dzot=dz*.5;
+ saoa(z+dzot,g3);
+ saoa(z+dz,g5);
+
+ } /* if( ! jump ) */
+
+ nogo=FALSE;
+ for( i = 0; i < n; i++ )
+ {
+ t00=(g1[i]+g5[i])*dzot;
+ t01[i]=(t00+dz*g3[i])*.5;
+ t10[i]=(4.*t01[i]-t00)/3.;
+
+ /* test convergence of 3 point romberg result */
+ test( creal(t01[i]), creal(t10[i]), &tr, cimag(t01[i]), cimag(t10[i]), &ti, 0. );
+ if( (tr > CRIT) || (ti > CRIT) )
+ nogo = TRUE;
+ }
+
+ if( ! nogo )
+ {
+ for( i = 0; i < n; i++ )
+ sum[i] += t10[i];
+
+ nt += 2;
+ z += dz;
+ if(z > zend)
+ return;
+
+ for( i = 0; i < n; i++ )
+ g1[i]=g5[i];
+
+ if( (nt >= NTS) && (ns > nx) )
+ {
+ ns=ns/2;
+ nt=1;
+ }
+
+ jump = FALSE;
+ continue;
+
+ } /* if( ! nogo ) */
+
+ saoa(z+dz*.25,g2);
+ saoa(z+dz*.75,g4);
+ nogo=FALSE;
+ for( i = 0; i < n; i++ )
+ {
+ t02=(t01[i]+dzot*(g2[i]+g4[i]))*.5;
+ t11=(4.*t02-t01[i])/3.;
+ t20[i]=(16.*t11-t10[i])/15.;
+
+ /* test convergence of 5 point romberg result */
+ test( creal(t11), creal(t20[i]), &tr, cimag(t11), cimag(t20[i]), &ti, 0. );
+ if( (tr > CRIT) || (ti > CRIT) )
+ nogo = TRUE;
+ }
+
+ if( ! nogo )
+ {
+ for( i = 0; i < n; i++ )
+ sum[i] += t20[i];
+
+ nt++;
+ z += dz;
+ if(z > zend)
+ return;
+
+ for( i = 0; i < n; i++ )
+ g1[i]=g5[i];
+
+ if( (nt >= NTS) && (ns > nx) )
+ {
+ ns=ns/2;
+ nt=1;
+ }
+
+ jump = FALSE;
+ continue;
+
+ } /* if( ! nogo ) */
+
+ nt=0;
+ if(ns < NM)
+ {
+ ns *= 2;
+ dz=s/ns;
+ dzot=dz*.5;
+
+ for( i = 0; i < n; i++ )
+ {
+ g5[i]=g3[i];
+ g3[i]=g2[i];
+ }
+
+ jump = TRUE;
+ continue;
+
+ } /* if(ns < nm) */
+
+ if( ! lstep )
+ {
+ lstep = TRUE;
+ lambda( z, &t00, &t11 );
+ }
+
+ for( i = 0; i < n; i++ )
+ sum[i] += t20[i];
+
+ nt++;
+ z += dz;
+ if(z > zend)
+ return;
+
+ for( i = 0; i < n; i++ )
+ g1[i]=g5[i];
+
+ if( (nt >= NTS) && (ns > nx) )
+ {
+ ns /= 2;
+ nt=1;
+ }
+
+ jump = FALSE;
+
+ } /* while( TRUE ) */
+
+}
+
+/*-----------------------------------------------------------------------*/
+
+/* saoa computes the integrand for each of the 6 sommerfeld */
+/* integrals for source and observer above ground */
+void saoa( long double t, complex long double *ans)
+{
+ long double xlr, sign;
+ static complex long double xl, dxl, cgam1, cgam2, b0, b0p, com, dgam, den1, den2;
+
+ lambda(t, &xl, &dxl);
+ if( jh == 0 )
+ {
+ /* bessel function form */
+ bessel(xl*rho, &b0, &b0p);
+ b0 *=2.;
+ b0p *=2.;
+ cgam1=csqrtl(xl*xl-ck1sq);
+ cgam2=csqrtl(xl*xl-ck2sq);
+ if(creal(cgam1) == 0.)
+ cgam1=cmplx(0.,-fabsl(cimag(cgam1)));
+ if(creal(cgam2) == 0.)
+ cgam2=cmplx(0.,-fabsl(cimag(cgam2)));
+ }
+ else
+ {
+ /* hankel function form */
+ hankel(xl*rho, &b0, &b0p);
+ com=xl-ck1;
+ cgam1=csqrtl(xl+ck1)*csqrtl(com);
+ if(creal(com) < 0. && cimag(com) >= 0.)
+ cgam1=-cgam1;
+ com=xl-ck2;
+ cgam2=csqrtl(xl+ck2)*csqrtl(com);
+ if(creal(com) < 0. && cimag(com) >= 0.)
+ cgam2=-cgam2;
+ }
+
+ xlr=xl*conj(xl);
+ if(xlr >= tsmag)
+ {
+ if(cimag(xl) >= 0.)
+ {
+ xlr=creal(xl);
+ if(xlr >= ck2)
+ {
+ if(xlr <= ck1r)
+ dgam=cgam2-cgam1;
+ else
+ {
+ sign=1.;
+ dgam=1./(xl*xl);
+ dgam=sign*((ct3*dgam+ct2)*dgam+ct1)/xl;
+ }
+ }
+ else
+ {
+ sign=-1.;
+ dgam=1./(xl*xl);
+ dgam=sign*((ct3*dgam+ct2)*dgam+ct1)/xl;
+ } /* if(xlr >= ck2) */
+
+ } /* if(cimag(xl) >= 0.) */
+ else
+ {
+ sign=1.;
+ dgam=1./(xl*xl);
+ dgam=sign*((ct3*dgam+ct2)*dgam+ct1)/xl;
+ }
+
+ } /* if(xlr < tsmag) */
+ else
+ dgam=cgam2-cgam1;
+
+ den2=cksm*dgam/(cgam2*(ck1sq*cgam2+ck2sq*cgam1));
+ den1=1./(cgam1+cgam2)-cksm/cgam2;
+ com=dxl*xl*cexp(-cgam2*zph);
+ ans[5]=com*b0*den1/ck1;
+ com *= den2;
+
+ if(rho != 0.)
+ {
+ b0p=b0p/rho;
+ ans[0]=-com*xl*(b0p+b0*xl);
+ ans[3]=com*xl*b0p;
+ }
+ else
+ {
+ ans[0]=-com*xl*xl*.5;
+ ans[3]=ans[0];
+ }
+
+ ans[1]=com*cgam2*cgam2*b0;
+ ans[2]=-ans[3]*cgam2*rho;
+ ans[4]=com*b0;
+
+ return;
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-hamradio/nec2c.git
More information about the pkg-hamradio-commits
mailing list