nec2c-0.8.orig/0000755000175000017500000000000011111214715011574 5ustar pg4ipg4inec2c-0.8.orig/AUTHORS0000644000175000017500000000004710620614554012656 0ustar pg4ipg4iNeoklis Kyriazis Ham Radio Call: 5B4AZ nec2c-0.8.orig/misc.c0000644000175000017500000001137210620614554012710 0ustar pg4ipg4i/* * 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] [-o]" "\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() */ /*------------------------------------------------------------------------*/ nec2c-0.8.orig/geometry.c0000644000175000017500000015240310620614554013611 0ustar pg4ipg4i/*** 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/network.c0000755000175000017500000003364611111214136013445 0ustar pg4ipg4i/*** 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/input.c0000644000175000017500000002437510767763033013134 0ustar pg4ipg4i/******* 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/Makefile0000644000175000017500000000103310767763033013253 0ustar pg4ipg4i#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 nec2c-0.8.orig/COPYING0000777000175000017500000000000011112506626020042 2/usr/share/automake-1.10/COPYINGustar pg4ipg4inec2c-0.8.orig/somnec.c0000644000175000017500000005013010620614554013234 0ustar pg4ipg4i/* 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; } nec2c-0.8.orig/fields.c0000644000175000017500000011725210620614554013227 0ustar pg4ipg4i/*** 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/README0000755000175000017500000002045611111214702012462 0ustar pg4ipg4i 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 [-o][-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 nec2c-0.8.orig/calculations.c0000644000175000017500000010071110620614554014432 0ustar pg4ipg4i/*** 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 ); } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/radiation.c0000644000175000017500000005703210620614554013732 0ustar pg4ipg4i/*** 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/main.c0000644000175000017500000013765110764445727012727 0ustar pg4ipg4i/*** 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 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() */ /*------------------------------------------------------------------------*/ nec2c-0.8.orig/matrix.c0000644000175000017500000007441210620614554013265 0ustar pg4ipg4i/*** 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/ground.c0000644000175000017500000001661210620614554013255 0ustar pg4ipg4i/*** 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; } /*-----------------------------------------------------------------------*/ nec2c-0.8.orig/NEC2-bug.txt0000644000175000017500000000656010767763033013630 0ustar pg4ipg4iYou 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 nec2c-0.8.orig/nec2c.h0000644000175000017500000003744210764420662012766 0ustar pg4ipg4i#ifndef NEC2C_H #define NEC2C_H 1 #include #include #include #include #include #include #include #include #include #include #include #include #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