1 /******* Translated to the C language by N. Kyriazis 20 Aug 2003 *******/
2 /* */
3 /* Program NEC(input,tape5=input,output,tape11,tape12,tape13,tape14, */
4 /* tape15,tape16,tape20,tape21) */
5 /* */
6 /* Numerical Electromagnetics Code (NEC2) developed at Lawrence */
7 /* Livermore lab., Livermore, CA. (contact G. Burke at 415-422-8414 */
8 /* for problems with the NEC code. For problems with the vax implem- */
9 /* entation, contact J. Breakall at 415-422-8196 or E. Domning at 415 */
10 /* 422-5936) */
11 /* file created 4/11/80. */
12 /* */
13 /* ***********Notice********** */
14 /* This computer code material was prepared as an account of work */
15 /* sponsored by the United States government. Neither the United */
16 /* States nor the United States Department Of Energy, nor any of */
17 /* their employees, nor any of their contractors, subcontractors, */
18 /* or their employees, makes any warranty, express or implied, or */
19 /* assumes any legal liability or responsibility for the accuracy, */
20 /* completeness or usefulness of any information, apparatus, product */
21 /* or process disclosed, or represents that its use would not infringe */
22 /* privately-owned rights. */
23 /* */
24 /************************************************************************/
25
26 #include "nec2c.h"
27
28 /*** common data are implemented as global variables ***/
29 /* common /data/ */
30 int n, np, m, mp, ipsym, npm, np2m, np3m; /* n+m,n+2m,n+3m */
31 int *icon1, *icon2, *itag;
32 double *x, *y, *z, *si, *bi;
33 double *x2, *y2, *z2, *cab, *sab, *salp;
34 double *t1x, *t1y, *t1z, *t2x, *t2y, *t2z;
35 double *px, *py, *pz, *pbi, *psalp;
36 double wlam;
37
38 /* common /cmb/ */
39 complex double *cm;
40
41 /* common /matpar/ */
42 int icase, npblk, nlast;
43 int imat, nbbx, npbx, nlbx, nbbl, npbl, nlbl;
44
45 /* common /save/ */
46 int *ip;
47 double epsr, sig, scrwlt, scrwrt, fmhz;
48
49 /* common /crnt/ */
50 double *air, *aii, *bir, *bii, *cir, *cii;
51 complex double *cur;
52
53 /* common /gnd/ */
54 int ksymp, ifar, iperf, nradl;
55 double t2, cl, ch, scrwl, scrwr;
56 complex double zrati, zrati2, t1, frati;
57
58 /* common /zload/ */
59 int nload;
60 complex double *zarray;
61
62 /* common /yparm/ */
63 int ncoup, icoup, *nctag, *ncseg;
64 complex double *y11a, *y12a;
65
66 /* common /segj/ */
67 int *jco, jsno, nscon, maxcon; /* Max. no. connections */
68 double *ax, *bx, *cx;
69
70 /* common /vsorc/ */
71 int *ivqd, *isant, *iqds, nvqd, nsant, nqds;
72 complex double *vqd, *vqds, *vsant;
73
74 /* common /netcx/ */
75 int masym, neq, npeq, neq2, nonet, ntsol, nprint;
76 int *iseg1, *iseg2, *ntyp;
77 double *x11r, *x11i, *x12r;
78 double *x12i, *x22r, *x22i;
79 double pin, pnls;
80 complex double zped;
81
82 /* common /fpat/ */
83 int near, nfeh, nrx, nry, nrz, nth, nph, ipd, iavp, inor, iax, ixtyp;
84 double thets, phis, dth, dph, rfld, gnor, clt, cht, epsr2, sig2;
85 double xpr6, pinr, pnlr, ploss, xnr, ynr, znr, dxnr, dynr, dznr;
86
87 /*common /ggrid/ */
88 extern int nxa[3], nya[3];
89 extern double dxa[3], dya[3], xsa[3], ysa[3];
90 extern complex double epscf, *ar1, *ar2, *ar3;
91
92 /* common /gwav/ */
93 double r1, r2, zmh, zph;
94 complex double u, u2, xx1, xx2;
95
96 /* common /plot/ */
97 int iplp1, iplp2, iplp3, iplp4;
98
99 /* common /dataj/ */
100 int iexk, ind1, indd1, ind2, indd2, ipgnd;
101 double s, b, xj, yj, zj, cabj, sabj, salpj, rkh;
102 double t1xj, t1yj, t1zj, t2xj, t2yj, t2zj;
103 complex double exk, eyk, ezk, exs, eys, ezs, exc, eyc, ezc;
104
105 /* common /smat/ */
106 int nop; /* My addition */
107 complex double *ssx;
108
109 /* common /incom/ */
110 int isnor;
111 double xo, yo, zo, sn, xsn, ysn;
112
113 /* common /tmi/ */
114 int ija; /* changed to ija to avoid conflict */
115 double zpk, rkb2;
116
117 /*common /tmh/ */
118 double zpka, rhks;
119
120 /* pointers to input/output files */
121 FILE *input_fp=NULL, *output_fp=NULL, *plot_fp=NULL;
122
123 /* signal handler */
124 static void sig_handler( int signal );
125
126 /*-------------------------------------------------------------------*/
127
main(int argc,char ** argv)128 int main( int argc, char **argv )
129 {
130 char infile[81] = "", otfile[81] = "";
131 char ain[3], line_buf[81];
132
133 /* input card mnemonic list */
134 /* "XT" stands for "exit", added for testing */
135 #define CMD_NUM 20
136 char *atst[CMD_NUM] =
137 {
138 "FR", "LD", "GN", "EX", "NT", "TL", \
139 "XQ", "GD", "RP", "NX", "PT", "KH", \
140 "NE", "NH", "PQ", "EK", "CP", "PL", \
141 "EN", "WG"
142 };
143
144 char *hpol[3] = { "LINEAR", "RIGHT", "LEFT" };
145 char *pnet[3] = { " ", "STRAIGHT", " CROSSED" };
146
147 int *ldtyp, *ldtag, *ldtagf, *ldtagt;
148 int ifrtmw, ifrtmp, mpcnt, ib11=0, ic11=0, id11=0, ix11, igo, nfrq;
149 int iexk, jump, iptflg, iptflq, iped, iflow, itmp1, iresrv;
150 int itmp3, itmp2, itmp4, nthi=0, nphi=0, iptag=0, iptagf=0, iptagt=0;
151 int iptaq=0, iptaqf=0, iptaqt=0, nphic=0, inc=0;
152 int i, j, itmp5, nthic=0, mhz=0, ifrq=0, isave=0;
153
154 int
155 igox, /* used in place of "igo" in freq loop */
156 next_job, /* start next job (next sructure) flag */
157 idx, /* general purpose index */
158 ain_num, /* ain mnemonic as a number */
159 jmp_iloop, /* jump to input loop flag */
160 jmp_floop=0,/* jump to freq. loop flag */
161 mreq; /* Size req. for malloc's */
162
163 double *zlr, *zli, *zlc, *fnorm;
164 double *xtemp, *ytemp, *ztemp, *sitemp, *bitemp;
165 double fmhz1, rkh, tmp1, delfrq=0., tmp2, tmp3, tmp4, tmp5, tmp6;
166 double xpr1=0., xpr2=0., xpr3=0., xpr4=0., xpr5=0.;
167 double zpnorm=0., thetis=0., phiss=0., extim;
168 double tim1, tim, tim2, etha, fr, fr2, cmag, ph, ethm, ephm, epha;
169 complex double eth, eph, curi, ex, ey, ez, epsc;
170
171 /* getopt() variables */
172 extern char *optarg;
173 extern int optind, opterr, optopt;
174 int option;
175
176 /*** signal handler related code ***/
177 /* new and old actions for sigaction() */
178 struct sigaction sa_new, sa_old;
179
180
181 /* initialize new actions */
182 sa_new.sa_handler = sig_handler;
183 sigemptyset( &sa_new.sa_mask );
184 sa_new.sa_flags = 0;
185
186 /* register function to handle signals */
187 sigaction( SIGINT, &sa_new, &sa_old );
188 sigaction( SIGSEGV, &sa_new, 0 );
189 sigaction( SIGFPE, &sa_new, 0 );
190 sigaction( SIGTERM, &sa_new, 0 );
191 sigaction( SIGABRT, &sa_new, 0 );
192
193 /*** command line arguments handler ***/
194 if( argc == 1 )
195 {
196 usage();
197 exit(-1);
198 }
199
200 /* process command line options */
201 while( (option = getopt(argc, argv, "i:o:hv") ) != -1 )
202 {
203 switch( option )
204 {
205 case 'i' : /* specify input file name */
206 if( strlen(optarg) > 75 )
207 abort_on_error(-1);
208 strcpy( infile, optarg );
209 break;
210
211 case 'o' : /* specify output file name */
212 if( strlen(optarg) > 75 )
213 abort_on_error(-2);
214 strcpy( otfile, optarg );
215 break;
216
217 case 'h' : /* print usage and exit */
218 usage();
219 exit(0);
220
221 case 'v' : /* print nec2c version */
222 puts( version );
223 exit(0);
224
225 default: /* print usage and exit */
226 usage();
227 exit(-1);
228
229 } /* end of switch( option ) */
230
231 } /* while( (option = getopt(argc, argv, "i:o:hv") ) != -1 ) */
232
233 /*** open input file ***/
234 if( (input_fp = fopen(infile, "r")) == NULL )
235 {
236 char mesg[88] = "nec2c: ";
237
238 strcat( mesg, infile );
239 perror( mesg );
240 exit(-1);
241 }
242
243 /* make an output file name if not */
244 /* specified by user on invocation */
245 if( strlen( otfile ) == 0 )
246 {
247 /* strip file name extension if there is one */
248 idx = 0;
249 while( (infile[++idx] != '.') && (infile[idx] != '\0') );
250 infile[idx] = '\0';
251
252 /* make the output file name */
253 strcpy( otfile, infile );
254 }
255
256 /* add extension */
257 strcat( otfile, ".out" );
258
259 /* open output file */
260 if( (output_fp = fopen(otfile, "w")) == NULL )
261 {
262 char mesg[88] = "nec2c: ";
263
264 strcat( mesg, otfile );
265 perror( mesg );
266 exit(-1);
267 }
268
269 /*** here we had code to read interactively input/output ***/
270 /*** file names. this is done non-interactively above. ***/
271
272 secnds( &extim );
273
274 /* Null buffer pointers */
275 /* type int */
276 icon1 = icon2 = ncseg = nctag = ivqd = isant = iqds = NULL;
277 itag = ip = ldtyp = ldtag = ldtagf = ldtagt = jco = NULL;
278 /* type double */
279 air = aii = bir = bii = cir = cii = zlr = zli = zlc = fnorm = NULL;
280 ax = bx = cx = xtemp = ytemp = ztemp = sitemp = bitemp = NULL;
281 x = y = z = si = bi = x2 = y2 = z2 = cab = sab = salp = NULL;
282 t1x = t1y = t1z = t2x = t2y = t2z = px = py = pz = pbi = psalp = NULL;
283 /* type complex double */
284 ar1 = ar2 = ar3 = cur = cm = zarray = NULL;
285 y11a = y12a = vqd = vqds = vsant = ssx = NULL;
286
287 /* Allocate some buffers */
288 mem_alloc( (void *)&ar1, sizeof(complex double)*11*10*4 );
289 mem_alloc( (void *)&ar2, sizeof(complex double)*17*5*4 );
290 mem_alloc( (void *)&ar3, sizeof(complex double)*9*8*4 );
291
292
293 /* l_1: */
294 /* main execution loop, exits at various points */
295 /* depending on error conditions or end of jobs */
296 while( TRUE )
297 {
298 ifrtmw=0;
299 ifrtmp=0;
300
301 /* print the nec2c header to output file */
302 fprintf( output_fp, "\n\n\n"
303 " "
304 " __________________________________________\n"
305 " "
306 "| |\n"
307 " "
308 "| NUMERICAL ELECTROMAGNETICS CODE (nec2c) |\n"
309 " "
310 "| Translated to 'C' in Double Precision |\n"
311 " "
312 "|__________________________________________|\n" );
313
314 /* read a line from input file */
315 if( load_line(line_buf, input_fp) == EOF )
316 abort_on_error(-3);
317
318 /* separate card's id mnemonic */
319 strncpy( ain, line_buf, 2 );
320 ain[2] = '\0';
321
322 /* If its an "XT" card, exit (used for debugging) */
323 if( strcmp(ain, "XT") == 0 )
324 {
325 fprintf( stderr,
326 "\nnec2c: Exiting after an \"XT\" command in main()\n" );
327 fprintf( output_fp,
328 "\n\n nec2c: Exiting after an \"XT\" command in main()" );
329 stop(0);
330 }
331
332 /* if its a "cm" or "ce" card start reading comments */
333 if( (strcmp(ain, "CM") == 0) ||
334 (strcmp(ain, "CE") == 0) )
335 {
336 fprintf( output_fp, "\n\n\n"
337 " "
338 "---------------- COMMENTS ----------------\n" );
339
340 /* write comment to output file */
341 fprintf( output_fp,
342 " %s\n",
343 &line_buf[2] );
344
345 /* Keep reading till a non "CM" card */
346 while( strcmp(ain, "CM") == 0 )
347 {
348 /* read a line from input file */
349 if( load_line(line_buf, input_fp) == EOF )
350 abort_on_error(-3);
351
352 /* separate card's id mnemonic */
353 strncpy( ain, line_buf, 2 );
354 ain[2] = '\0';
355
356 /* write comment to output file */
357 fprintf( output_fp,
358 " %s\n",
359 &line_buf[2] );
360
361 } /* while( strcmp(ain, "CM") == 0 ) */
362
363 /* no "ce" card at end of comments */
364 if( strcmp(ain, "CE") != 0 )
365 {
366 fprintf( output_fp,
367 "\n\n ERROR: INCORRECT LABEL FOR A COMMENT CARD" );
368 abort_on_error(-4);
369 }
370
371 } /* if( strcmp(ain, "CM") == 0 ... */
372 else
373 rewind( input_fp );
374
375 /* Free some buffer pointers.
376 * These are allocated by realloc()
377 * so they need to be free()'d
378 * before reallocation for a new job
379 */
380 free_ptr( (void *)&itag );
381 free_ptr( (void *)&fnorm );
382 free_ptr( (void *)&ldtyp );
383 free_ptr( (void *)&ldtag );
384 free_ptr( (void *)&ldtagf );
385 free_ptr( (void *)&ldtagt );
386 free_ptr( (void *)&zlr );
387 free_ptr( (void *)&zli );
388 free_ptr( (void *)&zlc );
389 free_ptr( (void *)&jco );
390 free_ptr( (void *)&ax );
391 free_ptr( (void *)&bx );
392 free_ptr( (void *)&cx );
393 free_ptr( (void *)&ivqd );
394 free_ptr( (void *)&iqds );
395 free_ptr( (void *)&vqd );
396 free_ptr( (void *)&vqds );
397 free_ptr( (void *)&isant );
398 free_ptr( (void *)&vsant );
399 free_ptr( (void *)&x );
400 free_ptr( (void *)&y );
401 free_ptr( (void *)&z );
402 free_ptr( (void *)&x2 );
403 free_ptr( (void *)&y2 );
404 free_ptr( (void *)&z2 );
405 free_ptr( (void *)&px );
406 free_ptr( (void *)&py );
407 free_ptr( (void *)&pz );
408 free_ptr( (void *)&t1x );
409 free_ptr( (void *)&t1y );
410 free_ptr( (void *)&t1z );
411 free_ptr( (void *)&t2x );
412 free_ptr( (void *)&t2y );
413 free_ptr( (void *)&t2z );
414 free_ptr( (void *)&si );
415 free_ptr( (void *)&bi );
416 free_ptr( (void *)&cab );
417 free_ptr( (void *)&sab );
418 free_ptr( (void *)&salp );
419 free_ptr( (void *)&pbi );
420 free_ptr( (void *)&psalp );
421
422 /* initializations etc from original fortran code */
423 mpcnt=0;
424 imat=0;
425
426 /* set up geometry data in subroutine datagn */
427 datagn();
428 iflow=1;
429
430 /* Allocate some buffers */
431 mreq = npm * sizeof(double);
432 mem_alloc( (void *)&air, mreq );
433 mem_alloc( (void *)&aii, mreq );
434 mem_alloc( (void *)&bir, mreq );
435 mem_alloc( (void *)&bii, mreq );
436 mem_alloc( (void *)&cir, mreq );
437 mem_alloc( (void *)&cii, mreq );
438 mem_alloc( (void *)&xtemp, mreq );
439 mem_alloc( (void *)&ytemp, mreq );
440 mem_alloc( (void *)&ztemp, mreq );
441 mem_alloc( (void *)&sitemp, mreq );
442 mem_alloc( (void *)&bitemp, mreq );
443
444 mreq = np2m * sizeof(int);
445 mem_alloc( (void *)&ip, mreq );
446
447 mreq = np3m * sizeof( complex double);
448 mem_alloc( (void *)&cur, mreq );
449
450 /* Matrix parameters */
451 if( imat == 0)
452 {
453 neq= n+2*m;
454 neq2=0;
455 ib11=0;
456 ic11=0;
457 id11=0;
458 ix11=0;
459 }
460
461 fprintf( output_fp, "\n\n\n" );
462
463 /* default values for input parameters and flags */
464 npeq= np+2*mp;
465 iplp1=0;
466 iplp2=0;
467 iplp3=0;
468 iplp4=0;
469 igo=1;
470 nfrq=1;
471 rkh=1.;
472 iexk=0;
473 ixtyp=0;
474 nload=0;
475 nonet=0;
476 near=-1;
477 iptflg=-2;
478 iptflq=-1;
479 ifar=-1;
480 zrati=CPLX_10;
481 iped=0;
482 ncoup=0;
483 icoup=0;
484 fmhz= CVEL;
485 ksymp=1;
486 nradl=0;
487 iperf=0;
488
489 /* l_14: */
490
491 /* main input section, exits at various points */
492 /* depending on error conditions or end of job */
493 next_job = FALSE;
494 while( ! next_job )
495 {
496 jmp_iloop = FALSE;
497
498 /* main input section - standard read statement - jumps */
499 /* to appropriate section for specific parameter set up */
500 readmn( ain, &itmp1, &itmp2, &itmp3, &itmp4,
501 &tmp1, &tmp2, &tmp3, &tmp4, &tmp5, &tmp6 );
502
503 /* If its an "XT" card, exit */
504 if( strcmp(ain, "XT" ) == 0 )
505 {
506 fprintf( stderr,
507 "\nnec2c: Exiting after an \"XT\" command in main()\n" );
508 fprintf( output_fp,
509 "\n\n nec2c: Exiting after an \"XT\" command in main()" );
510 stop(0);
511 }
512
513 mpcnt++;
514 fprintf( output_fp,
515 "\n DATA CARD No: %3d "
516 "%s %3d %5d %5d %5d %12.5E %12.5E %12.5E %12.5E %12.5E %12.5E",
517 mpcnt, ain, itmp1, itmp2, itmp3, itmp4,
518 tmp1, tmp2, tmp3, tmp4, tmp5, tmp6 );
519
520 /* identify card id mnemonic (except "ce" and "cm") */
521 for( ain_num = 0; ain_num < CMD_NUM; ain_num++ )
522 if( strncmp( ain, atst[ain_num], 2) == 0 )
523 break;
524
525 /* take action according to card id mnemonic */
526 switch( ain_num )
527 {
528 case 0: /* "fr" card, frequency parameters */
529
530 ifrq= itmp1;
531 nfrq= itmp2;
532 if( nfrq == 0)
533 nfrq=1;
534 fmhz= tmp1;
535 delfrq= tmp2;
536 if( iped == 1)
537 zpnorm=0.;
538 igo=1;
539 iflow=1;
540
541 continue; /* continue card input loop */
542
543 case 1: /* "ld" card, loading parameters */
544 {
545 int idx;
546
547 if( iflow != 3 )
548 {
549 iflow=3;
550 /* Free loading buffers */
551 nload=0;
552 free_ptr( (void *)&ldtyp );
553 free_ptr( (void *)&ldtag );
554 free_ptr( (void *)&ldtagf );
555 free_ptr( (void *)&ldtagt );
556 free_ptr( (void *)&zlr );
557 free_ptr( (void *)&zli );
558 free_ptr( (void *)&zlc );
559
560 if( igo > 2 )
561 igo=2;
562 if( itmp1 == -1 )
563 continue; /* continue card input loop */
564 }
565
566 /* Reallocate loading buffers */
567 nload++;
568 idx = nload * sizeof(int);
569 mem_realloc( (void *)&ldtyp, idx );
570 mem_realloc( (void *)&ldtag, idx );
571 mem_realloc( (void *)&ldtagf, idx );
572 mem_realloc( (void *)&ldtagt, idx );
573 idx = nload * sizeof(double);
574 mem_realloc( (void *)&zlr, idx );
575 mem_realloc( (void *)&zli, idx );
576 mem_realloc( (void *)&zlc, idx );
577
578 idx = nload-1;
579 ldtyp[idx]= itmp1;
580 ldtag[idx]= itmp2;
581 if( itmp4 == 0)
582 itmp4= itmp3;
583 ldtagf[idx]= itmp3;
584 ldtagt[idx]= itmp4;
585
586 if( itmp4 < itmp3 )
587 {
588 fprintf( output_fp,
589 "\n\n DATA FAULT ON LOADING CARD No: %d: ITAG "
590 "STEP1: %d IS GREATER THAN ITAG STEP2: %d",
591 nload, itmp3, itmp4 );
592 stop(-1);
593 }
594
595 zlr[idx]= tmp1;
596 zli[idx]= tmp2;
597 zlc[idx]= tmp3;
598 }
599
600 continue; /* continue card input loop */
601
602 case 2: /* "gn" card, ground parameters under the antenna */
603
604 iflow=4;
605
606 if( igo > 2)
607 igo=2;
608
609 if( itmp1 == -1 )
610 {
611 ksymp=1;
612 nradl=0;
613 iperf=0;
614 continue; /* continue card input loop */
615 }
616
617 iperf= itmp1;
618 nradl= itmp2;
619 ksymp=2;
620 epsr= tmp1;
621 sig= tmp2;
622
623 if( nradl != 0)
624 {
625 if( iperf == 2)
626 {
627 fprintf( output_fp,
628 "\n\n RADIAL WIRE G.S. APPROXIMATION MAY "
629 "NOT BE USED WITH SOMMERFELD GROUND OPTION" );
630 stop(-1);
631 }
632
633 scrwlt= tmp3;
634 scrwrt= tmp4;
635 continue; /* continue card input loop */
636 }
637
638 epsr2= tmp3;
639 sig2= tmp4;
640 clt= tmp5;
641 cht= tmp6;
642
643 continue; /* continue card input loop */
644
645 case 3: /* "ex" card, excitation parameters */
646
647 if( iflow != 5)
648 {
649 /* Free vsource buffers */
650 free_ptr( (void *)&ivqd );
651 free_ptr( (void *)&iqds );
652 free_ptr( (void *)&vqd );
653 free_ptr( (void *)&vqds );
654 free_ptr( (void *)&isant );
655 free_ptr( (void *)&vsant );
656
657 nsant=0;
658 nvqd=0;
659 iped=0;
660 iflow=5;
661 if( igo > 3)
662 igo=3;
663 }
664
665 masym= itmp4/10;
666 if( (itmp1 == 0) || (itmp1 == 5) )
667 {
668 ixtyp= itmp1;
669 ntsol=0;
670
671 if( ixtyp != 0)
672 {
673 nvqd++;
674 mem_realloc( (void *)&ivqd, nvqd * sizeof(int) );
675 mem_realloc( (void *)&iqds, nvqd * sizeof(int) );
676 mem_realloc( (void *)&vqd, nvqd * sizeof(complex double) );
677 mem_realloc( (void *)&vqds, nvqd * sizeof(complex double) );
678
679 {
680 int indx = nvqd-1;
681
682 ivqd[indx]= isegno( itmp2, itmp3);
683 vqd[indx]= cmplx( tmp1, tmp2);
684 if( cabs( vqd[indx]) < 1.e-20)
685 vqd[indx] = CPLX_10;
686
687 iped= itmp4- masym*10;
688 zpnorm= tmp3;
689 if( (iped == 1) && (zpnorm > 0.0) )
690 iped=2;
691 continue; /* continue card input loop */
692 }
693
694 } /* if( ixtyp != 0) */
695
696 nsant++;
697 mem_realloc( (void *)&isant, nsant * sizeof(int) );
698 mem_realloc( (void *)&vsant, nsant * sizeof(complex double) );
699
700 {
701 int indx = nsant-1;
702
703 isant[indx]= isegno( itmp2, itmp3);
704 vsant[indx]= cmplx( tmp1, tmp2);
705 if( cabs( vsant[indx]) < 1.e-20)
706 vsant[indx] = CPLX_10;
707
708 iped= itmp4- masym*10;
709 zpnorm= tmp3;
710 if( (iped == 1) && (zpnorm > 0.0) )
711 iped=2;
712 continue; /* continue card input loop */
713 }
714
715 } /* if( (itmp1 <= 0) || (itmp1 == 5) ) */
716
717 if( (ixtyp == 0) || (ixtyp == 5) )
718 ntsol=0;
719
720 ixtyp= itmp1;
721 nthi= itmp2;
722 nphi= itmp3;
723 xpr1= tmp1;
724 xpr2= tmp2;
725 xpr3= tmp3;
726 xpr4= tmp4;
727 xpr5= tmp5;
728 xpr6= tmp6;
729 nsant=0;
730 nvqd=0;
731 thetis= xpr1;
732 phiss= xpr2;
733
734 continue; /* continue card input loop */
735
736 case 4: case 5: /* "nt" & "tl" cards, network parameters */
737 {
738 int idx;
739
740 if( iflow != 6)
741 {
742 nonet=0;
743 ntsol=0;
744 iflow=6;
745
746 /* Free network buffers */
747 free_ptr( (void *)&ntyp );
748 free_ptr( (void *)&iseg1 );
749 free_ptr( (void *)&iseg2 );
750 free_ptr( (void *)&x11r );
751 free_ptr( (void *)&x11i );
752 free_ptr( (void *)&x12r );
753 free_ptr( (void *)&x12i );
754 free_ptr( (void *)&x22r );
755 free_ptr( (void *)&x22i );
756
757 if( igo > 3)
758 igo=3;
759
760 if( itmp2 == -1 )
761 continue; /* continue card input loop */
762 }
763
764 /* Re-allocate network buffers */
765 nonet++;
766 idx = nonet * sizeof(int);
767 mem_realloc( (void *)&ntyp, idx );
768 mem_realloc( (void *)&iseg1, idx );
769 mem_realloc( (void *)&iseg2, idx );
770 idx = nonet * sizeof(double);
771 mem_realloc( (void *)&x11r, idx );
772 mem_realloc( (void *)&x11i, idx );
773 mem_realloc( (void *)&x12r, idx );
774 mem_realloc( (void *)&x12i, idx );
775 mem_realloc( (void *)&x22r, idx );
776 mem_realloc( (void *)&x22i, idx );
777
778 idx = nonet-1;
779 if( ain_num == 4 )
780 ntyp[idx]=1;
781 else
782 ntyp[idx]=2;
783
784 iseg1[idx]= isegno( itmp1, itmp2);
785 iseg2[idx]= isegno( itmp3, itmp4);
786 x11r[idx]= tmp1;
787 x11i[idx]= tmp2;
788 x12r[idx]= tmp3;
789 x12i[idx]= tmp4;
790 x22r[idx]= tmp5;
791 x22i[idx]= tmp6;
792
793 if( (ntyp[idx] == 1) || (tmp1 > 0.) )
794 continue; /* continue card input loop */
795
796 ntyp[idx]=3;
797 x11r[idx]= - tmp1;
798
799 continue; /* continue card input loop */
800 }
801
802 case 6: /* "xq" execute card - calc. including radiated fields */
803
804 if( ((iflow == 10) && (itmp1 == 0)) ||
805 ((nfrq == 1) && (itmp1 == 0) && (iflow > 7)) )
806 continue; /* continue card input loop */
807
808 if( itmp1 == 0)
809 {
810 if( iflow > 7)
811 iflow=11;
812 else
813 iflow=7;
814 }
815 else
816 {
817 ifar=0;
818 rfld=0.;
819 ipd=0;
820 iavp=0;
821 inor=0;
822 iax=0;
823 nth=91;
824 nph=1;
825 thets=0.;
826 phis=0.;
827 dth=1.0;
828 dph=0.;
829
830 if( itmp1 == 2)
831 phis=90.;
832
833 if( itmp1 == 3)
834 {
835 nph=2;
836 dph=90.;
837 }
838
839 } /* if( itmp1 == 0) */
840
841 break;
842
843 case 7: /* "gd" card, ground representation */
844
845 epsr2= tmp1;
846 sig2= tmp2;
847 clt= tmp3;
848 cht= tmp4;
849 iflow=9;
850
851 continue; /* continue card input loop */
852
853 case 8: /* "rp" card, standard observation angle parameters */
854
855 ifar= itmp1;
856 nth= itmp2;
857 nph= itmp3;
858
859 if( nth == 0)
860 nth=1;
861 if( nph == 0)
862 nph=1;
863
864 ipd= itmp4/10;
865 iavp= itmp4- ipd*10;
866 inor= ipd/10;
867 ipd= ipd- inor*10;
868 iax= inor/10;
869 inor= inor- iax*10;
870
871 if( iax != 0)
872 iax=1;
873 if( ipd != 0)
874 ipd=1;
875 if( (nth < 2) || (nph < 2) || (ifar == 1) )
876 iavp=0;
877
878 thets= tmp1;
879 phis= tmp2;
880 dth= tmp3;
881 dph= tmp4;
882 rfld= tmp5;
883 gnor= tmp6;
884 iflow=10;
885
886 break;
887
888 case 9: /* "nx" card, do next job */
889 next_job = TRUE;
890 continue; /* continue card input loop */
891
892 case 10: /* "pt" card, print control for current */
893
894 iptflg= itmp1;
895 iptag= itmp2;
896 iptagf= itmp3;
897 iptagt= itmp4;
898
899 if( (itmp3 == 0) && (iptflg != -1) )
900 iptflg=-2;
901 if( itmp4 == 0)
902 iptagt= iptagf;
903
904 continue; /* continue card input loop */
905
906 case 11: /* "kh" card, matrix integration limit */
907
908 rkh= tmp1;
909 if( igo > 2)
910 igo=2;
911 iflow=1;
912
913 continue; /* continue card input loop */
914
915 case 12: case 13: /* "ne"/"nh" cards, near field calculation parameters */
916
917 if( ain_num == 13 )
918 nfeh=1;
919 else
920 nfeh=0;
921
922 if( (iflow == 8) && (nfrq != 1) )
923 {
924 fprintf( output_fp,
925 "\n\n WHEN MULTIPLE FREQUENCIES ARE REQUESTED, "
926 "ONLY ONE NEAR FIELD CARD CAN BE USED -"
927 "\n LAST CARD READ WILL BE USED" );
928 }
929
930 near= itmp1;
931 nrx= itmp2;
932 nry= itmp3;
933 nrz= itmp4;
934 xnr= tmp1;
935 ynr= tmp2;
936 znr= tmp3;
937 dxnr= tmp4;
938 dynr= tmp5;
939 dznr= tmp6;
940 iflow=8;
941
942 if( nfrq != 1)
943 continue; /* continue card input loop */
944
945 break;
946
947 case 14: /* "pq" card, write control for charge */
948
949 iptflq= itmp1;
950 iptaq= itmp2;
951 iptaqf= itmp3;
952 iptaqt= itmp4;
953
954 if( (itmp3 == 0) && (iptflq != -1) )
955 iptflq=-2;
956 if( itmp4 == 0)
957 iptaqt= iptaqf;
958
959 continue; /* continue card input loop */
960
961 case 15: /* "ek" card, extended thin wire kernel option */
962
963 iexk=1;
964 if( itmp1 == -1)
965 iexk=0;
966 if( igo > 2)
967 igo=2;
968 iflow=1;
969
970 continue; /* continue card input loop */
971
972 case 16: /* "cp" card, maximum coupling between antennas */
973
974 if( iflow != 2)
975 {
976 ncoup=0;
977 free_ptr( (void *)&nctag );
978 free_ptr( (void *)&ncseg );
979 free_ptr( (void *)&y11a );
980 free_ptr( (void *)&y12a );
981 }
982
983 icoup=0;
984 iflow=2;
985
986 if( itmp2 == 0)
987 continue; /* continue card input loop */
988
989 ncoup++;
990 mem_realloc( (void *)&nctag, (ncoup) * sizeof(int) );
991 mem_realloc( (void *)&ncseg, (ncoup) * sizeof(int) );
992 nctag[ncoup-1]= itmp1;
993 ncseg[ncoup-1]= itmp2;
994
995 if( itmp4 == 0)
996 continue; /* continue card input loop */
997
998 ncoup++;
999 mem_realloc( (void *)&nctag, (ncoup) * sizeof(int) );
1000 mem_realloc( (void *)&ncseg, (ncoup) * sizeof(int) );
1001 nctag[ncoup-1]= itmp3;
1002 ncseg[ncoup-1]= itmp4;
1003
1004 continue; /* continue card input loop */
1005
1006 case 17: /* "pl" card, plot flags */
1007
1008 iplp1= itmp1;
1009 iplp2= itmp2;
1010 iplp3= itmp3;
1011 iplp4= itmp4;
1012
1013 if( plot_fp == NULL )
1014 {
1015 char plotfile[81];
1016
1017 /* Make a plot file name */
1018 strcpy( plotfile, infile );
1019 strcat( plotfile, ".plt" );
1020
1021 /* Open plot file */
1022 if( (plot_fp = fopen(plotfile, "w")) == NULL )
1023 {
1024 char mesg[88] = "nec2c: ";
1025
1026 strcat( mesg, plotfile );
1027 perror( mesg );
1028 exit(-1);
1029 }
1030 }
1031
1032 continue; /* continue card input loop */
1033
1034 case 19: /* "wg" card, not supported */
1035 abort_on_error(-5);
1036
1037 default:
1038 if( ain_num != 18 )
1039 {
1040 fprintf( output_fp,
1041 "\n\n FAULTY DATA CARD LABEL AFTER GEOMETRY SECTION" );
1042 stop(-1);
1043 }
1044
1045 /******************************************************
1046 *** normal exit of nec2c when all jobs complete ok ***
1047 ******************************************************/
1048
1049 /* time the process */
1050 secnds( &tmp1 );
1051 tmp1 -= extim;
1052 fprintf( output_fp, "\n\n TOTAL RUN TIME: %d msec", (int)tmp1 );
1053 stop(0);
1054
1055 } /* switch( ain_num ) */
1056
1057 /**************************************
1058 *** end of the main input section. ***
1059 *** beginning of frequency do loop ***
1060 **************************************/
1061
1062 /* Allocate to normalization buffer */
1063 {
1064 int mreq1, mreq2;
1065
1066 mreq1 = mreq2 = 0;
1067 if( iped )
1068 mreq1 = 4*nfrq * sizeof(double);
1069 if( iptflg >= 2 )
1070 mreq2 = nthi*nphi * sizeof(double);
1071
1072 if( (mreq1 > 0) || (mreq2 > 0) )
1073 {
1074 if( mreq1 > mreq2 )
1075 mem_alloc( (void *)&fnorm, mreq1 );
1076 else
1077 mem_alloc( (void *)&fnorm, mreq2 );
1078 }
1079 }
1080
1081 /* igox is used in place of "igo" in the */
1082 /* freq loop. below is a special igox case */
1083 if( ((ain_num == 6) || (ain_num == 8)) && (igo == 5) )
1084 igox = 6;
1085 else
1086 igox = igo;
1087
1088 switch( igox )
1089 {
1090 case 1: /* label 41 */
1091 /* Memory allocation for primary interacton matrix. */
1092 iresrv = np2m * (np+2*mp);
1093 mem_alloc( (void *)&cm, iresrv * sizeof(complex double) );
1094
1095 /* Memory allocation for symmetry array */
1096 nop = neq/npeq;
1097 mem_alloc( (void *)&ssx, nop*nop * sizeof( complex double) );
1098
1099 mhz=1;
1100
1101 if( (n != 0) && (ifrtmw != 1) )
1102 {
1103 ifrtmw=1;
1104 for( i = 0; i < n; i++ )
1105 {
1106 xtemp[i]= x[i];
1107 ytemp[i]= y[i];
1108 ztemp[i]= z[i];
1109 sitemp[i]= si[i];
1110 bitemp[i]= bi[i];
1111 }
1112 }
1113
1114 if( (m != 0) && (ifrtmp != 1) )
1115 {
1116 ifrtmp=1;
1117 for( i = 0; i < m; i++ )
1118 {
1119 j = i+n;
1120 xtemp[j]= px[i];
1121 ytemp[j]= py[i];
1122 ztemp[j]= pz[i];
1123 bitemp[j]= pbi[i];
1124 }
1125 }
1126
1127 fmhz1= fmhz;
1128
1129 /* irngf is not used (NGF function not implemented) */
1130 if( imat == 0)
1131 fblock( npeq, neq, iresrv, ipsym);
1132
1133 /* label 42 */
1134 /* frequency do loop */
1135 do
1136 {
1137 jmp_floop = FALSE;
1138
1139 if( mhz != 1)
1140 {
1141 if( ifrq == 1)
1142 fmhz *= delfrq;
1143 else
1144 fmhz += delfrq;
1145 }
1146
1147 fr= fmhz/ CVEL;
1148 wlam= CVEL/ fmhz;
1149 fprintf( output_fp, "\n\n\n"
1150 " "
1151 "--------- FREQUENCY --------\n"
1152 " "
1153 "FREQUENCY :%11.4E MHz\n"
1154 " "
1155 "WAVELENGTH:%11.4E Mtr", fmhz, wlam );
1156
1157 fprintf( output_fp, "\n\n"
1158 " "
1159 "APPROXIMATE INTEGRATION EMPLOYED FOR SEGMENTS \n"
1160 " "
1161 "THAT ARE MORE THAN %.3f WAVELENGTHS APART", rkh );
1162
1163 if( iexk == 1)
1164 fprintf( output_fp, "\n"
1165 " "
1166 "THE EXTENDED THIN WIRE KERNEL WILL BE USED" );
1167
1168 /* frequency scaling of geometric parameters */
1169 if( n != 0)
1170 {
1171 for( i = 0; i < n; i++ )
1172 {
1173 x[i]= xtemp[i]* fr;
1174 y[i]= ytemp[i]* fr;
1175 z[i]= ztemp[i]* fr;
1176 si[i]= sitemp[i]* fr;
1177 bi[i]= bitemp[i]* fr;
1178 }
1179 }
1180
1181 if( m != 0)
1182 {
1183 fr2= fr* fr;
1184 for( i = 0; i < m; i++ )
1185 {
1186 j = i+n;
1187 px[i]= xtemp[j]* fr;
1188 py[i]= ytemp[j]* fr;
1189 pz[i]= ztemp[j]* fr;
1190 pbi[i]= bitemp[j]* fr2;
1191 }
1192 }
1193
1194 igo = 2;
1195
1196 /* label 46 */
1197 case 2: /* structure segment loading */
1198 fprintf( output_fp, "\n\n\n"
1199 " "
1200 "------ STRUCTURE IMPEDANCE LOADING ------" );
1201
1202 if( nload != 0)
1203 load( ldtyp, ldtag, ldtagf, ldtagt, zlr, zli, zlc );
1204
1205 if( nload == 0 )
1206 fprintf( output_fp, "\n"
1207 " "
1208 "THIS STRUCTURE IS NOT LOADED" );
1209
1210 fprintf( output_fp, "\n\n\n"
1211 " "
1212 "-------- ANTENNA ENVIRONMENT --------" );
1213
1214 if( ksymp != 1)
1215 {
1216 frati=CPLX_10;
1217
1218 if( iperf != 1)
1219 {
1220 if( sig < 0.)
1221 sig= - sig/(59.96*wlam);
1222
1223 epsc= cmplx( epsr, -sig*wlam*59.96);
1224 zrati=1./ csqrt( epsc);
1225 u= zrati;
1226 u2= u* u;
1227
1228 if( nradl != 0)
1229 {
1230 scrwl= scrwlt/ wlam;
1231 scrwr= scrwrt/ wlam;
1232 t1= CPLX_01*2367.067/ (double)nradl;
1233 t2= scrwr* (double)nradl;
1234
1235 fprintf( output_fp, "\n"
1236 " "
1237 "RADIAL WIRE GROUND SCREEN\n"
1238 " "
1239 "%d WIRES\n"
1240 " "
1241 "WIRE LENGTH: %8.2f METERS\n"
1242 " "
1243 "WIRE RADIUS: %10.3E METERS",
1244 nradl, scrwlt, scrwrt );
1245
1246 fprintf( output_fp, "\n"
1247 " "
1248 "MEDIUM UNDER SCREEN -" );
1249
1250 } /* if( nradl != 0) */
1251
1252 if( iperf != 2)
1253 fprintf( output_fp, "\n"
1254 " "
1255 "FINITE GROUND - REFLECTION COEFFICIENT APPROXIMATION" );
1256 else
1257 {
1258 somnec( epsr, sig, fmhz );
1259 frati=( epsc-1.)/( epsc+1.);
1260 if( cabs(( epscf- epsc)/ epsc) >= 1.0e-3 )
1261 {
1262 fprintf( output_fp,
1263 "\n ERROR IN GROUND PARAMETERS -"
1264 "\n COMPLEX DIELECTRIC CONSTANT FROM FILE IS: %12.5E%+12.5Ej"
1265 "\n REQUESTED: %12.5E%+12.5Ej",
1266 creal(epscf), cimag(epscf), creal(epsc), cimag(epsc) );
1267 stop(-1);
1268 }
1269
1270 fprintf( output_fp, "\n"
1271 " "
1272 "FINITE GROUND - SOMMERFELD SOLUTION" );
1273
1274 } /* if( iperf != 2) */
1275
1276 fprintf( output_fp, "\n"
1277 " "
1278 "RELATIVE DIELECTRIC CONST: %.3f\n"
1279 " "
1280 "CONDUCTIVITY: %10.3E MHOS/METER\n"
1281 " "
1282 "COMPLEX DIELECTRIC CONSTANT: %11.4E%+11.4Ej",
1283 epsr, sig, creal(epsc), cimag(epsc) );
1284
1285 } /* if( iperf != 1) */
1286 else
1287 fprintf( output_fp, "\n"
1288 " "
1289 "PERFECT GROUND" );
1290
1291 } /* if( ksymp != 1) */
1292 else
1293 fprintf( output_fp, "\n"
1294 " "
1295 "FREE SPACE" );
1296
1297 /* label 50 */
1298 /* fill and factor primary interaction matrix */
1299 secnds( &tim1 );
1300 cmset( neq, cm, rkh, iexk );
1301 secnds( &tim2 );
1302 tim= tim2- tim1;
1303 factrs( npeq, neq, cm, ip );
1304 secnds( &tim1 );
1305 tim2= tim1- tim2;
1306 fprintf( output_fp, "\n\n\n"
1307 " "
1308 "---------- MATRIX TIMING ----------\n"
1309 " "
1310 "FILL: %d msec FACTOR: %d msec",
1311 (int)tim, (int)tim2 );
1312
1313 igo=3;
1314 ntsol=0;
1315
1316 /* label 53 */
1317 case 3: /* excitation set up (right hand side, -e inc.) */
1318
1319 nthic=1;
1320 nphic=1;
1321 inc=1;
1322 nprint=0;
1323
1324 /* l_54 */
1325 do
1326 {
1327 if( (ixtyp != 0) && (ixtyp != 5) )
1328 {
1329 if( (iptflg <= 0) || (ixtyp == 4) )
1330 fprintf( output_fp, "\n\n\n"
1331 " "
1332 "---------- EXCITATION ----------" );
1333
1334 tmp5= TA* xpr5;
1335 tmp4= TA* xpr4;
1336
1337 if( ixtyp == 4)
1338 {
1339 tmp1= xpr1/ wlam;
1340 tmp2= xpr2/ wlam;
1341 tmp3= xpr3/ wlam;
1342 tmp6= xpr6/( wlam* wlam);
1343
1344 fprintf( output_fp, "\n"
1345 " "
1346 " CURRENT SOURCE\n"
1347 " -- POSITION (METERS) -- "
1348 " ORIENTATION (DEG)\n"
1349 " X Y Z "
1350 " ALPHA BETA DIPOLE MOMENT\n"
1351 " %10.5f %10.5f %10.5f "
1352 " %7.2f %7.2f %8.3f",
1353 xpr1, xpr2, xpr3, xpr4, xpr5, xpr6 );
1354 }
1355 else
1356 {
1357 tmp1= TA* xpr1;
1358 tmp2= TA* xpr2;
1359 tmp3= TA* xpr3;
1360 tmp6= xpr6;
1361
1362 if( iptflg <= 0)
1363 fprintf( output_fp,
1364 "\n PLANE WAVE - THETA: %7.2f deg, PHI: %7.2f deg,"
1365 " ETA=%7.2f DEG, TYPE - %s AXIAL RATIO: %6.3f",
1366 xpr1, xpr2, xpr3, hpol[ixtyp-1], xpr6 );
1367
1368 } /* if( ixtyp == 4) */
1369
1370 } /* if( (ixtyp != 0) && (ixtyp <= 4) ) */
1371
1372 /* fills e field right-hand matrix */
1373 etmns( tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, ixtyp, cur);
1374
1375 /* matrix solving (netwk calls solves) */
1376 if( (nonet != 0) && (inc <= 1) )
1377 {
1378 fprintf( output_fp, "\n\n\n"
1379 " "
1380 "---------- NETWORK DATA ----------" );
1381
1382 itmp3=0;
1383 itmp1= ntyp[0];
1384
1385 for( i = 0; i < 2; i++ )
1386 {
1387 if( itmp1 == 3)
1388 itmp1=2;
1389
1390 if( itmp1 == 2)
1391 fprintf( output_fp, "\n"
1392 " -- FROM - --- TO -- TRANSMISSION LINE "
1393 " --------- SHUNT ADMITTANCES (MHOS) --------- LINE\n"
1394 " TAG SEG TAG SEG IMPEDANCE LENGTH "
1395 " ----- END ONE ----- ----- END TWO ----- TYPE\n"
1396 " No: No: No: No: OHMS METERS "
1397 " REAL IMAGINARY REAL IMAGINARY" );
1398 else
1399 if( itmp1 == 1)
1400 fprintf( output_fp, "\n"
1401 " -- FROM - --- TO -- --------"
1402 " ADMITTANCE MATRIX ELEMENTS (MHOS) ---------\n"
1403 " TAG SEG TAG SEG ----- (ONE,ONE) ------ "
1404 " ----- (ONE,TWO) ----- ----- (TWO,TWO) -------\n"
1405 " No: No: No: No: REAL IMAGINARY "
1406 " REAL IMAGINARY REAL IMAGINARY" );
1407
1408 for( j = 0; j < nonet; j++)
1409 {
1410 itmp2= ntyp[j];
1411
1412 if( (itmp2/itmp1) != 1 )
1413 itmp3 = itmp2;
1414 else
1415 {
1416 int idx4, idx5;
1417
1418 itmp4= iseg1[j];
1419 itmp5= iseg2[j];
1420 idx4 = itmp4-1;
1421 idx5 = itmp5-1;
1422
1423 if( (itmp2 >= 2) && (x11i[j] <= 0.) )
1424 {
1425 double xx, yy, zz;
1426
1427 xx = x[idx5]- x[idx4];
1428 yy = y[idx5]- y[idx4];
1429 zz = z[idx5]- z[idx4];
1430 x11i[j]= wlam* sqrt( xx*xx + yy*yy + zz*zz );
1431 }
1432
1433 fprintf( output_fp, "\n"
1434 " %4d %5d %4d %5d %11.4E %11.4E %11.4E %11.4E %11.4E %11.4E %s",
1435 itag[idx4], itmp4, itag[idx5], itmp5,
1436 x11r[j], x11i[j], x12r[j], x12i[j],
1437 x22r[j], x22i[j], pnet[itmp2-1] );
1438
1439 } /* if(( itmp2/ itmp1) == 1) */
1440
1441 } /* for( j = 0; j < nonet; j++) */
1442
1443 if( itmp3 == 0)
1444 break;
1445
1446 itmp1= itmp3;
1447
1448 } /* for( j = 0; j < nonet; j++) */
1449
1450 } /* if( (nonet != 0) && (inc <= 1) ) */
1451
1452 if( (inc > 1) && (iptflg > 0) )
1453 nprint=1;
1454
1455 netwk( cm, &cm[ib11], &cm[ic11], &cm[id11], ip, cur );
1456 ntsol=1;
1457
1458 if( iped != 0)
1459 {
1460 itmp1= 4*( mhz-1);
1461
1462 fnorm[itmp1 ]= creal( zped);
1463 fnorm[itmp1+1]= cimag( zped);
1464 fnorm[itmp1+2]= cabs( zped);
1465 fnorm[itmp1+3]= cang( zped);
1466
1467 if( iped != 2 )
1468 {
1469 if( fnorm[itmp1+2] > zpnorm)
1470 zpnorm= fnorm[itmp1+2];
1471 }
1472
1473 } /* if( iped != 0) */
1474
1475 /* printing structure currents */
1476 if( n != 0)
1477 {
1478 if( iptflg != -1)
1479 {
1480 if( iptflg <= 0)
1481 {
1482 fprintf( output_fp, "\n\n\n"
1483 " "
1484 "-------- CURRENTS AND LOCATION --------\n"
1485 " "
1486 "DISTANCES IN WAVELENGTHS" );
1487
1488 fprintf( output_fp, "\n\n"
1489 " SEG TAG COORDINATES OF SEGM CENTER SEGM"
1490 " ------------- CURRENT (AMPS) -------------\n"
1491 " No: No: X Y Z LENGTH"
1492 " REAL IMAGINARY MAGN PHASE" );
1493 }
1494 else
1495 {
1496 if( (iptflg != 3) && (inc <= 1) )
1497 fprintf( output_fp, "\n\n\n"
1498 " -------- RECEIVING PATTERN PARAMETERS --------\n"
1499 " ETA: %7.2f DEGREES\n"
1500 " TYPE: %s\n"
1501 " AXIAL RATIO: %6.3f\n\n"
1502 " THETA PHI ----- CURRENT ---- SEG\n"
1503 " (DEG) (DEG) MAGNITUDE PHASE No:",
1504 xpr3, hpol[ixtyp-1], xpr6 );
1505
1506 } /* if( iptflg <= 0) */
1507
1508 } /* if( iptflg != -1) */
1509
1510 ploss=0.;
1511 itmp1=0;
1512 jump= iptflg+1;
1513
1514 for( i = 0; i < n; i++ )
1515 {
1516 curi= cur[i]* wlam;
1517 cmag= cabs( curi);
1518 ph= cang( curi);
1519
1520 if( (nload != 0) && (fabs(creal(zarray[i])) >= 1.e-20) )
1521 ploss += 0.5* cmag* cmag* creal( zarray[i])* si[i];
1522
1523 if( jump == 0)
1524 continue;
1525
1526 if( jump > 0 )
1527 {
1528 if( (iptag != 0) && (itag[i] != iptag) )
1529 continue;
1530
1531 itmp1++;
1532 if( (itmp1 < iptagf) || (itmp1 > iptagt) )
1533 continue;
1534
1535 if( iptflg != 0)
1536 {
1537 if( iptflg >= 2 )
1538 {
1539 fnorm[inc-1]= cmag;
1540 isave= (i+1);
1541 }
1542
1543 if( iptflg != 3)
1544 {
1545 fprintf( output_fp, "\n"
1546 " %7.2f %7.2f %11.4E %7.2f %5d",
1547 xpr1, xpr2, cmag, ph, i+1 );
1548
1549 continue;
1550 }
1551
1552 } /* if( iptflg != 0) */
1553
1554 } /* if( jump > 0 ) */
1555 else
1556 {
1557 fprintf( output_fp, "\n"
1558 " %5d %4d %9.4f %9.4f %9.4f %9.5f"
1559 " %11.4E %11.4E %11.4E %8.3f",
1560 i+1, itag[i], x[i], y[i], z[i], si[i],
1561 creal(curi), cimag(curi), cmag, ph );
1562
1563 if( iplp1 != 1 )
1564 continue;
1565
1566 if( iplp2 == 1)
1567 fprintf( plot_fp, "%12.4E %12.4E\n", creal(curi), cimag(curi) );
1568 else
1569 if( iplp2 == 2)
1570 fprintf( plot_fp, "%12.4E %12.4E\n", cmag, ph );
1571 }
1572
1573 } /* for( i = 0; i < n; i++ ) */
1574
1575 if( iptflq != -1)
1576 {
1577 fprintf( output_fp, "\n\n\n"
1578 " "
1579 "------ CHARGE DENSITIES ------\n"
1580 " "
1581 " DISTANCES IN WAVELENGTHS\n\n"
1582 " SEG TAG COORDINATES OF SEG CENTER SEG "
1583 " CHARGE DENSITY (COULOMBS/METER)\n"
1584 " NO: NO: X Y Z LENGTH "
1585 " REAL IMAGINARY MAGN PHASE" );
1586
1587 itmp1 = 0;
1588 fr = 1.e-6/fmhz;
1589
1590 for( i = 0; i < n; i++ )
1591 {
1592 if( iptflq != -2 )
1593 {
1594 if( (iptaq != 0) && (itag[i] != iptaq) )
1595 continue;
1596
1597 itmp1++;
1598 if( (itmp1 < iptaqf) || (itmp1 > iptaqt) )
1599 continue;
1600
1601 } /* if( iptflq == -2) */
1602
1603 curi= fr* cmplx(- bii[i], bir[i]);
1604 cmag= cabs( curi);
1605 ph= cang( curi);
1606
1607 fprintf( output_fp, "\n"
1608 " %5d %4d %9.4f %9.4f %9.4f %9.5f"
1609 " %11.4E %11.4E %11.4E %9.3f",
1610 i+1, itag[i], x[i], y[i], z[i], si[i],
1611 creal(curi), cimag(curi), cmag, ph );
1612
1613 } /* for( i = 0; i < n; i++ ) */
1614
1615 } /* if( iptflq != -1) */
1616
1617 } /* if( n != 0) */
1618
1619 if( m != 0)
1620 {
1621 fprintf( output_fp, "\n\n\n"
1622 " "
1623 " --------- SURFACE PATCH CURRENTS ---------\n"
1624 " "
1625 " DISTANCE IN WAVELENGTHS\n"
1626 " "
1627 " CURRENT IN AMPS/METER\n\n"
1628 " ---------"
1629 " SURFACE COMPONENTS -------- "
1630 " ---------------- RECTANGULAR COMPONENTS ----------------\n"
1631 " PCH --- PATCH CENTER --- TANGENT VECTOR 1 "
1632 " TANGENT VECTOR 2 ------- X ------ ------- Y ------ "
1633 " ------- Z ------\n No: X Y Z MAG. "
1634 " PHASE MAG. PHASE REAL IMAGINARY REAL "
1635 " IMAGINARY REAL IMAGINARY" );
1636
1637 j= n-3;
1638 itmp1= -1;
1639
1640 for( i = 0; i < m; i++ )
1641 {
1642 j += 3;
1643 itmp1++;
1644 ex= cur[j];
1645 ey= cur[j+1];
1646 ez= cur[j+2];
1647 eth= ex* t1x[itmp1]+ ey* t1y[itmp1]+ ez* t1z[itmp1];
1648 eph= ex* t2x[itmp1]+ ey* t2y[itmp1]+ ez* t2z[itmp1];
1649 ethm= cabs( eth);
1650 etha= cang( eth);
1651 ephm= cabs( eph);
1652 epha= cang( eph);
1653
1654 fprintf( output_fp, "\n"
1655 " %4d %7.3f %7.3f %7.3f %11.4E %8.2f %11.4E %8.2f"
1656 " %9.2E %9.2E %9.2E %9.2E %9.2E %9.2E",
1657 i+1, px[itmp1], py[itmp1], pz[itmp1],
1658 ethm, etha, ephm, epha, creal(ex), cimag(ex),
1659 creal(ey), cimag(ey), creal(ez), cimag(ez) );
1660
1661 if( iplp1 != 1)
1662 continue;
1663
1664 if( iplp3 == 1)
1665 fprintf( plot_fp, "%12.4E %12.4E\n", creal(ex), cimag(ex) );
1666 if( iplp3 == 2)
1667 fprintf( plot_fp, "%12.4E %12.4E\n", creal(ey), cimag(ey) );
1668 if( iplp3 == 3)
1669 fprintf( plot_fp, "%12.4E %12.4E\n", creal(ez), cimag(ez) );
1670 if( iplp3 == 4)
1671 fprintf( plot_fp, "%12.4E %12.4E %12.4E %12.4E %12.4E %12.4E\n",
1672 creal(ex),cimag(ex),creal(ey),cimag(ey),creal(ez),cimag(ez) );
1673
1674 } /* for( i=0; i<m; i++ ) */
1675
1676 } /* if( m != 0) */
1677
1678 if( (ixtyp == 0) || (ixtyp == 5) )
1679 {
1680 tmp1= pin- pnls- ploss;
1681 tmp2= 100.* tmp1/ pin;
1682
1683 fprintf( output_fp, "\n\n\n"
1684 " "
1685 "---------- POWER BUDGET ---------\n"
1686 " "
1687 "INPUT POWER = %11.4E Watts\n"
1688 " "
1689 "RADIATED POWER= %11.4E Watts\n"
1690 " "
1691 "STRUCTURE LOSS= %11.4E Watts\n"
1692 " "
1693 "NETWORK LOSS = %11.4E Watts\n"
1694 " "
1695 "EFFICIENCY = %7.2f Percent",
1696 pin, tmp1, ploss, pnls, tmp2 );
1697
1698 } /* if( (ixtyp == 0) || (ixtyp == 5) ) */
1699
1700 igo = 4;
1701
1702 if( ncoup > 0)
1703 couple( cur, wlam );
1704
1705 if( iflow == 7)
1706 {
1707 if( (ixtyp > 0) && (ixtyp < 4) )
1708 {
1709 nthic++;
1710 inc++;
1711 xpr1 += xpr4;
1712
1713 if( nthic <= nthi )
1714 continue; /* continue excitation loop */
1715
1716 nthic=1;
1717 xpr1= thetis;
1718 xpr2= xpr2+ xpr5;
1719 nphic++;
1720
1721 if( nphic <= nphi )
1722 continue; /* continue excitation loop */
1723
1724 break;
1725
1726 } /* if( (ixtyp >= 1) && (ixtyp <= 3) ) */
1727
1728 if( nfrq != 1)
1729 {
1730 jmp_floop = TRUE;
1731 break; /* continue the freq loop */
1732 }
1733
1734 fprintf( output_fp, "\n\n\n" );
1735 jmp_iloop = TRUE;
1736
1737 break; /* continue card input loop */
1738
1739 } /*if( iflow == 7) */
1740
1741
1742 case 4: /* label_71 */
1743 igo = 5;
1744
1745 /* label_72 */
1746 case 5: /* near field calculation */
1747
1748 if( near != -1)
1749 {
1750 nfpat();
1751
1752 if( mhz == nfrq)
1753 near=-1;
1754
1755 if( nfrq == 1)
1756 {
1757 fprintf( output_fp, "\n\n\n" );
1758 jmp_iloop = TRUE;
1759 break; /* continue card input loop */
1760 }
1761
1762 } /* if( near != -1) */
1763
1764
1765 /* label_78 */
1766 case 6: /* standard far field calculation */
1767
1768 if( ifar != -1)
1769 {
1770 pinr= pin;
1771 pnlr= pnls;
1772 rdpat();
1773 }
1774
1775 if( (ixtyp == 0) || (ixtyp >= 4) )
1776 {
1777 if( mhz == nfrq )
1778 ifar=-1;
1779
1780 if( nfrq != 1)
1781 {
1782 jmp_floop = TRUE;
1783 break;
1784 }
1785
1786 fprintf( output_fp, "\n\n\n" );
1787 jmp_iloop = TRUE;
1788 break;
1789
1790 } /* if( (ixtyp == 0) || (ixtyp >= 4) ) */
1791
1792 nthic++;
1793 inc++;
1794 xpr1 += xpr4;
1795
1796 if( nthic <= nthi )
1797 continue; /* continue excitation loop */
1798
1799 nthic = 1;
1800 xpr1 = thetis;
1801 xpr2 += xpr5;
1802 nphic++;
1803
1804 if( nphic > nphi )
1805 break;
1806
1807 } /* do (l_54) */
1808 while( TRUE );
1809
1810 /* jump to freq. or input loop */
1811 if( jmp_iloop )
1812 break;
1813
1814 if( jmp_floop )
1815 continue;
1816
1817 nphic = 1;
1818 xpr2 = phiss;
1819
1820 /* normalized receiving pattern printed */
1821 if( iptflg >= 2)
1822 {
1823 itmp1= nthi* nphi;
1824
1825 tmp1= fnorm[0];
1826 for( j = 1; j < itmp1; j++ )
1827 if( fnorm[j] > tmp1)
1828 tmp1= fnorm[j];
1829
1830 fprintf( output_fp, "\n\n\n"
1831 " "
1832 "---- NORMALIZED RECEIVING PATTERN ----\n"
1833 " "
1834 "NORMALIZATION FACTOR: %11.4E\n"
1835 " "
1836 "ETA: %7.2f DEGREES\n"
1837 " "
1838 "TYPE: %s\n"
1839 " AXIAL RATIO: %6.3f\n"
1840 " SEGMENT No: %d\n\n"
1841 " "
1842 "THETA PHI ---- PATTERN ----\n"
1843 " "
1844 "(DEG) (DEG) DB MAGNITUDE",
1845 tmp1, xpr3, hpol[ixtyp-1], xpr6, isave );
1846
1847 for( j = 0; j < nphi; j++ )
1848 {
1849 itmp2= nthi*j;
1850
1851 for( i = 0; i < nthi; i++ )
1852 {
1853 itmp3= i + itmp2;
1854
1855 if( itmp3 < itmp1)
1856 {
1857 tmp2= fnorm[itmp3]/ tmp1;
1858 tmp3= db20( tmp2);
1859
1860 fprintf( output_fp, "\n"
1861 " %7.2f %7.2f %7.2f %11.4E",
1862 xpr1, xpr2, tmp3, tmp2 );
1863
1864 xpr1 += xpr4;
1865 }
1866
1867 } /* for( i = 0; i < nthi; i++ ) */
1868
1869 xpr1= thetis;
1870 xpr2 += xpr5;
1871
1872 } /* for( j = 0; j < nphi; j++ ) */
1873
1874 xpr2= phiss;
1875
1876 } /* if( iptflg >= 2) */
1877
1878 if( mhz == nfrq)
1879 ifar=-1;
1880
1881 if( nfrq == 1)
1882 {
1883 fprintf( output_fp, "\n\n\n" );
1884 jmp_iloop = TRUE;
1885 break; /* continue card input loop */
1886 }
1887
1888 } /*** do (frequency loop) (l_42) ***/
1889 while( (++mhz <= nfrq) );
1890
1891 /* Jump to card input loop */
1892 if( jmp_iloop )
1893 break;
1894
1895 if( iped != 0)
1896 {
1897 int iss;
1898
1899 if( nvqd > 0)
1900 iss = ivqd[nvqd-1];
1901 else
1902 iss = isant[nsant-1];
1903
1904 fprintf( output_fp, "\n\n\n"
1905 " "
1906 " -------- INPUT IMPEDANCE DATA --------\n"
1907 " "
1908 " SOURCE SEGMENT No: %d\n"
1909 " "
1910 " NORMALIZATION FACTOR:%12.5E\n\n"
1911 " ----------- UNNORMALIZED IMPEDANCE ---------- "
1912 " ------------ NORMALIZED IMPEDANCE -----------\n"
1913 " FREQ RESISTANCE REACTANCE MAGNITUDE PHASE "
1914 " RESISTANCE REACTANCE MAGNITUDE PHASE\n"
1915 " MHz OHMS OHMS OHMS DEGREES "
1916 " OHMS OHMS OHMS DEGREES",
1917 iss, zpnorm );
1918
1919 itmp1= nfrq;
1920 if( ifrq == 0)
1921 tmp1= fmhz-( nfrq-1)* delfrq;
1922 else
1923 if( ifrq == 1)
1924 tmp1= fmhz/( pow(delfrq, (nfrq-1)) );
1925
1926 for( i = 0; i < itmp1; i++ )
1927 {
1928 itmp2= 4*i;
1929 tmp2= fnorm[itmp2 ]/ zpnorm;
1930 tmp3= fnorm[itmp2+1]/ zpnorm;
1931 tmp4= fnorm[itmp2+2]/ zpnorm;
1932 tmp5= fnorm[itmp2+3];
1933
1934 fprintf( output_fp, "\n"
1935 " %9.3f %11.4E %11.4E %11.4E %7.2f "
1936 " %11.4E %11.4E %11.4E %7.2f",
1937 tmp1, fnorm[itmp2], fnorm[itmp2+1], fnorm[itmp2+2],
1938 fnorm[itmp2+3], tmp2, tmp3, tmp4, tmp5 );
1939
1940 if( ifrq == 0)
1941 tmp1 += delfrq;
1942 else
1943 if( ifrq == 1)
1944 tmp1 *= delfrq;
1945
1946 } /* for( i = 0; i < itmp1; i++ ) */
1947
1948 fprintf( output_fp, "\n\n\n" );
1949
1950 } /* if( iped != 0) */
1951
1952 nfrq=1;
1953 mhz=1;
1954
1955 } /* switch( igox ) */
1956
1957 } /* while( ! next_job ): Main input section (l_14) */
1958
1959 } /* while(TRUE): Main execution loop (l_1) */
1960
1961 return(0);
1962
1963 } /* end of main() */
1964
1965 /*-----------------------------------------------------------------------*/
1966
1967 /* arc generates segment geometry data for an arc of ns segments */
arc(int itg,int ns,double rada,double ang1,double ang2,double rad)1968 void arc( int itg, int ns, double rada,
1969 double ang1, double ang2, double rad )
1970 {
1971 int ist, i, mreq;
1972 double ang, dang, xs1, xs2, zs1, zs2;
1973
1974 ist= n;
1975 n += ns;
1976 np= n;
1977 mp= m;
1978 ipsym=0;
1979
1980 if( ns < 1)
1981 return;
1982
1983 if( fabs( ang2- ang1) < 360.00001)
1984 {
1985 /* Reallocate tags buffer */
1986 mem_realloc( (void *)&itag, (n+m) * sizeof(int) );
1987
1988 /* Reallocate wire buffers */
1989 mreq = n * sizeof(double);
1990 mem_realloc( (void *)&x, mreq );
1991 mem_realloc( (void *)&y, mreq );
1992 mem_realloc( (void *)&z, mreq );
1993 mem_realloc( (void *)&x2, mreq );
1994 mem_realloc( (void *)&y2, mreq );
1995 mem_realloc( (void *)&z2, mreq );
1996 mem_realloc( (void *)&bi, mreq );
1997
1998 ang= ang1* TA;
1999 dang=( ang2- ang1)* TA/ ns;
2000 xs1= rada* cos( ang);
2001 zs1= rada* sin( ang);
2002
2003 for( i = ist; i < n; i++ )
2004 {
2005 ang += dang;
2006 xs2= rada* cos( ang);
2007 zs2= rada* sin( ang);
2008 x[i]= xs1;
2009 y[i]=0.;
2010 z[i]= zs1;
2011 x2[i]= xs2;
2012 y2[i]=0.;
2013 z2[i]= zs2;
2014 xs1= xs2;
2015 zs1= zs2;
2016 bi[i]= rad;
2017 itag[i]= itg;
2018
2019 } /* for( i = ist; i < n; i++ ) */
2020
2021 } /* if( fabs( ang2- ang1) < 360.00001) */
2022 else
2023 {
2024 fprintf( output_fp, "\n ERROR -- ARC ANGLE EXCEEDS 360 DEGREES");
2025 stop(-1);
2026 }
2027
2028 return;
2029 }
2030
2031 /*-----------------------------------------------------------------------*/
2032
2033 /* atgn2 is arctangent function modified to return 0 when x=y=0. */
atgn2(double x,double y)2034 double atgn2( double x, double y)
2035 {
2036 return( atan2(y, x) );
2037 }
2038
2039 /*-----------------------------------------------------------------------*/
2040
2041 /* cabc computes coefficients of the constant (a), sine (b), and */
2042 /* cosine (c) terms in the current interpolation functions for the */
2043 /* current vector cur. */
cabc(complex double * curx)2044 void cabc( complex double *curx)
2045 {
2046 int i, is, j, jx, jco1, jco2;
2047 double ar, ai, sh;
2048 complex double curd, cs1, cs2;
2049
2050 if( n != 0)
2051 {
2052 for( i = 0; i < n; i++ )
2053 {
2054 air[i]=0.;
2055 aii[i]=0.;
2056 bir[i]=0.;
2057 bii[i]=0.;
2058 cir[i]=0.;
2059 cii[i]=0.;
2060 }
2061
2062 for( i = 0; i < n; i++ )
2063 {
2064 ar= creal( curx[i]);
2065 ai= cimag( curx[i]);
2066 tbf( i+1, 1 );
2067
2068 for( jx = 0; jx < jsno; jx++ )
2069 {
2070 j= jco[jx]-1;
2071 air[j] += ax[jx]* ar;
2072 aii[j] += ax[jx]* ai;
2073 bir[j] += bx[jx]* ar;
2074 bii[j] += bx[jx]* ai;
2075 cir[j] += cx[jx]* ar;
2076 cii[j] += cx[jx]* ai;
2077 }
2078
2079 } /* for( i = 0; i < n; i++ ) */
2080
2081 if( nqds != 0)
2082 {
2083 for( is = 0; is < nqds; is++ )
2084 {
2085 i= iqds[is]-1;
2086 jx= icon1[i];
2087 icon1[i]=0;
2088 tbf(i+1,0);
2089 icon1[i]= jx;
2090 sh= si[i]*.5;
2091 curd= CCJ* vqds[is]/( (log(2.* sh/ bi[i])-1.)*
2092 (bx[jsno-1]* cos(TP* sh)+ cx[jsno-1]* sin(TP* sh))* wlam );
2093 ar= creal( curd);
2094 ai= cimag( curd);
2095
2096 for( jx = 0; jx < jsno; jx++ )
2097 {
2098 j= jco[jx]-1;
2099 air[j]= air[j]+ ax[jx]* ar;
2100 aii[j]= aii[j]+ ax[jx]* ai;
2101 bir[j]= bir[j]+ bx[jx]* ar;
2102 bii[j]= bii[j]+ bx[jx]* ai;
2103 cir[j]= cir[j]+ cx[jx]* ar;
2104 cii[j]= cii[j]+ cx[jx]* ai;
2105 }
2106
2107 } /* for( is = 0; is < nqds; is++ ) */
2108
2109 } /* if( nqds != 0) */
2110
2111 for( i = 0; i < n; i++ )
2112 curx[i]= cmplx( air[i]+cir[i], aii[i]+cii[i] );
2113
2114 } /* if( n != 0) */
2115
2116 if( m == 0)
2117 return;
2118
2119 /* convert surface currents from */
2120 /* t1,t2 components to x,y,z components */
2121 jco1= np2m;
2122 jco2= jco1+ m;
2123 for( i = 1; i <= m; i++ )
2124 {
2125 jco1 -= 2;
2126 jco2 -= 3;
2127 cs1= curx[jco1];
2128 cs2= curx[jco1+1];
2129 curx[jco2] = cs1* t1x[m-i]+ cs2* t2x[m-i];
2130 curx[jco2+1]= cs1* t1y[m-i]+ cs2* t2y[m-i];
2131 curx[jco2+2]= cs1* t1z[m-i]+ cs2* t2z[m-i];
2132 }
2133
2134 return;
2135 }
2136
2137 /*-----------------------------------------------------------------------*/
2138
2139 /* cang returns the phase angle of a complex number in degrees. */
cang(complex double z)2140 double cang( complex double z )
2141 {
2142 return( carg(z)*TD );
2143 }
2144
2145 /*-----------------------------------------------------------------------*/
2146
2147 /* cmset sets up the complex structure matrix in the array cm */
cmset(int nrow,complex double * cm,double rkhx,int iexkx)2148 void cmset( int nrow, complex double *cm, double rkhx, int iexkx )
2149 {
2150 int mp2, neq, npeq, iout, it, i, j, i1, i2, in2;
2151 int im1, im2, ist, ij, ipr, jss, jm1, jm2, jst, k, ka, kk;
2152 complex double zaj, deter, *scm = NULL;
2153
2154 mp2=2* mp;
2155 npeq= np+ mp2;
2156 neq= n+2* m;
2157
2158 rkh= rkhx;
2159 iexk= iexkx;
2160 iout=2* npblk* nrow;
2161 it= nlast;
2162
2163 for( i = 0; i < nrow; i++ )
2164 for( j = 0; j < it; j++ )
2165 cm[i+j*nrow]= CPLX_00;
2166
2167 i1= 1;
2168 i2= it;
2169 in2= i2;
2170
2171 if( in2 > np)
2172 in2= np;
2173
2174 im1= i1- np;
2175 im2= i2- np;
2176
2177 if( im1 < 1)
2178 im1=1;
2179
2180 ist=1;
2181 if( i1 <= np)
2182 ist= np- i1+2;
2183
2184 /* wire source loop */
2185 if( n != 0)
2186 {
2187 for( j = 1; j <= n; j++ )
2188 {
2189 trio(j);
2190 for( i = 0; i < jsno; i++ )
2191 {
2192 ij= jco[i];
2193 jco[i]=(( ij-1)/ np)* mp2+ ij;
2194 }
2195
2196 if( i1 <= in2)
2197 cmww( j, i1, in2, cm, nrow, cm, nrow,1);
2198
2199 if( im1 <= im2)
2200 cmws( j, im1, im2, &cm[(ist-1)*nrow], nrow, cm, nrow, 1);
2201
2202 /* matrix elements modified by loading */
2203 if( nload == 0)
2204 continue;
2205
2206 if( j > np)
2207 continue;
2208
2209 ipr= j;
2210 if( (ipr < 1) || (ipr > it) )
2211 continue;
2212
2213 zaj= zarray[j-1];
2214
2215 for( i = 0; i < jsno; i++ )
2216 {
2217 jss= jco[i];
2218 cm[(jss-1)+(ipr-1)*nrow] -= ( ax[i]+ cx[i])* zaj;
2219 }
2220
2221 } /* for( j = 1; j <= n; j++ ) */
2222
2223 } /* if( n != 0) */
2224
2225 if( m != 0)
2226 {
2227 /* matrix elements for patch current sources */
2228 jm1=1- mp;
2229 jm2=0;
2230 jst=1- mp2;
2231
2232 for( i = 0; i < nop; i++ )
2233 {
2234 jm1 += mp;
2235 jm2 += mp;
2236 jst += npeq;
2237
2238 if( i1 <= in2)
2239 cmsw( jm1, jm2, i1, in2, &cm[(jst-1)], cm, 0, nrow, 1);
2240
2241 if( im1 <= im2)
2242 cmss( jm1, jm2, im1, im2, &cm[(jst-1)+(ist-1)*nrow], nrow, 1);
2243 }
2244
2245 } /* if( m != 0) */
2246
2247 if( icase == 1)
2248 return;
2249
2250 /* Allocate to scratch memory */
2251 mem_alloc( (void *)&scm, np2m * sizeof(complex double) );
2252
2253 /* combine elements for symmetry modes */
2254 for( i = 0; i < it; i++ )
2255 {
2256 for( j = 0; j < npeq; j++ )
2257 {
2258 for( k = 0; k < nop; k++ )
2259 {
2260 ka= j+ k*npeq;
2261 scm[k]= cm[ka+i*nrow];
2262 }
2263
2264 deter= scm[0];
2265
2266 for( kk = 1; kk < nop; kk++ )
2267 deter += scm[kk];
2268
2269 cm[j+i*nrow]= deter;
2270
2271 for( k = 1; k < nop; k++ )
2272 {
2273 ka= j+ k*npeq;
2274 deter= scm[0];
2275
2276 for( kk = 1; kk < nop; kk++ )
2277 {
2278 deter += scm[kk]* ssx[k+kk*nop];
2279 cm[ka+i*nrow]= deter;
2280 }
2281
2282 } /* for( k = 1; k < nop; k++ ) */
2283
2284 } /* for( j = 0; j < npeq; j++ ) */
2285
2286 } /* for( i = 0; i < it; i++ ) */
2287
2288 free_ptr( (void *)&scm );
2289
2290 return;
2291 }
2292
2293 /*-----------------------------------------------------------------------*/
2294
2295 /* cmss computes matrix elements for surface-surface interactions. */
cmss(int j1,int j2,int im1,int im2,complex double * cm,int nrow,int itrp)2296 void cmss( int j1, int j2, int im1, int im2,
2297 complex double *cm, int nrow, int itrp )
2298 {
2299 int i1, i2, icomp, ii1, i, il, ii2, jj1, j, jl, jj2;
2300 double t1xi, t1yi, t1zi, t2xi, t2yi, t2zi, xi, yi, zi;
2301 complex double g11, g12, g21, g22;
2302
2303 i1=( im1+1)/2;
2304 i2=( im2+1)/2;
2305 icomp= i1*2-3;
2306 ii1=-2;
2307 if( icomp+2 < im1)
2308 ii1=-3;
2309
2310 /* loop over observation patches */
2311 il = -1;
2312 for( i = i1; i <= i2; i++ )
2313 {
2314 il++;
2315 icomp += 2;
2316 ii1 += 2;
2317 ii2 = ii1+1;
2318
2319 t1xi= t1x[il]* psalp[il];
2320 t1yi= t1y[il]* psalp[il];
2321 t1zi= t1z[il]* psalp[il];
2322 t2xi= t2x[il]* psalp[il];
2323 t2yi= t2y[il]* psalp[il];
2324 t2zi= t2z[il]* psalp[il];
2325 xi= px[il];
2326 yi= py[il];
2327 zi= pz[il];
2328
2329 /* loop over source patches */
2330 jj1=-2;
2331 for( j = j1; j <= j2; j++ )
2332 {
2333 jl=j-1;
2334 jj1 += 2;
2335 jj2 = jj1+1;
2336
2337 s= pbi[jl];
2338 xj= px[jl];
2339 yj= py[jl];
2340 zj= pz[jl];
2341 t1xj= t1x[jl];
2342 t1yj= t1y[jl];
2343 t1zj= t1z[jl];
2344 t2xj= t2x[jl];
2345 t2yj= t2y[jl];
2346 t2zj= t2z[jl];
2347
2348 hintg( xi, yi, zi);
2349
2350 g11=-( t2xi* exk+ t2yi* eyk+ t2zi* ezk);
2351 g12=-( t2xi* exs+ t2yi* eys+ t2zi* ezs);
2352 g21=-( t1xi* exk+ t1yi* eyk+ t1zi* ezk);
2353 g22=-( t1xi* exs+ t1yi* eys+ t1zi* ezs);
2354
2355 if( i == j )
2356 {
2357 g11 -= .5;
2358 g22 += .5;
2359 }
2360
2361 /* normal fill */
2362 if( itrp == 0)
2363 {
2364 if( icomp >= im1 )
2365 {
2366 cm[ii1+jj1*nrow]= g11;
2367 cm[ii1+jj2*nrow]= g12;
2368 }
2369
2370 if( icomp >= im2 )
2371 continue;
2372
2373 cm[ii2+jj1*nrow]= g21;
2374 cm[ii2+jj2*nrow]= g22;
2375 continue;
2376
2377 } /* if( itrp == 0) */
2378
2379 /* transposed fill */
2380 if( icomp >= im1 )
2381 {
2382 cm[jj1+ii1*nrow]= g11;
2383 cm[jj2+ii1*nrow]= g12;
2384 }
2385
2386 if( icomp >= im2 )
2387 continue;
2388
2389 cm[jj1+ii2*nrow]= g21;
2390 cm[jj2+ii2*nrow]= g22;
2391
2392 } /* for( j = j1; j <= j2; j++ ) */
2393
2394 } /* for( i = i1; i <= i2; i++ ) */
2395
2396 return;
2397 }
2398
2399 /*-----------------------------------------------------------------------*/
2400
2401 /* computes matrix elements for e along wires due to patch current */
cmsw(int j1,int j2,int i1,int i2,complex double * cm,complex double * cw,int ncw,int nrow,int itrp)2402 void cmsw( int j1, int j2, int i1, int i2, complex double *cm,
2403 complex double *cw, int ncw, int nrow, int itrp )
2404 {
2405 int neqs, k, icgo, i, ipch, jl, j, js, il, ip;
2406 int jsnox; /* -1 offset to "jsno" for array indexing */
2407 double xi, yi, zi, cabi, sabi, salpi, fsign=1., pyl, pxl;
2408 complex double emel[9];
2409
2410 neqs= np2m;
2411 jsnox = jsno-1;
2412
2413 if( itrp >= 0)
2414 {
2415 k=-1;
2416 icgo=0;
2417
2418 /* observation loop */
2419 for( i = i1-1; i < i2; i++ )
2420 {
2421 k++;
2422 xi= x[i];
2423 yi= y[i];
2424 zi= z[i];
2425 cabi= cab[i];
2426 sabi= sab[i];
2427 salpi= salp[i];
2428 ipch=0;
2429
2430 if( icon1[i] >= PCHCON)
2431 {
2432 ipch= icon1[i]-PCHCON;
2433 fsign=-1.;
2434 }
2435
2436 if( icon2[i] >= PCHCON)
2437 {
2438 ipch= icon2[i]-PCHCON;
2439 fsign=1.;
2440 }
2441
2442 /* source loop */
2443 jl = -1;
2444 for( j = j1; j <= j2; j++ )
2445 {
2446 jl += 2;
2447 js = j-1;
2448 t1xj= t1x[js];
2449 t1yj= t1y[js];
2450 t1zj= t1z[js];
2451 t2xj= t2x[js];
2452 t2yj= t2y[js];
2453 t2zj= t2z[js];
2454 xj= px[js];
2455 yj= py[js];
2456 zj= pz[js];
2457 s= pbi[js];
2458
2459 /* ground loop */
2460 for( ip = 1; ip <= ksymp; ip++ )
2461 {
2462 ipgnd= ip;
2463
2464 if( ((ipch == j) || (icgo != 0)) && (ip != 2) )
2465 {
2466 if( icgo <= 0 )
2467 {
2468 pcint( xi, yi, zi, cabi, sabi, salpi, emel);
2469
2470 pyl= PI* si[i]* fsign;
2471 pxl= sin( pyl);
2472 pyl= cos( pyl);
2473 exc= emel[8]* fsign;
2474
2475 trio(i+1);
2476
2477 il= i-ncw;
2478 if( i < np)
2479 il += (il/np)*2*mp;
2480
2481 if( itrp == 0 )
2482 cw[k+il*nrow] += exc*( ax[jsnox]+ bx[jsnox]* pxl+ cx[jsnox]* pyl);
2483 else
2484 cw[il+k*nrow] += exc*( ax[jsnox]+ bx[jsnox]* pxl+ cx[jsnox]* pyl);
2485
2486 } /* if( icgo <= 0 ) */
2487
2488 if( itrp == 0)
2489 {
2490 cm[k+(jl-1)*nrow]= emel[icgo];
2491 cm[k+jl*nrow] = emel[icgo+4];
2492 }
2493 else
2494 {
2495 cm[(jl-1)+k*nrow]= emel[icgo];
2496 cm[jl+k*nrow] = emel[icgo+4];
2497 }
2498
2499 icgo++;
2500 if( icgo == 4)
2501 icgo=0;
2502
2503 continue;
2504
2505 } /* if( ((ipch == (j+1)) || (icgo != 0)) && (ip != 2) ) */
2506
2507 unere( xi, yi, zi);
2508
2509 /* normal fill */
2510 if( itrp == 0)
2511 {
2512 cm[k+(jl-1)*nrow] += exk* cabi+ eyk* sabi+ ezk* salpi;
2513 cm[k+jl*nrow] += exs* cabi+ eys* sabi+ ezs* salpi;
2514 continue;
2515 }
2516
2517 /* transposed fill */
2518 cm[(jl-1)+k*nrow] += exk* cabi+ eyk* sabi+ ezk* salpi;
2519 cm[jl+k*nrow] += exs* cabi+ eys* sabi+ ezs* salpi;
2520
2521 } /* for( ip = 1; ip <= ksymp; ip++ ) */
2522
2523 } /* for( j = j1; j <= j2; j++ ) */
2524
2525 } /* for( i = i1-1; i < i2; i++ ) */
2526
2527 } /* if( itrp >= 0) */
2528
2529 return;
2530 }
2531
2532 /*-----------------------------------------------------------------------*/
2533
2534 /* cmws computes matrix elements for wire-surface interactions */
cmws(int j,int i1,int i2,complex double * cm,int nr,complex double * cw,int nw,int itrp)2535 void cmws( int j, int i1, int i2, complex double *cm,
2536 int nr, complex double *cw, int nw, int itrp )
2537 {
2538 int ipr, i, ipatch, ik, js=0, ij, jx;
2539 double xi, yi, zi, tx, ty, tz;
2540 complex double etk, ets, etc;
2541
2542 j--;
2543 s= si[j];
2544 b= bi[j];
2545 xj= x[j];
2546 yj= y[j];
2547 zj= z[j];
2548 cabj= cab[j];
2549 sabj= sab[j];
2550 salpj= salp[j];
2551
2552 /* observation loop */
2553 ipr= -1;
2554 for( i = i1; i <= i2; i++ )
2555 {
2556 ipr++;
2557 ipatch=(i+1)/2;
2558 ik= i-( i/2)*2;
2559
2560 if( (ik != 0) || (ipr == 0) )
2561 {
2562 js= ipatch-1;
2563 xi= px[js];
2564 yi= py[js];
2565 zi= pz[js];
2566 hsfld( xi, yi, zi,0.);
2567
2568 if( ik != 0 )
2569 {
2570 tx= t2x[js];
2571 ty= t2y[js];
2572 tz= t2z[js];
2573 }
2574 else
2575 {
2576 tx= t1x[js];
2577 ty= t1y[js];
2578 tz= t1z[js];
2579 }
2580
2581 } /* if( (ik != 0) || (ipr == 0) ) */
2582 else
2583 {
2584 tx= t1x[js];
2585 ty= t1y[js];
2586 tz= t1z[js];
2587
2588 } /* if( (ik != 0) || (ipr == 0) ) */
2589
2590 etk=-( exk* tx+ eyk* ty+ ezk* tz)* psalp[js];
2591 ets=-( exs* tx+ eys* ty+ ezs* tz)* psalp[js];
2592 etc=-( exc* tx+ eyc* ty+ ezc* tz)* psalp[js];
2593
2594 /* fill matrix elements. element locations */
2595 /* determined by connection data. */
2596
2597 /* normal fill */
2598 if( itrp == 0)
2599 {
2600 for( ij = 0; ij < jsno; ij++ )
2601 {
2602 jx= jco[ij]-1;
2603 cm[ipr+jx*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2604 }
2605
2606 continue;
2607 } /* if( itrp == 0) */
2608
2609 /* transposed fill */
2610 if( itrp != 2)
2611 {
2612 for( ij = 0; ij < jsno; ij++ )
2613 {
2614 jx= jco[ij]-1;
2615 cm[jx+ipr*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2616 }
2617
2618 continue;
2619 } /* if( itrp != 2) */
2620
2621 /* transposed fill - c(ws) and d(ws)prime (=cw) */
2622 for( ij = 0; ij < jsno; ij++ )
2623 {
2624 jx= jco[ij]-1;
2625 if( jx < nr)
2626 cm[jx+ipr*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2627 else
2628 {
2629 jx -= nr;
2630 cw[jx+ipr*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2631 }
2632 } /* for( ij = 0; ij < jsno; ij++ ) */
2633
2634 } /* for( i = i1; i <= i2; i++ ) */
2635
2636 return;
2637 }
2638
2639 /*-----------------------------------------------------------------------*/
2640
2641 /* cmww computes matrix elements for wire-wire interactions */
cmww(int j,int i1,int i2,complex double * cm,int nr,complex double * cw,int nw,int itrp)2642 void cmww( int j, int i1, int i2, complex double *cm,
2643 int nr, complex double *cw, int nw, int itrp)
2644 {
2645 int ipr, iprx, i, ij, jx;
2646 double xi, yi, zi, ai, cabi, sabi, salpi;
2647 complex double etk, ets, etc;
2648
2649 /* set source segment parameters */
2650 jx = j;
2651 j--;
2652 s= si[j];
2653 b= bi[j];
2654 xj= x[j];
2655 yj= y[j];
2656 zj= z[j];
2657 cabj= cab[j];
2658 sabj= sab[j];
2659 salpj= salp[j];
2660
2661 /* decide whether ext. t.w. approx. can be used */
2662 if( iexk != 0)
2663 {
2664 ipr = icon1[j];
2665 if( ipr < 0 )
2666 {
2667 ipr= -ipr;
2668 iprx= ipr-1;
2669
2670 if( -icon1[iprx] != jx )
2671 ind1=2;
2672 else
2673 {
2674 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
2675 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.e-6) )
2676 ind1=2;
2677 else
2678 ind1=0;
2679
2680 } /* if( -icon1[iprx] != jx ) */
2681
2682 } /* if( ipr < 0 ) */
2683 else
2684 {
2685 iprx = ipr-1;
2686 if( ipr == 0 )
2687 ind1=1;
2688 else
2689 {
2690 if( ipr != jx )
2691 {
2692 if( icon2[iprx] != jx )
2693 ind1=2;
2694 else
2695 {
2696 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
2697 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.e-6) )
2698 ind1=2;
2699 else
2700 ind1=0;
2701
2702 } /* if( icon2[iprx] != jx ) */
2703
2704 } /* if( ipr != jx ) */
2705 else
2706 if( cabj* cabj+ sabj* sabj > 1.e-8)
2707 ind1=2;
2708 else
2709 ind1=0;
2710
2711 } /* if( ipr == 0 ) */
2712
2713 } /* if( ipr < 0 ) */
2714
2715 ipr = icon2[j];
2716 if( ipr < 0 )
2717 {
2718 ipr= -ipr;
2719 iprx = ipr-1;
2720 if( -icon2[iprx] != jx )
2721 ind2=2;
2722 else
2723 {
2724 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
2725 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.e-6) )
2726 ind2=2;
2727 else
2728 ind2=0;
2729
2730 } /* if( -icon1[iprx] != jx ) */
2731
2732 } /* if( ipr < 0 ) */
2733 else
2734 {
2735 iprx = ipr-1;
2736 if( ipr == 0 )
2737 ind2=1;
2738 else
2739 {
2740 if( ipr != jx )
2741 {
2742 if( icon1[iprx] != jx )
2743 ind2=2;
2744 else
2745 {
2746 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
2747 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.e-6) )
2748 ind2=2;
2749 else
2750 ind2=0;
2751
2752 } /* if( icon2[iprx] != jx ) */
2753
2754 } /* if( ipr != jx ) */
2755 else
2756 if( cabj* cabj+ sabj* sabj > 1.e-8)
2757 ind2=2;
2758 else
2759 ind2=0;
2760
2761 } /* if( ipr == 0 ) */
2762
2763 } /* if( ipr < 0 ) */
2764
2765 } /* if( iexk != 0) */
2766
2767 /* observation loop */
2768 ipr=-1;
2769 for( i = i1-1; i < i2; i++ )
2770 {
2771 ipr++;
2772 ij= i-j;
2773 xi= x[i];
2774 yi= y[i];
2775 zi= z[i];
2776 ai= bi[i];
2777 cabi= cab[i];
2778 sabi= sab[i];
2779 salpi= salp[i];
2780
2781 efld( xi, yi, zi, ai, ij);
2782
2783 etk= exk* cabi+ eyk* sabi+ ezk* salpi;
2784 ets= exs* cabi+ eys* sabi+ ezs* salpi;
2785 etc= exc* cabi+ eyc* sabi+ ezc* salpi;
2786
2787 /* fill matrix elements. element locations */
2788 /* determined by connection data. */
2789
2790 /* normal fill */
2791 if( itrp == 0)
2792 {
2793 for( ij = 0; ij < jsno; ij++ )
2794 {
2795 jx = jco[ij]-1;
2796 cm[ipr+jx*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2797 }
2798 continue;
2799 }
2800
2801 /* transposed fill */
2802 if( itrp != 2)
2803 {
2804 for( ij = 0; ij < jsno; ij++ )
2805 {
2806 jx= jco[ij]-1;
2807 cm[jx+ipr*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2808 }
2809 continue;
2810 }
2811
2812 /* trans. fill for c(ww) - test for elements for d(ww)prime. (=cw) */
2813 for( ij = 0; ij < jsno; ij++ )
2814 {
2815 jx= jco[ij]-1;
2816 if( jx < nr)
2817 cm[jx+ipr*nr] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2818 else
2819 {
2820 jx -= nr;
2821 cw[jx*ipr*nw] += etk* ax[ij]+ ets* bx[ij]+ etc* cx[ij];
2822 }
2823
2824 } /* for( ij = 0; ij < jsno; ij++ ) */
2825
2826 } /* for( i = i1-1; i < i2; i++ ) */
2827
2828 return;
2829 }
2830
2831 /*-----------------------------------------------------------------------*/
2832
2833 /* connect sets up segment connection data in arrays icon1 and */
2834 /* icon2 by searching for segment ends that are in contact. */
conect(int ignd)2835 void conect( int ignd )
2836 {
2837 int i, iz, ic, j, jx, ix, ixx, iseg, iend, jend, nsflg, jump, ipf;
2838 double sep=0., xi1, yi1, zi1, xi2, yi2, zi2;
2839 double slen, xa, ya, za, xs, ys, zs;
2840
2841 nscon= -1;
2842 maxcon = 1;
2843
2844 if( ignd != 0)
2845 {
2846 fprintf( output_fp, "\n\n GROUND PLANE SPECIFIED." );
2847
2848 if( ignd > 0)
2849 fprintf( output_fp,
2850 "\n WHERE WIRE ENDS TOUCH GROUND, CURRENT WILL"
2851 " BE INTERPOLATED TO IMAGE IN GROUND PLANE.\n" );
2852
2853 if( ipsym == 2)
2854 {
2855 np=2* np;
2856 mp=2* mp;
2857 }
2858
2859 if( abs( ipsym) > 2 )
2860 {
2861 np= n;
2862 mp= m;
2863 }
2864
2865 /*** possibly should be error condition?? **/
2866 if( np > n)
2867 {
2868 fprintf( output_fp,
2869 "\n ERROR: NP > N IN CONECT()" );
2870 stop(-1);
2871 }
2872
2873 if( (np == n) && (mp == m) )
2874 ipsym=0;
2875
2876 } /* if( ignd != 0) */
2877
2878 if( n != 0)
2879 {
2880 /* Allocate memory to connections */
2881 mem_alloc( (void *)&icon1, (n+m) * sizeof(int) );
2882 mem_alloc( (void *)&icon2, (n+m) * sizeof(int) );
2883
2884 for( i = 0; i < n; i++ )
2885 {
2886 iz = i+1;
2887 xi1= x[i];
2888 yi1= y[i];
2889 zi1= z[i];
2890 xi2= x2[i];
2891 yi2= y2[i];
2892 zi2= z2[i];
2893 slen= sqrt( (xi2- xi1)*(xi2- xi1) + (yi2- yi1) *
2894 (yi2- yi1) + (zi2- zi1)*(zi2- zi1) ) * SMIN;
2895
2896 /* determine connection data for end 1 of segment. */
2897 jump = FALSE;
2898 if( ignd > 0)
2899 {
2900 if( zi1 <= -slen)
2901 {
2902 fprintf( output_fp,
2903 "\n GEOMETRY DATA ERROR -- SEGMENT"
2904 " %d EXTENDS BELOW GROUND", iz );
2905 stop(-1);
2906 }
2907
2908 if( zi1 <= slen)
2909 {
2910 icon1[i]= iz;
2911 z[i]=0.;
2912 jump = TRUE;
2913
2914 } /* if( zi1 <= slen) */
2915
2916 } /* if( ignd > 0) */
2917
2918 if( ! jump )
2919 {
2920 ic= i;
2921 for( j = 1; j < n; j++)
2922 {
2923 ic++;
2924 if( ic >= n)
2925 ic=0;
2926
2927 sep= fabs( xi1- x[ic])+ fabs(yi1- y[ic])+ fabs(zi1- z[ic]);
2928 if( sep <= slen)
2929 {
2930 icon1[i]= -(ic+1);
2931 break;
2932 }
2933
2934 sep= fabs( xi1- x2[ic])+ fabs(yi1- y2[ic])+ fabs(zi1- z2[ic]);
2935 if( sep <= slen)
2936 {
2937 icon1[i]= (ic+1);
2938 break;
2939 }
2940
2941 } /* for( j = 1; j < n; j++) */
2942
2943 if( ((iz > 0) || (icon1[i] <= PCHCON)) && (sep > slen) )
2944 icon1[i]=0;
2945
2946 } /* if( ! jump ) */
2947
2948 /* determine connection data for end 2 of segment. */
2949 if( (ignd > 0) || jump )
2950 {
2951 if( zi2 <= -slen)
2952 {
2953 fprintf( output_fp,
2954 "\n GEOMETRY DATA ERROR -- SEGMENT"
2955 " %d EXTENDS BELOW GROUND", iz );
2956 stop(-1);
2957 }
2958
2959 if( zi2 <= slen)
2960 {
2961 if( icon1[i] == iz )
2962 {
2963 fprintf( output_fp,
2964 "\n GEOMETRY DATA ERROR -- SEGMENT"
2965 " %d LIES IN GROUND PLANE", iz );
2966 stop(-1);
2967 }
2968
2969 icon2[i]= iz;
2970 z2[i]=0.;
2971 continue;
2972
2973 } /* if( zi2 <= slen) */
2974
2975 } /* if( ignd > 0) */
2976
2977 ic= i;
2978 for( j = 1; j < n; j++ )
2979 {
2980 ic++;
2981 if( ic >= n)
2982 ic=0;
2983
2984 sep= fabs(xi2- x[ic])+ fabs(yi2- y[ic])+ fabs(zi2- z[ic]);
2985 if( sep <= slen)
2986 {
2987 icon2[i]= (ic+1);
2988 break;
2989 }
2990
2991 sep= fabs(xi2- x2[ic])+ fabs(yi2- y2[ic])+ fabs(zi2- z2[ic]);
2992 if( sep <= slen)
2993 {
2994 icon2[i]= -(ic+1);
2995 break;
2996 }
2997
2998 } /* for( j = 1; j < n; j++ ) */
2999
3000 if( ((iz > 0) || (icon2[i] <= PCHCON)) && (sep > slen) )
3001 icon2[i]=0;
3002
3003 } /* for( i = 0; i < n; i++ ) */
3004
3005 /* find wire-surface connections for new patches */
3006 if( m != 0)
3007 {
3008 ix = -1;
3009 i = 0;
3010 while( ++i <= m )
3011 {
3012 ix++;
3013 xs= px[ix];
3014 ys= py[ix];
3015 zs= pz[ix];
3016
3017 for( iseg = 0; iseg < n; iseg++ )
3018 {
3019 xi1= x[iseg];
3020 yi1= y[iseg];
3021 zi1= z[iseg];
3022 xi2= x2[iseg];
3023 yi2= y2[iseg];
3024 zi2= z2[iseg];
3025
3026 /* for first end of segment */
3027 slen=( fabs(xi2- xi1)+ fabs(yi2- yi1)+ fabs(zi2- zi1))* SMIN;
3028 sep= fabs(xi1- xs)+ fabs(yi1- ys)+ fabs(zi1- zs);
3029
3030 /* connection - divide patch into 4 patches at present array loc. */
3031 if( sep <= slen)
3032 {
3033 icon1[iseg]=PCHCON+ i;
3034 ic=0;
3035 subph( i, ic );
3036 break;
3037 }
3038
3039 sep= fabs(xi2- xs)+ fabs(yi2- ys)+ fabs(zi2- zs);
3040 if( sep <= slen)
3041 {
3042 icon2[iseg]=PCHCON+ i;
3043 ic=0;
3044 subph( i, ic );
3045 break;
3046 }
3047
3048 } /* for( iseg = 0; iseg < n; iseg++ ) */
3049
3050 } /* while( ++i <= m ) */
3051
3052 } /* if( m != 0) */
3053
3054 } /* if( n != 0) */
3055
3056 fprintf( output_fp, "\n\n"
3057 " TOTAL SEGMENTS USED: %d SEGMENTS IN A"
3058 " SYMMETRIC CELL: %d SYMMETRY FLAG: %d",
3059 n, np, ipsym );
3060
3061 if( m > 0)
3062 fprintf( output_fp, "\n"
3063 " TOTAL PATCHES USED: %d PATCHES"
3064 " IN A SYMMETRIC CELL: %d", m, mp );
3065
3066 iseg=( n+ m)/( np+ mp);
3067 if( iseg != 1)
3068 {
3069 /*** may be error condition?? ***/
3070 if( ipsym == 0 )
3071 {
3072 fprintf( output_fp,
3073 "\n ERROR: IPSYM=0 IN CONECT()" );
3074 stop(-1);
3075 }
3076
3077 if( ipsym < 0 )
3078 fprintf( output_fp,
3079 "\n STRUCTURE HAS %d FOLD ROTATIONAL SYMMETRY\n", iseg );
3080 else
3081 {
3082 ic= iseg/2;
3083 if( iseg == 8)
3084 ic=3;
3085 fprintf( output_fp,
3086 "\n STRUCTURE HAS %d PLANES OF SYMMETRY\n", ic );
3087 } /* if( ipsym < 0 ) */
3088
3089 } /* if( iseg == 1) */
3090
3091 if( n == 0)
3092 return;
3093
3094 /* Allocate to connection buffers */
3095 mem_alloc( (void *)&jco, maxcon * sizeof(int) );
3096
3097 /* adjust connected seg. ends to exactly coincide. print junctions */
3098 /* of 3 or more seg. also find old seg. connecting to new seg. */
3099 iseg = 0;
3100 ipf = FALSE;
3101 for( j = 0; j < n; j++ )
3102 {
3103 jx = j+1;
3104 iend=-1;
3105 jend=-1;
3106 ix= icon1[j];
3107 ic=1;
3108 jco[0]= -jx;
3109 xa= x[j];
3110 ya= y[j];
3111 za= z[j];
3112
3113 while( TRUE )
3114 {
3115 if( (ix != 0) && (ix != (j+1)) && (ix <= PCHCON) )
3116 {
3117 nsflg=0;
3118
3119 do
3120 {
3121 if( ix == 0 )
3122 {
3123 fprintf( output_fp,
3124 "\n CONNECT - SEGMENT CONNECTION ERROR FOR SEGMENT: %d", ix );
3125 stop(-1);
3126 }
3127
3128 if( ix < 0 )
3129 ix= -ix;
3130 else
3131 jend= -jend;
3132
3133 jump = FALSE;
3134
3135 if( ix == jx )
3136 break;
3137
3138 if( ix < jx )
3139 {
3140 jump = TRUE;
3141 break;
3142 }
3143
3144 /* Record max. no. of connections */
3145 ic++;
3146 if( ic >= maxcon )
3147 {
3148 maxcon = ic+1;
3149 mem_realloc( (void *)&jco, maxcon * sizeof(int) );
3150 }
3151 jco[ic-1]= ix* jend;
3152
3153 if( ix > 0)
3154 nsflg=1;
3155
3156 ixx = ix-1;
3157 if( jend != 1)
3158 {
3159 xa= xa+ x[ixx];
3160 ya= ya+ y[ixx];
3161 za= za+ z[ixx];
3162 ix= icon1[ixx];
3163 continue;
3164 }
3165
3166 xa= xa+ x2[ixx];
3167 ya= ya+ y2[ixx];
3168 za= za+ z2[ixx];
3169 ix= icon2[ixx];
3170
3171 } /* do */
3172 while( ix != 0 );
3173
3174 if( jump && (iend == 1) )
3175 break;
3176 else
3177 if( jump )
3178 {
3179 iend=1;
3180 jend=1;
3181 ix= icon2[j];
3182 ic=1;
3183 jco[0]= jx;
3184 xa= x2[j];
3185 ya= y2[j];
3186 za= z2[j];
3187 continue;
3188 }
3189
3190 sep= (double)ic;
3191 xa= xa/ sep;
3192 ya= ya/ sep;
3193 za= za/ sep;
3194
3195 for( i = 0; i < ic; i++ )
3196 {
3197 ix= jco[i];
3198 if( ix <= 0)
3199 {
3200 ix= - ix;
3201 ixx = ix-1;
3202 x[ixx]= xa;
3203 y[ixx]= ya;
3204 z[ixx]= za;
3205 continue;
3206 }
3207
3208 ixx = ix-1;
3209 x2[ixx]= xa;
3210 y2[ixx]= ya;
3211 z2[ixx]= za;
3212
3213 } /* for( i = 0; i < ic; i++ ) */
3214
3215 if( ic >= 3)
3216 {
3217 if( ! ipf )
3218 {
3219 fprintf( output_fp, "\n\n"
3220 " ---------- MULTIPLE WIRE JUNCTIONS ----------\n"
3221 " JUNCTION SEGMENTS (- FOR END 1, + FOR END 2)" );
3222 ipf = TRUE;
3223 }
3224
3225 iseg++;
3226 fprintf( output_fp, "\n %5d ", iseg );
3227
3228 for( i = 1; i <= ic; i++ )
3229 {
3230 fprintf( output_fp, "%5d", jco[i-1] );
3231 if( !(i % 20) )
3232 fprintf( output_fp, "\n " );
3233 }
3234
3235 } /* if( ic >= 3) */
3236
3237 } /*if( (ix != 0) && (ix != j) && (ix <= PCHCON) ) */
3238
3239 if( iend == 1)
3240 break;
3241
3242 iend=1;
3243 jend=1;
3244 ix= icon2[j];
3245 ic=1;
3246 jco[0]= jx;
3247 xa= x2[j];
3248 ya= y2[j];
3249 za= z2[j];
3250
3251 } /* while( TRUE ) */
3252
3253 } /* for( j = 0; j < n; j++ ) */
3254
3255 mem_alloc( (void *)&ax, maxcon * sizeof(double) );
3256 mem_alloc( (void *)&bx, maxcon * sizeof(double) );
3257 mem_alloc( (void *)&cx, maxcon * sizeof(double) );
3258
3259 return;
3260 }
3261
3262 /*-----------------------------------------------------------------------*/
3263
3264 /* couple computes the maximum coupling between pairs of segments. */
couple(complex double * cur,double wlam)3265 void couple( complex double *cur, double wlam )
3266 {
3267 int j, j1, j2, l1, i, k, itt1, itt2, its1, its2, isg1, isg2, npm1;
3268 double dbc, c, gmax;
3269 complex double y11, y12, y22, yl, yin, zl, zin, rho;
3270
3271 if( (nsant != 1) || (nvqd != 0) )
3272 return;
3273
3274 j= isegno( nctag[icoup], ncseg[icoup]);
3275 if( j != isant[0] )
3276 return;
3277
3278 zin= vsant[0];
3279 icoup++;
3280 mem_realloc( (void *)&y11a, icoup * sizeof( complex double) );
3281 y11a[icoup-1]= cur[j-1]*wlam/zin;
3282
3283 l1=(icoup-1)*(ncoup-1);
3284 for( i = 0; i < ncoup; i++ )
3285 {
3286 if( (i+1) == icoup)
3287 continue;
3288
3289 l1++;
3290 mem_realloc( (void *)&y12a, l1 * sizeof( complex double) );
3291 k= isegno( nctag[i], ncseg[i]);
3292 y12a[l1-1]= cur[k-1]* wlam/ zin;
3293 }
3294
3295 if( icoup < ncoup)
3296 return;
3297
3298 fprintf( output_fp, "\n\n\n"
3299 " -----------"
3300 " ISOLATION DATA -----------\n\n"
3301 " ------- COUPLING BETWEEN ------ MAXIMUM "
3302 " ---------- FOR MAXIMUM COUPLING ----------\n"
3303 " SEG SEG COUPLING LOAD"
3304 " IMPEDANCE (2ND SEG) INPUT IMPEDANCE \n"
3305 " TAG SEG No: TAG SEG No: (DB) "
3306 " REAL IMAGINARY REAL IMAGINARY" );
3307
3308 npm1= ncoup-1;
3309
3310 for( i = 0; i < npm1; i++ )
3311 {
3312 itt1= nctag[i];
3313 its1= ncseg[i];
3314 isg1= isegno( itt1, its1);
3315 l1= i+1;
3316
3317 for( j = l1; j < ncoup; j++ )
3318 {
3319 itt2= nctag[j];
3320 its2= ncseg[j];
3321 isg2= isegno( itt2, its2);
3322 j1= j+ i* npm1-1;
3323 j2= i+ j* npm1;
3324 y11= y11a[i];
3325 y22= y11a[j];
3326 y12=.5*( y12a[j1]+ y12a[j2]);
3327 yin= y12* y12;
3328 dbc= cabs( yin);
3329 c= dbc/(2.* creal( y11)* creal( y22)- creal( yin));
3330
3331 if( (c >= 0.0) && (c <= 1.0) )
3332 {
3333 if( c >= .01 )
3334 gmax=(1.- sqrt(1.- c*c))/c;
3335 else
3336 gmax=.5*( c+.25* c* c* c);
3337
3338 rho= gmax* conj( yin)/ dbc;
3339 yl=((1.- rho)/(1.+ rho)+1.)* creal( y22)- y22;
3340 zl=1./ yl;
3341 yin= y11- yin/( y22+ yl);
3342 zin=1./ yin;
3343 dbc= db10( gmax);
3344
3345 fprintf( output_fp, "\n"
3346 " %4d %4d %5d %4d %4d %5d %9.3f"
3347 " %12.5E %12.5E %12.5E %12.5E",
3348 itt1, its1, isg1, itt2, its2, isg2, dbc,
3349 creal(zl), cimag(zl), creal(zin), cimag(zin) );
3350
3351 continue;
3352
3353 } /* if( (c >= 0.0) && (c <= 1.0) ) */
3354
3355 fprintf( output_fp, "\n"
3356 " %4d %4d %5d %4d %4d %5d **ERROR** "
3357 "COUPLING IS NOT BETWEEN 0 AND 1. (= %12.5E)",
3358 itt1, its1, isg1, itt2, its2, isg2, c );
3359
3360 } /* for( j = l1; j < ncoup; j++ ) */
3361
3362 } /* for( i = 0; i < npm1; i++ ) */
3363
3364 return;
3365 }
3366
3367 /*-----------------------------------------------------------------------*/
3368
3369 /* datagn is the main routine for input of geometry data. */
datagn(void)3370 void datagn( void )
3371 {
3372 char gm[3];
3373 char ifx[2] = {'*', 'X'}, ify[2]={'*','Y'}, ifz[2]={'*','Z'};
3374 char ipt[4] = { 'P', 'R', 'T', 'Q' };
3375
3376 /* input card mnemonic list */
3377 /* "XT" stands for "exit", added for testing */
3378 #define GM_NUM 12
3379 char *atst[GM_NUM] =
3380 {
3381 "GW", "GX", "GR", "GS", "GE", "GM", \
3382 "SP", "SM", "GA", "SC", "GH", "GF"
3383 };
3384
3385 int nwire, isct, iphd, i1, i2, itg, iy, iz, mreq;
3386 int ix, i, ns, gm_num; /* geometry card id as a number */
3387 double rad, xs1, xs2, ys1, ys2, zs1, zs2, x4=0, y4=0, z4=0;
3388 double x3=0, y3=0, z3=0, xw1, xw2, yw1, yw2, zw1, zw2;
3389 double dummy;
3390
3391 ipsym=0;
3392 nwire=0;
3393 n=0;
3394 np=0;
3395 m=0;
3396 mp=0;
3397 isct=0;
3398 iphd = FALSE;
3399
3400 /* read geometry data card and branch to */
3401 /* section for operation requested */
3402 do
3403 {
3404 readgm( gm, &itg, &ns, &xw1, &yw1, &zw1, &xw2, &yw2, &zw2, &rad);
3405
3406 /* identify card id mnemonic */
3407 for( gm_num = 0; gm_num < GM_NUM; gm_num++ )
3408 if( strncmp( gm, atst[gm_num], 2) == 0 )
3409 break;
3410
3411 if( iphd == FALSE )
3412 {
3413 fprintf( output_fp, "\n\n\n"
3414 " "
3415 "-------- STRUCTURE SPECIFICATION --------\n"
3416 " "
3417 "COORDINATES MUST BE INPUT IN\n"
3418 " "
3419 "METERS OR BE SCALED TO METERS\n"
3420 " "
3421 "BEFORE STRUCTURE INPUT IS ENDED\n" );
3422
3423 fprintf( output_fp, "\n"
3424 " WIRE "
3425 " SEG FIRST LAST TAG\n"
3426 " No: X1 Y1 Z1 X2 "
3427 " Y2 Z2 RADIUS No: SEG SEG No:" );
3428
3429 iphd=1;
3430 }
3431
3432 if( gm_num != 10 )
3433 isct=0;
3434
3435 switch( gm_num )
3436 {
3437 case 0: /* "gw" card, generate segment data for straight wire. */
3438
3439 nwire++;
3440 i1= n+1;
3441 i2= n+ ns;
3442
3443 fprintf( output_fp, "\n"
3444 " %5d %10.4f %10.4f %10.4f %10.4f"
3445 " %10.4f %10.4f %10.4f %5d %5d %5d %4d",
3446 nwire, xw1, yw1, zw1, xw2, yw2, zw2, rad, ns, i1, i2, itg );
3447
3448 if( rad != 0)
3449 {
3450 xs1=1.;
3451 ys1=1.;
3452 }
3453 else
3454 {
3455 readgm( gm, &ix, &iy, &xs1, &ys1, &zs1,
3456 &dummy, &dummy, &dummy, &dummy);
3457
3458 if( strcmp(gm, "GC" ) != 0 )
3459 {
3460 fprintf( output_fp, "\n GEOMETRY DATA CARD ERROR" );
3461 stop(-1);
3462 }
3463
3464 fprintf( output_fp,
3465 "\n ABOVE WIRE IS TAPERED. SEGMENT LENGTH RATIO: %9.5f\n"
3466 " "
3467 "RADIUS FROM: %9.5f TO: %9.5f", xs1, ys1, zs1 );
3468
3469 if( (ys1 == 0) || (zs1 == 0) )
3470 {
3471 fprintf( output_fp, "\n GEOMETRY DATA CARD ERROR" );
3472 stop(-1);
3473 }
3474
3475 rad= ys1;
3476 ys1= pow( (zs1/ys1), (1./(ns-1.)) );
3477 }
3478
3479 wire( xw1, yw1, zw1, xw2, yw2, zw2, rad, xs1, ys1, ns, itg);
3480
3481 continue;
3482
3483 /* reflect structure along x,y, or z */
3484 /* axes or rotate to form cylinder. */
3485 case 1: /* "gx" card */
3486
3487 iy= ns/10;
3488 iz= ns- iy*10;
3489 ix= iy/10;
3490 iy= iy- ix*10;
3491
3492 if( ix != 0)
3493 ix=1;
3494 if( iy != 0)
3495 iy=1;
3496 if( iz != 0)
3497 iz=1;
3498
3499 fprintf( output_fp,
3500 "\n STRUCTURE REFLECTED ALONG THE AXES %c %c %c"
3501 " - TAGS INCREMENTED BY %d\n",
3502 ifx[ix], ify[iy], ifz[iz], itg );
3503
3504 reflc( ix, iy, iz, itg, ns);
3505
3506 continue;
3507
3508 case 2: /* "gr" card */
3509
3510 fprintf( output_fp,
3511 "\n STRUCTURE ROTATED ABOUT Z-AXIS %d TIMES"
3512 " - LABELS INCREMENTED BY %d\n", ns, itg );
3513
3514 ix=-1;
3515 iz = 0;
3516 reflc( ix, iy, iz, itg, ns);
3517
3518 continue;
3519
3520 case 3: /* "gs" card, scale structure dimensions by factor xw1. */
3521
3522 if( n > 0)
3523 {
3524 for( i = 0; i < n; i++ )
3525 {
3526 x[i]= x[i]* xw1;
3527 y[i]= y[i]* xw1;
3528 z[i]= z[i]* xw1;
3529 x2[i]= x2[i]* xw1;
3530 y2[i]= y2[i]* xw1;
3531 z2[i]= z2[i]* xw1;
3532 bi[i]= bi[i]* xw1;
3533 }
3534 } /* if( n >= n2) */
3535
3536 if( m > 0)
3537 {
3538 yw1= xw1* xw1;
3539 for( i = 0; i < m; i++ )
3540 {
3541 px[i]= px[i]* xw1;
3542 py[i]= py[i]* xw1;
3543 pz[i]= pz[i]* xw1;
3544 pbi[i]= pbi[i]* yw1;
3545 }
3546 } /* if( m >= m2) */
3547
3548 fprintf( output_fp,
3549 "\n STRUCTURE SCALED BY FACTOR: %10.5f", xw1 );
3550
3551 continue;
3552
3553 case 4: /* "ge" card, terminate structure geometry input. */
3554
3555 if( ns != 0)
3556 {
3557 iplp1=1;
3558 iplp2=1;
3559 }
3560
3561 conect( itg);
3562
3563 if( n != 0)
3564 {
3565 /* Allocate wire buffers */
3566 mreq = n * sizeof(double);
3567 mem_alloc( (void *)&si, mreq );
3568 mem_alloc( (void *)&sab, mreq );
3569 mem_alloc( (void *)&cab, mreq );
3570 mem_alloc( (void *)&salp, mreq );
3571
3572 fprintf( output_fp, "\n\n\n"
3573 " "
3574 " ---------- SEGMENTATION DATA ----------\n"
3575 " "
3576 " COORDINATES IN METERS\n"
3577 " "
3578 " I+ AND I- INDICATE THE SEGMENTS BEFORE AND AFTER I\n" );
3579
3580 fprintf( output_fp, "\n"
3581 " SEG COORDINATES OF SEGM CENTER SEGM ORIENTATION"
3582 " ANGLES WIRE CONNECTION DATA TAG\n"
3583 " No: X Y Z LENGTH ALPHA "
3584 " BETA RADIUS I- I I+ NO:" );
3585
3586 for( i = 0; i < n; i++ )
3587 {
3588 xw1= x2[i]- x[i];
3589 yw1= y2[i]- y[i];
3590 zw1= z2[i]- z[i];
3591 x[i]=( x[i]+ x2[i])*.5;
3592 y[i]=( y[i]+ y2[i])*.5;
3593 z[i]=( z[i]+ z2[i])*.5;
3594 xw2= xw1* xw1+ yw1* yw1+ zw1* zw1;
3595 yw2= sqrt( xw2);
3596 yw2=( xw2/ yw2+ yw2)*.5;
3597 si[i]= yw2;
3598 cab[i]= xw1/ yw2;
3599 sab[i]= yw1/ yw2;
3600 xw2= zw1/ yw2;
3601
3602 if( xw2 > 1.)
3603 xw2=1.;
3604 if( xw2 < -1.)
3605 xw2=-1.;
3606
3607 salp[i]= xw2;
3608 xw2= asin( xw2)* TD;
3609 yw2= atan2( yw1, xw1)* TD;
3610
3611 fprintf( output_fp, "\n"
3612 " %5d %9.4f %9.4f %9.4f %9.4f"
3613 " %9.4f %9.4f %9.4f %5d %5d %5d %5d",
3614 i+1, x[i], y[i], z[i], si[i], xw2, yw2,
3615 bi[i], icon1[i], i+1, icon2[i], itag[i] );
3616
3617 if( iplp1 == 1)
3618 fprintf( plot_fp, "%12.4E %12.4E %12.4E "
3619 "%12.4E %12.4E %12.4E %12.4E %5d %5d %5d\n",
3620 x[i],y[i],z[i],si[i],xw2,yw2,bi[i],icon1[i],i+1,icon2[i] );
3621
3622 if( (si[i] <= 1.e-20) || (bi[i] <= 0.) )
3623 {
3624 fprintf( output_fp, "\n SEGMENT DATA ERROR" );
3625 stop(-1);
3626 }
3627
3628 } /* for( i = 0; i < n; i++ ) */
3629
3630 } /* if( n != 0) */
3631
3632 if( m != 0)
3633 {
3634 fprintf( output_fp, "\n\n\n"
3635 " "
3636 " --------- SURFACE PATCH DATA ---------\n"
3637 " "
3638 " COORDINATES IN METERS\n\n"
3639 " PATCH COORD. OF PATCH CENTER UNIT NORMAL VECTOR "
3640 " PATCH COMPONENTS OF UNIT TANGENT VECTORS\n"
3641 " NO: X Y Z X Y Z "
3642 " AREA X1 Y1 Z1 X2 Y2 Z2" );
3643
3644 for( i = 0; i < m; i++ )
3645 {
3646 xw1=( t1y[i]* t2z[i]- t1z[i]* t2y[i])* psalp[i];
3647 yw1=( t1z[i]* t2x[i]- t1x[i]* t2z[i])* psalp[i];
3648 zw1=( t1x[i]* t2y[i]- t1y[i]* t2x[i])* psalp[i];
3649
3650 fprintf( output_fp, "\n"
3651 " %4d %10.5f %10.5f %10.5f %8.4f %8.4f %8.4f"
3652 " %10.5f %8.4f %8.4f %8.4f %8.4f %8.4f %8.4f",
3653 i+1, px[i], py[i], pz[i], xw1, yw1, zw1, pbi[i],
3654 t1x[i], t1y[i], t1z[i], t2x[i], t2y[i], t2z[i] );
3655
3656 } /* for( i = 0; i < m; i++ ) */
3657
3658 } /* if( m == 0) */
3659
3660 npm = n+m;
3661 np2m = n+2*m;
3662 np3m = n+3*m;
3663
3664 return;
3665
3666 /* "gm" card, move structure or reproduce */
3667 /* original structure in new positions. */
3668 case 5:
3669
3670 fprintf( output_fp,
3671 "\n THE STRUCTURE HAS BEEN MOVED, MOVE DATA CARD IS:\n"
3672 " %3d %5d %10.5f %10.5f %10.5f %10.5f %10.5f %10.5f %10.5f",
3673 itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, rad );
3674
3675 xw1= xw1* TA;
3676 yw1= yw1* TA;
3677 zw1= zw1* TA;
3678
3679 move( xw1, yw1, zw1, xw2, yw2, zw2, (int)( rad+.5), ns, itg);
3680 continue;
3681
3682 case 6: /* "sp" card, generate single new patch */
3683
3684 i1= m+1;
3685 ns++;
3686
3687 if( itg != 0)
3688 {
3689 fprintf( output_fp, "\n PATCH DATA ERROR" );
3690 stop(-1);
3691 }
3692
3693 fprintf( output_fp, "\n"
3694 " %5d%c %10.5f %10.5f %10.5f %10.5f %10.5f %10.5f",
3695 i1, ipt[ns-1], xw1, yw1, zw1, xw2, yw2, zw2 );
3696
3697 if( (ns == 2) || (ns == 4) )
3698 isct=1;
3699
3700 if( ns > 1)
3701 {
3702 readgm( gm, &ix, &iy, &x3, &y3, &z3, &x4, &y4, &z4, &dummy);
3703
3704 if( (ns == 2) || (itg > 0) )
3705 {
3706 x4= xw1+ x3- xw2;
3707 y4= yw1+ y3- yw2;
3708 z4= zw1+ z3- zw2;
3709 }
3710
3711 fprintf( output_fp, "\n"
3712 " %11.5f %11.5f %11.5f %11.5f %11.5f %11.5f",
3713 x3, y3, z3, x4, y4, z4 );
3714
3715 if( strcmp(gm, "SC") != 0 )
3716 {
3717 fprintf( output_fp, "\n PATCH DATA ERROR" );
3718 stop(-1);
3719 }
3720
3721 } /* if( ns > 1) */
3722 else
3723 {
3724 xw2= xw2* TA;
3725 yw2= yw2* TA;
3726 }
3727
3728 patch( itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, x3, y3, z3, x4, y4, z4);
3729
3730 continue;
3731
3732 case 7: /* "sm" card, generate multiple-patch surface */
3733
3734 i1= m+1;
3735 fprintf( output_fp, "\n"
3736 " %5d%c %10.5f %11.5f %11.5f %11.5f %11.5f %11.5f"
3737 " SURFACE - %d BY %d PATCHES",
3738 i1, ipt[1], xw1, yw1, zw1, xw2, yw2, zw2, itg, ns );
3739
3740 if( (itg < 1) || (ns < 1) )
3741 {
3742 fprintf( output_fp, "\n PATCH DATA ERROR" );
3743 stop(-1);
3744 }
3745
3746 readgm( gm, &ix, &iy, &x3, &y3, &z3, &x4, &y4, &z4, &dummy);
3747
3748 if( (ns == 2) || (itg > 0) )
3749 {
3750 x4= xw1+ x3- xw2;
3751 y4= yw1+ y3- yw2;
3752 z4= zw1+ z3- zw2;
3753 }
3754
3755 fprintf( output_fp, "\n"
3756 " %11.5f %11.5f %11.5f %11.5f %11.5f %11.5f",
3757 x3, y3, z3, x4, y4, z4 );
3758
3759 if( strcmp(gm, "SC" ) != 0 )
3760 {
3761 fprintf( output_fp, "\n PATCH DATA ERROR" );
3762 stop(-1);
3763 }
3764
3765 patch( itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, x3, y3, z3, x4, y4, z4);
3766
3767 continue;
3768
3769 case 8: /* "ga" card, generate segment data for wire arc */
3770
3771 nwire++;
3772 i1= n+1;
3773 i2= n+ ns;
3774
3775 fprintf( output_fp, "\n"
3776 " %5d ARC RADIUS: %9.5f FROM: %8.3f TO: %8.3f DEGREES"
3777 " %11.5f %5d %5d %5d %4d",
3778 nwire, xw1, yw1, zw1, xw2, ns, i1, i2, itg );
3779
3780 arc( itg, ns, xw1, yw1, zw1, xw2);
3781
3782 continue;
3783
3784 case 9: /* "sc" card */
3785
3786 if( isct == 0)
3787 {
3788 fprintf( output_fp, "\n PATCH DATA ERROR" );
3789 stop(-1);
3790 }
3791
3792 i1= m+1;
3793 ns++;
3794
3795 if( (itg != 0) || ((ns != 2) && (ns != 4)) )
3796 {
3797 fprintf( output_fp, "\n PATCH DATA ERROR" );
3798 stop(-1);
3799 }
3800
3801 xs1= x4;
3802 ys1= y4;
3803 zs1= z4;
3804 xs2= x3;
3805 ys2= y3;
3806 zs2= z3;
3807 x3= xw1;
3808 y3= yw1;
3809 z3= zw1;
3810
3811 if( ns == 4)
3812 {
3813 x4= xw2;
3814 y4= yw2;
3815 z4= zw2;
3816 }
3817
3818 xw1= xs1;
3819 yw1= ys1;
3820 zw1= zs1;
3821 xw2= xs2;
3822 yw2= ys2;
3823 zw2= zs2;
3824
3825 if( ns != 4)
3826 {
3827 x4= xw1+ x3- xw2;
3828 y4= yw1+ y3- yw2;
3829 z4= zw1+ z3- zw2;
3830 }
3831
3832 fprintf( output_fp, "\n"
3833 " %5d%c %10.5f %11.5f %11.5f %11.5f %11.5f %11.5f",
3834 i1, ipt[ns-1], xw1, yw1, zw1, xw2, yw2, zw2 );
3835
3836 fprintf( output_fp, "\n"
3837 " %11.5f %11.5f %11.5f %11.5f %11.5f %11.5f",
3838 x3, y3, z3, x4, y4, z4 );
3839
3840 patch( itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, x3, y3, z3, x4, y4, z4);
3841
3842 continue;
3843
3844 case 10: /* "gh" card, generate helix */
3845
3846 nwire++;
3847 i1= n+1;
3848 i2= n+ ns;
3849
3850 fprintf( output_fp, "\n"
3851 " %5d HELIX STRUCTURE - SPACING OF TURNS: %8.3f AXIAL"
3852 " LENGTH: %8.3f %8.3f %5d %5d %5d %4d\n "
3853 " RADIUS X1:%8.3f Y1:%8.3f X2:%8.3f Y2:%8.3f ",
3854 nwire, xw1, yw1, rad, ns, i1, i2, itg, zw1, xw2, yw2, zw2 );
3855
3856 helix( xw1, yw1, zw1, xw2, yw2, zw2, rad, ns, itg);
3857
3858 continue;
3859
3860 case 11: /* "gf" card, not supported */
3861 abort_on_error(-5);
3862
3863 default: /* error message */
3864
3865 fprintf( output_fp, "\n GEOMETRY DATA CARD ERROR" );
3866 fprintf( output_fp, "\n"
3867 " %2s %3d %5d %10.5f %10.5f %10.5f %10.5f %10.5f %10.5f %10.5f",
3868 gm, itg, ns, xw1, yw1, zw1, xw2, yw2, zw2, rad );
3869
3870 stop(-1);
3871
3872 } /* switch( gm_num ) */
3873
3874 } /* do */
3875 while( TRUE );
3876
3877 return;
3878 }
3879
3880 /*-----------------------------------------------------------------------*/
3881
3882 /* function db10 returns db for magnitude (field) */
db10(double x)3883 double db10( double x )
3884 {
3885 if( x < 1.e-20 )
3886 return( -999.99 );
3887
3888 return( 10. * log10(x) );
3889 }
3890
3891 /*-----------------------------------------------------------------------*/
3892
3893 /* function db20 returns db for mag**2 (power) i */
db20(double x)3894 double db20( double x )
3895 {
3896 if( x < 1.e-20 )
3897 return( -999.99 );
3898
3899 return( 20. * log10(x) );
3900 }
3901
3902 /*-----------------------------------------------------------------------*/
3903
3904 /* compute near e fields of a segment with sine, cosine, and */
3905 /* constant currents. ground effect included. */
efld(double xi,double yi,double zi,double ai,int ij)3906 void efld( double xi, double yi, double zi, double ai, int ij )
3907 {
3908 #define txk egnd[0]
3909 #define tyk egnd[1]
3910 #define tzk egnd[2]
3911 #define txs egnd[3]
3912 #define tys egnd[4]
3913 #define tzs egnd[5]
3914 #define txc egnd[6]
3915 #define tyc egnd[7]
3916 #define tzc egnd[8]
3917
3918 int ip;
3919 double xij, yij, ijx, rfl, salpr, zij, zp, rhox;
3920 double rhoy, rhoz, rh, r, rmag, cth, px, py;
3921 double xymag, xspec, yspec, rhospc, dmin, shaf;
3922 complex double epx, epy, refs, refps, zrsin, zratx, zscrn;
3923 complex double tezs, ters, tezc, terc, tezk, terk, egnd[9];
3924
3925 xij= xi- xj;
3926 yij= yi- yj;
3927 ijx= ij;
3928 rfl=-1.;
3929
3930 for( ip = 0; ip < ksymp; ip++ )
3931 {
3932 if( ip == 1)
3933 ijx=1;
3934 rfl= - rfl;
3935 salpr= salpj* rfl;
3936 zij= zi- rfl* zj;
3937 zp= xij* cabj+ yij* sabj+ zij* salpr;
3938 rhox= xij- cabj* zp;
3939 rhoy= yij- sabj* zp;
3940 rhoz= zij- salpr* zp;
3941
3942 rh= sqrt( rhox* rhox+ rhoy* rhoy+ rhoz* rhoz+ ai* ai);
3943 if( rh <= 1.e-10)
3944 {
3945 rhox=0.;
3946 rhoy=0.;
3947 rhoz=0.;
3948 }
3949 else
3950 {
3951 rhox= rhox/ rh;
3952 rhoy= rhoy/ rh;
3953 rhoz= rhoz/ rh;
3954 }
3955
3956 /* lumped current element approx. for large separations */
3957 r= sqrt( zp* zp+ rh* rh);
3958 if( r >= rkh)
3959 {
3960 rmag= TP* r;
3961 cth= zp/ r;
3962 px= rh/ r;
3963 txk= cmplx( cos( rmag),- sin( rmag));
3964 py= TP* r* r;
3965 tyk= ETA* cth* txk* cmplx(1.0,-1.0/ rmag)/ py;
3966 tzk= ETA* px* txk* cmplx(1.0, rmag-1.0/ rmag)/(2.* py);
3967 tezk= tyk* cth- tzk* px;
3968 terk= tyk* px+ tzk* cth;
3969 rmag= sin( PI* s)/ PI;
3970 tezc= tezk* rmag;
3971 terc= terk* rmag;
3972 tezk= tezk* s;
3973 terk= terk* s;
3974 txs=CPLX_00;
3975 tys=CPLX_00;
3976 tzs=CPLX_00;
3977
3978 } /* if( r >= rkh) */
3979
3980 if( r < rkh)
3981 {
3982 /* eksc for thin wire approx. or ekscx for extended t.w. approx. */
3983 if( iexk != 1)
3984 eksc( s, zp, rh, TP, ijx, &tezs, &ters,
3985 &tezc, &terc, &tezk, &terk );
3986 else
3987 ekscx( b, s, zp, rh, TP, ijx, ind1, ind2,
3988 &tezs, &ters, &tezc, &terc, &tezk, &terk);
3989
3990 txs= tezs* cabj+ ters* rhox;
3991 tys= tezs* sabj+ ters* rhoy;
3992 tzs= tezs* salpr+ ters* rhoz;
3993
3994 } /* if( r < rkh) */
3995
3996 txk= tezk* cabj+ terk* rhox;
3997 tyk= tezk* sabj+ terk* rhoy;
3998 tzk= tezk* salpr+ terk* rhoz;
3999 txc= tezc* cabj+ terc* rhox;
4000 tyc= tezc* sabj+ terc* rhoy;
4001 tzc= tezc* salpr+ terc* rhoz;
4002
4003 if( ip == 1)
4004 {
4005 if( iperf <= 0)
4006 {
4007 zratx= zrati;
4008 rmag= r;
4009 xymag= sqrt( xij* xij+ yij* yij);
4010
4011 /* set parameters for radial wire ground screen. */
4012 if( nradl != 0)
4013 {
4014 xspec=( xi* zj+ zi* xj)/( zi+ zj);
4015 yspec=( yi* zj+ zi* yj)/( zi+ zj);
4016 rhospc= sqrt( xspec* xspec+ yspec* yspec+ t2* t2);
4017
4018 if( rhospc <= scrwl)
4019 {
4020 zscrn= t1* rhospc* log( rhospc/ t2);
4021 zratx=( zscrn* zrati)/( ETA* zrati+ zscrn);
4022 }
4023 } /* if( nradl != 0) */
4024
4025 /* calculation of reflection coefficients when ground is specified. */
4026 if( xymag <= 1.0e-6)
4027 {
4028 px=0.;
4029 py=0.;
4030 cth=1.;
4031 zrsin=CPLX_10;
4032 }
4033 else
4034 {
4035 px= - yij/ xymag;
4036 py= xij/ xymag;
4037 cth= zij/ rmag;
4038 zrsin= csqrt(1.0 - zratx*zratx*(1.0 - cth*cth) );
4039
4040 } /* if( xymag <= 1.0e-6) */
4041
4042 refs=( cth- zratx* zrsin)/( cth+ zratx* zrsin);
4043 refps=-( zratx* cth- zrsin)/( zratx* cth+ zrsin);
4044 refps= refps- refs;
4045 epy= px* txk+ py* tyk;
4046 epx= px* epy;
4047 epy= py* epy;
4048 txk= refs* txk+ refps* epx;
4049 tyk= refs* tyk+ refps* epy;
4050 tzk= refs* tzk;
4051 epy= px* txs+ py* tys;
4052 epx= px* epy;
4053 epy= py* epy;
4054 txs= refs* txs+ refps* epx;
4055 tys= refs* tys+ refps* epy;
4056 tzs= refs* tzs;
4057 epy= px* txc+ py* tyc;
4058 epx= px* epy;
4059 epy= py* epy;
4060 txc= refs* txc+ refps* epx;
4061 tyc= refs* tyc+ refps* epy;
4062 tzc= refs* tzc;
4063
4064 } /* if( iperf <= 0) */
4065
4066 exk= exk- txk* frati;
4067 eyk= eyk- tyk* frati;
4068 ezk= ezk- tzk* frati;
4069 exs= exs- txs* frati;
4070 eys= eys- tys* frati;
4071 ezs= ezs- tzs* frati;
4072 exc= exc- txc* frati;
4073 eyc= eyc- tyc* frati;
4074 ezc= ezc- tzc* frati;
4075 continue;
4076
4077 } /* if( ip == 1) */
4078
4079 exk= txk;
4080 eyk= tyk;
4081 ezk= tzk;
4082 exs= txs;
4083 eys= tys;
4084 ezs= tzs;
4085 exc= txc;
4086 eyc= tyc;
4087 ezc= tzc;
4088
4089 } /* for( ip = 0; ip < ksymp; ip++ ) */
4090
4091 if( iperf != 2)
4092 return;
4093
4094 /* field due to ground using sommerfeld/norton */
4095 sn= sqrt( cabj* cabj+ sabj* sabj);
4096 if( sn >= 1.0e-5)
4097 {
4098 xsn= cabj/ sn;
4099 ysn= sabj/ sn;
4100 }
4101 else
4102 {
4103 sn=0.;
4104 xsn=1.;
4105 ysn=0.;
4106 }
4107
4108 /* displace observation point for thin wire approximation */
4109 zij= zi+ zj;
4110 salpr= - salpj;
4111 rhox= sabj* zij- salpr* yij;
4112 rhoy= salpr* xij- cabj* zij;
4113 rhoz= cabj* yij- sabj* xij;
4114 rh= rhox* rhox+ rhoy* rhoy+ rhoz* rhoz;
4115
4116 if( rh <= 1.e-10)
4117 {
4118 xo= xi- ai* ysn;
4119 yo= yi+ ai* xsn;
4120 zo= zi;
4121 }
4122 else
4123 {
4124 rh= ai/ sqrt( rh);
4125 if( rhoz < 0.)
4126 rh= - rh;
4127 xo= xi+ rh* rhox;
4128 yo= yi+ rh* rhoy;
4129 zo= zi+ rh* rhoz;
4130
4131 } /* if( rh <= 1.e-10) */
4132
4133 r= xij* xij+ yij* yij+ zij* zij;
4134 if( r <= .95)
4135 {
4136 /* field from interpolation is integrated over segment */
4137 isnor=1;
4138 dmin= exk* conj( exk)+ eyk* conj( eyk)+ ezk* conj( ezk);
4139 dmin=.01* sqrt( dmin);
4140 shaf=.5* s;
4141 rom2(- shaf, shaf, egnd, dmin);
4142 }
4143 else
4144 {
4145 /* norton field equations and lumped current element approximation */
4146 isnor=2;
4147 sflds(0., egnd);
4148 } /* if( r <= .95) */
4149
4150 if( r > .95)
4151 {
4152 zp= xij* cabj+ yij* sabj+ zij* salpr;
4153 rh= r- zp* zp;
4154 if( rh <= 1.e-10)
4155 dmin=0.;
4156 else
4157 dmin= sqrt( rh/( rh+ ai* ai));
4158
4159 if( dmin <= .95)
4160 {
4161 px=1.- dmin;
4162 terk=( txk* cabj+ tyk* sabj+ tzk* salpr)* px;
4163 txk= dmin* txk+ terk* cabj;
4164 tyk= dmin* tyk+ terk* sabj;
4165 tzk= dmin* tzk+ terk* salpr;
4166 ters=( txs* cabj+ tys* sabj+ tzs* salpr)* px;
4167 txs= dmin* txs+ ters* cabj;
4168 tys= dmin* tys+ ters* sabj;
4169 tzs= dmin* tzs+ ters* salpr;
4170 terc=( txc* cabj+ tyc* sabj+ tzc* salpr)* px;
4171 txc= dmin* txc+ terc* cabj;
4172 tyc= dmin* tyc+ terc* sabj;
4173 tzc= dmin* tzc+ terc* salpr;
4174
4175 } /* if( dmin <= .95) */
4176
4177 } /* if( r > .95) */
4178
4179 exk= exk+ txk;
4180 eyk= eyk+ tyk;
4181 ezk= ezk+ tzk;
4182 exs= exs+ txs;
4183 eys= eys+ tys;
4184 ezs= ezs+ tzs;
4185 exc= exc+ txc;
4186 eyc= eyc+ tyc;
4187 ezc= ezc+ tzc;
4188
4189 return;
4190 }
4191
4192 /*-----------------------------------------------------------------------*/
4193
4194 /* compute e field of sine, cosine, and constant */
4195 /* current filaments by thin wire approximation. */
eksc(double s,double z,double rh,double xk,int ij,complex double * ezs,complex double * ers,complex double * ezc,complex double * erc,complex double * ezk,complex double * erk)4196 void eksc( double s, double z, double rh, double xk, int ij,
4197 complex double *ezs, complex double *ers, complex double *ezc,
4198 complex double *erc, complex double *ezk, complex double *erk )
4199 {
4200 double rhk, sh, shk, ss, cs, z1a, z2a, cint, sint;
4201 complex double gz1, gz2, gp1, gp2, gzp1, gzp2;
4202
4203 ija= ij;
4204 zpk= xk* z;
4205 rhk= xk* rh;
4206 rkb2= rhk* rhk;
4207 sh=.5* s;
4208 shk= xk* sh;
4209 ss= sin( shk);
4210 cs= cos( shk);
4211 z2a= sh- z;
4212 z1a=-( sh+ z);
4213 gx( z1a, rh, xk, &gz1, &gp1);
4214 gx( z2a, rh, xk, &gz2, &gp2);
4215 gzp1= gp1* z1a;
4216 gzp2= gp2* z2a;
4217 *ezs= CONST1*(( gz2- gz1)* cs* xk-( gzp2+ gzp1)* ss);
4218 *ezc= - CONST1*(( gz2+ gz1)* ss* xk+( gzp2- gzp1)* cs);
4219 *erk= CONST1*( gp2- gp1)* rh;
4220 intx(- shk, shk, rhk, ij, &cint, &sint);
4221 *ezk= - CONST1*( gzp2- gzp1+ xk* xk* cmplx( cint,- sint));
4222 gzp1= gzp1* z1a;
4223 gzp2= gzp2* z2a;
4224
4225 if( rh >= 1.0e-10)
4226 {
4227 *ers= - CONST1*(( gzp2+ gzp1+ gz2+ gz1)*
4228 ss-( z2a* gz2- z1a* gz1)* cs*xk)/ rh;
4229 *erc= - CONST1*(( gzp2- gzp1+ gz2- gz1)*
4230 cs+( z2a* gz2+ z1a* gz1)* ss*xk)/ rh;
4231 return;
4232 }
4233
4234 *ers = CPLX_00;
4235 *erc = CPLX_00;
4236
4237 return;
4238 }
4239
4240 /*-----------------------------------------------------------------------*/
4241
4242 /* compute e field of sine, cosine, and constant current */
4243 /* filaments by extended thin wire approximation. */
ekscx(double bx,double s,double z,double rhx,double xk,int ij,int inx1,int inx2,complex double * ezs,complex double * ers,complex double * ezc,complex double * erc,complex double * ezk,complex double * erk)4244 void ekscx( double bx, double s, double z,
4245 double rhx, double xk, int ij, int inx1, int inx2,
4246 complex double *ezs, complex double *ers, complex double *ezc,
4247 complex double *erc, complex double *ezk, complex double *erk )
4248 {
4249 int ira;
4250 double b, rh, sh, rhk, shk, ss, cs, z1a;
4251 double z2a, a2, bk, bk2, cint, sint;
4252 complex double gz1, gz2, gzp1, gzp2, gr1, gr2;
4253 complex double grp1, grp2, grk1, grk2, gzz1, gzz2;
4254
4255 if( rhx >= bx)
4256 {
4257 rh= rhx;
4258 b= bx;
4259 ira=0;
4260 }
4261 else
4262 {
4263 rh= bx;
4264 b= rhx;
4265 ira=1;
4266 }
4267
4268 sh=.5* s;
4269 ija= ij;
4270 zpk= xk* z;
4271 rhk= xk* rh;
4272 rkb2= rhk* rhk;
4273 shk= xk* sh;
4274 ss= sin( shk);
4275 cs= cos( shk);
4276 z2a= sh- z;
4277 z1a=-( sh+ z);
4278 a2= b* b;
4279
4280 if( inx1 != 2)
4281 gxx( z1a, rh, b, a2, xk, ira, &gz1,
4282 &gzp1, &gr1, &grp1, &grk1, &gzz1);
4283 else
4284 {
4285 gx( z1a, rhx, xk, &gz1, &grk1);
4286 gzp1= grk1* z1a;
4287 gr1= gz1/ rhx;
4288 grp1= gzp1/ rhx;
4289 grk1= grk1* rhx;
4290 gzz1= CPLX_00;
4291 }
4292
4293 if( inx2 != 2)
4294 gxx( z2a, rh, b, a2, xk, ira, &gz2,
4295 &gzp2, &gr2, &grp2, &grk2, &gzz2);
4296 else
4297 {
4298 gx( z2a, rhx, xk, &gz2, &grk2);
4299 gzp2= grk2* z2a;
4300 gr2= gz2/ rhx;
4301 grp2= gzp2/ rhx;
4302 grk2= grk2* rhx;
4303 gzz2= CPLX_00;
4304 }
4305
4306 *ezs= CONST1*(( gz2- gz1)* cs* xk-( gzp2+ gzp1)* ss);
4307 *ezc= - CONST1*(( gz2+ gz1)* ss* xk+( gzp2- gzp1)* cs);
4308 *ers= - CONST1*(( z2a* grp2+ z1a* grp1+ gr2+ gr1)*ss
4309 -( z2a* gr2- z1a* gr1)* cs* xk);
4310 *erc= - CONST1*(( z2a* grp2- z1a* grp1+ gr2- gr1)*cs
4311 +( z2a* gr2+ z1a* gr1)* ss* xk);
4312 *erk= CONST1*( grk2- grk1);
4313 intx(- shk, shk, rhk, ij, &cint, &sint);
4314 bk= b* xk;
4315 bk2= bk* bk*.25;
4316 *ezk= - CONST1*( gzp2- gzp1+ xk* xk*(1.- bk2)*
4317 cmplx( cint,- sint)-bk2*( gzz2- gzz1));
4318
4319 return;
4320 }
4321
4322 /*-----------------------------------------------------------------------*/
4323
4324 /* etmns fills the array e with the negative of the */
4325 /* electric field incident on the structure. e is the */
4326 /* right hand side of the matrix equation. */
etmns(double p1,double p2,double p3,double p4,double p5,double p6,int ipr,complex double * e)4327 void etmns( double p1, double p2, double p3, double p4,
4328 double p5, double p6, int ipr, complex double *e )
4329 {
4330 int i, is, i1, i2=0, neq;
4331 double cth, sth, cph, sph, cet, set, pxl, pyl, pzl, wx;
4332 double wy, wz, qx, qy, qz, arg, ds, dsh, rs, r;
4333 complex double cx, cy, cz, er, et, ezh, erh, rrv, rrh, tt1, tt2;
4334
4335 neq= n+2*m;
4336 nqds=0;
4337
4338 /* applied field of voltage sources for transmitting case */
4339 if( (ipr <= 0) || (ipr == 5) )
4340 {
4341 for( i = 0; i < neq; i++ )
4342 e[i]=CPLX_00;
4343
4344 if( nsant != 0)
4345 {
4346 for( i = 0; i < nsant; i++ )
4347 {
4348 is= isant[i]-1;
4349 e[is]= -vsant[i]/( si[is]* wlam);
4350 }
4351 }
4352
4353 if( nvqd == 0)
4354 return;
4355
4356 for( i = 0; i < nvqd; i++ )
4357 {
4358 is= ivqd[i];
4359 qdsrc( is, vqd[i], e);
4360 }
4361 return;
4362
4363 } /* if( (ipr <= 0) || (ipr == 5) ) */
4364
4365 /* incident plane wave, linearly polarized. */
4366 if( ipr <= 3)
4367 {
4368 cth= cos( p1);
4369 sth= sin( p1);
4370 cph= cos( p2);
4371 sph= sin( p2);
4372 cet= cos( p3);
4373 set= sin( p3);
4374 pxl= cth* cph* cet- sph* set;
4375 pyl= cth* sph* cet+ cph* set;
4376 pzl= - sth* cet;
4377 wx= - sth* cph;
4378 wy= - sth* sph;
4379 wz= - cth;
4380 qx= wy* pzl- wz* pyl;
4381 qy= wz* pxl- wx* pzl;
4382 qz= wx* pyl- wy* pxl;
4383
4384 if( ksymp != 1)
4385 {
4386 if( iperf != 1)
4387 {
4388 rrv= csqrt(1.- zrati* zrati* sth* sth);
4389 rrh= zrati* cth;
4390 rrh=( rrh- rrv)/( rrh+ rrv);
4391 rrv= zrati* rrv;
4392 rrv=-( cth- rrv)/( cth+ rrv);
4393 }
4394 else
4395 {
4396 rrv=-CPLX_10;
4397 rrh=-CPLX_10;
4398 } /* if( iperf != 1) */
4399
4400 } /* if( ksymp != 1) */
4401
4402 if( ipr <= 1)
4403 {
4404 if( n != 0)
4405 {
4406 for( i = 0; i < n; i++ )
4407 {
4408 arg= - TP*( wx* x[i]+ wy* y[i]+ wz* z[i]);
4409 e[i]=-( pxl* cab[i]+ pyl* sab[i]+ pzl*
4410 salp[i])* cmplx( cos( arg), sin( arg));
4411 }
4412
4413 if( ksymp != 1)
4414 {
4415 tt1=( pyl* cph- pxl* sph)*( rrh- rrv);
4416 cx= rrv* pxl- tt1* sph;
4417 cy= rrv* pyl+ tt1* cph;
4418 cz= - rrv* pzl;
4419
4420 for( i = 0; i < n; i++ )
4421 {
4422 arg= - TP*( wx* x[i]+ wy* y[i]- wz* z[i]);
4423 e[i]= e[i]-( cx* cab[i]+ cy* sab[i]+
4424 cz* salp[i])* cmplx(cos( arg), sin( arg));
4425 }
4426
4427 } /* if( ksymp != 1) */
4428
4429 } /* if( n != 0) */
4430
4431 if( m == 0)
4432 return;
4433
4434 i= -1;
4435 i1= n-2;
4436 for( is = 0; is < m; is++ )
4437 {
4438 i++;
4439 i1 += 2;
4440 i2 = i1+1;
4441 arg= - TP*( wx* px[i]+ wy* py[i]+ wz* pz[i]);
4442 tt1= cmplx( cos( arg), sin( arg))* psalp[i]* RETA;
4443 e[i2]=( qx* t1x[i]+ qy* t1y[i]+ qz* t1z[i])* tt1;
4444 e[i1]=( qx* t2x[i]+ qy* t2y[i]+ qz* t2z[i])* tt1;
4445 }
4446
4447 if( ksymp == 1)
4448 return;
4449
4450 tt1=( qy* cph- qx* sph)*( rrv- rrh);
4451 cx=-( rrh* qx- tt1* sph);
4452 cy=-( rrh* qy+ tt1* cph);
4453 cz= rrh* qz;
4454
4455 i= -1;
4456 i1= n-2;
4457 for( is = 0; is < m; is++ )
4458 {
4459 i++;
4460 i1 += 2;
4461 i2 = i1+1;
4462 arg= - TP*( wx* px[i]+ wy* py[i]- wz* pz[i]);
4463 tt1= cmplx( cos( arg), sin( arg))* psalp[i]* RETA;
4464 e[i2]= e[i2]+( cx* t1x[i]+ cy* t1y[i]+ cz* t1z[i])* tt1;
4465 e[i1]= e[i1]+( cx* t2x[i]+ cy* t2y[i]+ cz* t2z[i])* tt1;
4466 }
4467 return;
4468
4469 } /* if( ipr <= 1) */
4470
4471 /* incident plane wave, elliptic polarization. */
4472 tt1=-(CPLX_01)* p6;
4473 if( ipr == 3)
4474 tt1= - tt1;
4475
4476 if( n != 0)
4477 {
4478 cx= pxl+ tt1* qx;
4479 cy= pyl+ tt1* qy;
4480 cz= pzl+ tt1* qz;
4481
4482 for( i = 0; i < n; i++ )
4483 {
4484 arg= - TP*( wx* x[i]+ wy* y[i]+ wz* z[i]);
4485 e[i]=-( cx* cab[i]+ cy* sab[i]+ cz*
4486 salp[i])* cmplx( cos( arg), sin( arg));
4487 }
4488
4489 if( ksymp != 1)
4490 {
4491 tt2=( cy* cph- cx* sph)*( rrh- rrv);
4492 cx= rrv* cx- tt2* sph;
4493 cy= rrv* cy+ tt2* cph;
4494 cz= - rrv* cz;
4495
4496 for( i = 0; i < n; i++ )
4497 {
4498 arg= - TP*( wx* x[i]+ wy* y[i]- wz* z[i]);
4499 e[i]= e[i]-( cx* cab[i]+ cy* sab[i]+
4500 cz* salp[i])* cmplx(cos( arg), sin( arg));
4501 }
4502
4503 } /* if( ksymp != 1) */
4504
4505 } /* if( n != 0) */
4506
4507 if( m == 0)
4508 return;
4509
4510 cx= qx- tt1* pxl;
4511 cy= qy- tt1* pyl;
4512 cz= qz- tt1* pzl;
4513
4514 i= -1;
4515 i1= n-2;
4516 for( is = 0; is < m; is++ )
4517 {
4518 i++;
4519 i1 += 2;
4520 i2 = i1+1;
4521 arg= - TP*( wx* px[i]+ wy* py[i]+ wz* pz[i]);
4522 tt2= cmplx( cos( arg), sin( arg))* psalp[i]* RETA;
4523 e[i2]=( cx* t1x[i]+ cy* t1y[i]+ cz* t1z[i])* tt2;
4524 e[i1]=( cx* t2x[i]+ cy* t2y[i]+ cz* t2z[i])* tt2;
4525 }
4526
4527 if( ksymp == 1)
4528 return;
4529
4530 tt1=( cy* cph- cx* sph)*( rrv- rrh);
4531 cx=-( rrh* cx- tt1* sph);
4532 cy=-( rrh* cy+ tt1* cph);
4533 cz= rrh* cz;
4534
4535 i= -1;
4536 i1= n-2;
4537 for( is=0; is < m; is++ )
4538 {
4539 i++;
4540 i1 += 2;
4541 i2 = i1+1;
4542 arg= - TP*( wx* px[i]+ wy* py[i]- wz* pz[i]);
4543 tt1= cmplx( cos( arg), sin( arg))* psalp[i]* RETA;
4544 e[i2]= e[i2]+( cx* t1x[i]+ cy* t1y[i]+ cz* t1z[i])* tt1;
4545 e[i1]= e[i1]+( cx* t2x[i]+ cy* t2y[i]+ cz* t2z[i])* tt1;
4546 }
4547
4548 return;
4549
4550 } /* if( ipr <= 3) */
4551
4552 /* incident field of an elementary current source. */
4553 wz= cos( p4);
4554 wx= wz* cos( p5);
4555 wy= wz* sin( p5);
4556 wz= sin( p4);
4557 ds= p6*59.958;
4558 dsh= p6/(2.* TP);
4559
4560 is= 0;
4561 i1= n-2;
4562 for( i = 0; i < npm; i++ )
4563 {
4564 if( i >= n )
4565 {
4566 i1 += 2;
4567 i2 = i1+1;
4568 pxl= px[is]- p1;
4569 pyl= py[is]- p2;
4570 pzl= pz[is]- p3;
4571 is++;
4572 }
4573
4574 pxl= x[i]- p1;
4575 pyl= y[i]- p2;
4576 pzl= z[i]- p3;
4577
4578 rs= pxl* pxl+ pyl* pyl+ pzl* pzl;
4579 if( rs < 1.0e-30)
4580 continue;
4581
4582 r= sqrt( rs);
4583 pxl= pxl/ r;
4584 pyl= pyl/ r;
4585 pzl= pzl/ r;
4586 cth= pxl* wx+ pyl* wy+ pzl* wz;
4587 sth= sqrt(1.- cth* cth);
4588 qx= pxl- wx* cth;
4589 qy= pyl- wy* cth;
4590 qz= pzl- wz* cth;
4591
4592 arg= sqrt( qx* qx+ qy* qy+ qz* qz);
4593 if( arg >= 1.e-30)
4594 {
4595 qx= qx/ arg;
4596 qy= qy/ arg;
4597 qz= qz/ arg;
4598 }
4599 else
4600 {
4601 qx=1.;
4602 qy=0.;
4603 qz=0.;
4604
4605 } /* if( arg >= 1.e-30) */
4606
4607 arg= - TP* r;
4608 tt1= cmplx( cos( arg), sin( arg));
4609
4610 if( i < n )
4611 {
4612 tt2= cmplx(1.0,-1.0/( r* TP))/ rs;
4613 er= ds* tt1* tt2* cth;
4614 et=.5* ds* tt1*((CPLX_01)* TP/ r+ tt2)* sth;
4615 ezh= er* cth- et* sth;
4616 erh= er* sth+ et* cth;
4617 cx= ezh* wx+ erh* qx;
4618 cy= ezh* wy+ erh* qy;
4619 cz= ezh* wz+ erh* qz;
4620 e[i]=-( cx* cab[i]+ cy* sab[i]+ cz* salp[i]);
4621 }
4622 else
4623 {
4624 pxl= wy* qz- wz* qy;
4625 pyl= wz* qx- wx* qz;
4626 pzl= wx* qy- wy* qx;
4627 tt2= dsh* tt1* cmplx(1./ r, TP)/ r* sth* psalp[is];
4628 cx= tt2* pxl;
4629 cy= tt2* pyl;
4630 cz= tt2* pzl;
4631 e[i2]= cx* t1x[is]+ cy* t1y[is]+ cz* t1z[is];
4632 e[i1]= cx* t2x[is]+ cy* t2y[is]+ cz* t2z[is];
4633
4634 } /* if( i >= n) */
4635
4636 } /* for( i = 0; i < npm; i++ ) */
4637
4638 return;
4639 }
4640
4641 /*-----------------------------------------------------------------------*/
4642
4643 /* subroutine to factor a matrix into a unit lower triangular matrix */
4644 /* and an upper triangular matrix using the gauss-doolittle algorithm */
4645 /* presented on pages 411-416 of a. ralston--a first course in */
4646 /* numerical analysis. comments below refer to comments in ralstons */
4647 /* text. (matrix transposed.) */
4648
factr(int n,complex double * a,int * ip,int ndim)4649 void factr( int n, complex double *a, int *ip, int ndim)
4650 {
4651 int r, rm1, rp1, pj, pr, iflg, k, j, jp1, i;
4652 double dmax, elmag;
4653 complex double arj, *scm = NULL;
4654
4655 /* Allocate to scratch memory */
4656 mem_alloc( (void *)&scm, np2m * sizeof(complex double) );
4657
4658 /* Un-transpose the matrix for Gauss elimination */
4659 for( i = 1; i < n; i++ )
4660 for( j = 0; j < i; j++ )
4661 {
4662 arj = a[i+j*ndim];
4663 a[i+j*ndim] = a[j+i*ndim];
4664 a[j+i*ndim] = arj;
4665 }
4666
4667 iflg=FALSE;
4668 /* step 1 */
4669 for( r = 0; r < n; r++ )
4670 {
4671 for( k = 0; k < n; k++ )
4672 scm[k]= a[k+r*ndim];
4673
4674 /* steps 2 and 3 */
4675 rm1= r;
4676 if( rm1 > 0)
4677 {
4678 for( j = 0; j < rm1; j++ )
4679 {
4680 pj= ip[j]-1;
4681 arj= scm[pj];
4682 a[j+r*ndim]= arj;
4683 scm[pj]= scm[j];
4684 jp1= j+1;
4685
4686 for( i = jp1; i < n; i++ )
4687 scm[i] -= a[i+j*ndim]* arj;
4688
4689 } /* for( j = 0; j < rm1; j++ ) */
4690
4691 } /* if( rm1 >= 0.) */
4692
4693 /* step 4 */
4694 dmax= creal( scm[r]*conj(scm[r]) );
4695
4696 rp1= r+1;
4697 ip[r]= rp1;
4698 if( rp1 < n)
4699 {
4700 for( i = rp1; i < n; i++ )
4701 {
4702 elmag= creal( scm[i]* conj(scm[i]) );
4703 if( elmag >= dmax)
4704 {
4705 dmax= elmag;
4706 ip[r]= i+1;
4707 }
4708 }
4709 } /* if( rp1 < n) */
4710
4711 if( dmax < 1.e-10)
4712 iflg=TRUE;
4713
4714 pr= ip[r]-1;
4715 a[r+r*ndim]= scm[pr];
4716 scm[pr]= scm[r];
4717
4718 /* step 5 */
4719 if( rp1 < n)
4720 {
4721 arj=1./ a[r+r*ndim];
4722
4723 for( i = rp1; i < n; i++ )
4724 a[i+r*ndim]= scm[i]* arj;
4725 }
4726
4727 if( iflg == TRUE )
4728 {
4729 fprintf( output_fp,
4730 "\n PIVOT(%d)= %16.8E", r, dmax );
4731 iflg=FALSE;
4732 }
4733
4734 } /* for( r=0; r < n; r++ ) */
4735
4736 free_ptr( (void *)&scm );
4737
4738 return;
4739 }
4740
4741 /*-----------------------------------------------------------------------*/
4742
4743 /* factrs, for symmetric structure, transforms submatricies to form */
4744 /* matricies of the symmetric modes and calls routine to factor */
4745 /* matricies. if no symmetry, the routine is called to factor the */
4746 /* complete matrix. */
factrs(int np,int nrow,complex double * a,int * ip)4747 void factrs( int np, int nrow, complex double *a, int *ip )
4748 {
4749 int kk, ka;
4750
4751 for( kk = 0; kk < nop; kk++ )
4752 {
4753 ka= kk* np;
4754 factr( np, &a[ka], &ip[ka], nrow );
4755 }
4756 return;
4757 }
4758
4759 /*-----------------------------------------------------------------------*/
4760
4761 /* fbar is sommerfeld attenuation function for numerical distance p */
fbar(complex double p)4762 complex double fbar( complex double p )
4763 {
4764 int i, minus;
4765 double tms, sms;
4766 complex double z, zs, sum, pow, term, fbar;
4767
4768 z= CPLX_01* csqrt( p);
4769 if( cabs( z) <= 3.)
4770 {
4771 /* series expansion */
4772 zs= z* z;
4773 sum= z;
4774 pow= z;
4775
4776 for( i = 1; i <= 100; i++ )
4777 {
4778 pow= - pow* zs/ (double)i;
4779 term= pow/(2.* i+1.);
4780 sum= sum+ term;
4781 tms= creal( term* conj( term));
4782 sms= creal( sum* conj( sum));
4783 if( tms/sms < ACCS)
4784 break;
4785 }
4786
4787 fbar=1.-(1.- sum* TOSP)* z* cexp( zs)* SP;
4788 return( fbar );
4789
4790 } /* if( cabs( z) <= 3.) */
4791
4792 /* asymptotic expansion */
4793 if( creal( z) < 0.)
4794 {
4795 minus=1;
4796 z= - z;
4797 }
4798 else
4799 minus=0;
4800
4801 zs=.5/( z* z);
4802 sum=CPLX_00;
4803 term=CPLX_10;
4804
4805 for( i = 1; i <= 6; i++ )
4806 {
4807 term = - term*(2.*i -1.)* zs;
4808 sum += term;
4809 }
4810
4811 if( minus == 1)
4812 sum -= 2.* SP* z* cexp( z* z);
4813 fbar= - sum;
4814
4815 return( fbar );
4816 }
4817
4818 /*-----------------------------------------------------------------------*/
4819
4820 /* fblock sets parameters for out-of-core */
4821 /* solution for the primary matrix (a) */
fblock(int nrow,int ncol,int imax,int ipsym)4822 void fblock( int nrow, int ncol, int imax, int ipsym )
4823 {
4824 int i, j, k, ka, kk;
4825 double phaz, arg;
4826 complex double deter;
4827
4828 if( nrow*ncol <= imax)
4829 {
4830 npblk= nrow;
4831 nlast= nrow;
4832 imat= nrow* ncol;
4833
4834 if( nrow == ncol)
4835 {
4836 icase=1;
4837 return;
4838 }
4839 else
4840 icase=2;
4841
4842 } /* if( nrow*ncol <= imax) */
4843
4844 if( nop*nrow != ncol)
4845 {
4846 fprintf( output_fp,
4847 "\n SYMMETRY ERROR - NROW: %d NCOL: %d", nrow, ncol );
4848 stop(-1);
4849 }
4850
4851 /* set up ssx matrix for rotational symmetry. */
4852 if( ipsym <= 0)
4853 {
4854 phaz = TP/nop;
4855
4856 for( i = 1; i < nop; i++ )
4857 {
4858 for( j= i; j < nop; j++ )
4859 {
4860 arg= phaz* (double)i * (double)j;
4861 ssx[i+j*nop]= cmplx( cos( arg), sin( arg));
4862 ssx[j+i*nop]= ssx[i+j*nop];
4863 }
4864 }
4865 return;
4866
4867 } /* if( ipsym <= 0) */
4868
4869 /* set up ssx matrix for plane symmetry */
4870 kk=1;
4871 ssx[0]=CPLX_10;
4872
4873 k = 2;
4874 for( ka = 1; k != nop; ka++ )
4875 k *= 2;
4876
4877 for( k = 0; k < ka; k++ )
4878 {
4879 for( i = 0; i < kk; i++ )
4880 {
4881 for( j = 0; j < kk; j++ )
4882 {
4883 deter= ssx[i+j*nop];
4884 ssx[i+(j+kk)*nop]= deter;
4885 ssx[i+kk+(j+kk)*nop]= - deter;
4886 ssx[i+kk+j*nop]= deter;
4887 }
4888 }
4889 kk *= 2;
4890
4891 } /* for( k = 0; k < ka; k++ ) */
4892
4893 return;
4894 }
4895
4896 /*-----------------------------------------------------------------------*/
4897
4898 /* ffld calculates the far zone radiated electric fields, */
4899 /* the factor exp(j*k*r)/(r/lamda) not included */
ffld(double thet,double phi,complex double * eth,complex double * eph)4900 void ffld( double thet, double phi,
4901 complex double *eth, complex double *eph )
4902 {
4903 int k, i, ip, jump;
4904 double phx, phy, roz, rozs, thx, thy, thz, rox, roy;
4905 double tthet=0., darg=0., omega, el, sill, top, bot, a;
4906 double too, boo, b, c, d, rr, ri, arg, dr, rfl, rrz;
4907 complex double cix, ciy, ciz, exa, ccx, ccy, ccz, cdp;
4908 complex double zrsin, rrv, rrh, rrv1, rrh1, rrv2, rrh2;
4909 complex double tix, tiy, tiz, zscrn, ex, ey, ez, gx, gy, gz;
4910
4911 phx= - sin( phi);
4912 phy= cos( phi);
4913 roz= cos( thet);
4914 rozs= roz;
4915 thx= roz* phy;
4916 thy= - roz* phx;
4917 thz= - sin( thet);
4918 rox= - thz* phy;
4919 roy= thz* phx;
4920
4921 jump = FALSE;
4922 if( n != 0)
4923 {
4924 /* loop for structure image if any */
4925 /* calculation of reflection coeffecients */
4926 for( k = 0; k < ksymp; k++ )
4927 {
4928 if( k != 0 )
4929 {
4930 /* for perfect ground */
4931 if( iperf == 1)
4932 {
4933 rrv=-CPLX_10;
4934 rrh=-CPLX_10;
4935 }
4936 else
4937 {
4938 /* for infinite planar ground */
4939 zrsin= csqrt(1.- zrati* zrati* thz* thz);
4940 rrv=-( roz- zrati* zrsin)/( roz+ zrati* zrsin);
4941 rrh=( zrati* roz- zrsin)/( zrati* roz+ zrsin);
4942
4943 } /* if( iperf == 1) */
4944
4945 /* for the cliff problem, two reflction coefficients calculated */
4946 if( ifar > 1)
4947 {
4948 rrv1= rrv;
4949 rrh1= rrh;
4950 tthet= tan( thet);
4951
4952 if( ifar != 4)
4953 {
4954 zrsin= csqrt(1.- zrati2* zrati2* thz* thz);
4955 rrv2=-( roz- zrati2* zrsin)/( roz+ zrati2* zrsin);
4956 rrh2=( zrati2* roz- zrsin)/( zrati2* roz+ zrsin);
4957 darg= - TP*2.* ch* roz;
4958 }
4959 } /* if( ifar > 1) */
4960
4961 roz= - roz;
4962 ccx= cix;
4963 ccy= ciy;
4964 ccz= ciz;
4965
4966 } /* if( k != 0 ) */
4967
4968 cix=CPLX_00;
4969 ciy=CPLX_00;
4970 ciz=CPLX_00;
4971
4972 /* loop over structure segments */
4973 for( i = 0; i < n; i++ )
4974 {
4975 omega=-( rox* cab[i]+ roy* sab[i]+ roz* salp[i]);
4976 el= PI* si[i];
4977 sill= omega* el;
4978 top= el+ sill;
4979 bot= el- sill;
4980
4981 if( fabs( omega) >= 1.0e-7)
4982 a=2.* sin( sill)/ omega;
4983 else
4984 a=(2.- omega* omega* el* el/3.)* el;
4985
4986 if( fabs( top) >= 1.0e-7)
4987 too= sin( top)/ top;
4988 else
4989 too=1.- top* top/6.;
4990
4991 if( fabs( bot) >= 1.0e-7)
4992 boo= sin( bot)/ bot;
4993 else
4994 boo=1.- bot* bot/6.;
4995
4996 b= el*( boo- too);
4997 c= el*( boo+ too);
4998 rr= a* air[i]+ b* bii[i]+ c* cir[i];
4999 ri= a* aii[i]- b* bir[i]+ c* cii[i];
5000 arg= TP*( x[i]* rox+ y[i]* roy+ z[i]* roz);
5001
5002 if( (k != 1) || (ifar < 2) )
5003 {
5004 /* summation for far field integral */
5005 exa= cmplx( cos( arg), sin( arg))* cmplx( rr, ri);
5006 cix= cix+ exa* cab[i];
5007 ciy= ciy+ exa* sab[i];
5008 ciz= ciz+ exa* salp[i];
5009 continue;
5010 }
5011
5012 /* calculation of image contribution */
5013 /* in cliff and ground screen problems */
5014
5015 /* specular point distance */
5016 dr= z[i]* tthet;
5017
5018 d= dr* phy+ x[i];
5019 if( ifar == 2)
5020 {
5021 if(( cl- d) > 0.)
5022 {
5023 rrv= rrv1;
5024 rrh= rrh1;
5025 }
5026 else
5027 {
5028 rrv= rrv2;
5029 rrh= rrh2;
5030 arg= arg+ darg;
5031 }
5032 } /* if( ifar == 2) */
5033 else
5034 {
5035 d= sqrt( d*d + (y[i]-dr*phx)*(y[i]-dr*phx) );
5036 if( ifar == 3)
5037 {
5038 if(( cl- d) > 0.)
5039 {
5040 rrv= rrv1;
5041 rrh= rrh1;
5042 }
5043 else
5044 {
5045 rrv= rrv2;
5046 rrh= rrh2;
5047 arg= arg+ darg;
5048 }
5049 } /* if( ifar == 3) */
5050 else
5051 {
5052 if(( scrwl- d) >= 0.)
5053 {
5054 /* radial wire ground screen reflection coefficient */
5055 d= d+ t2;
5056 zscrn= t1* d* log( d/ t2);
5057 zscrn=( zscrn* zrati)/( ETA* zrati+ zscrn);
5058 zrsin= csqrt(1.- zscrn* zscrn* thz* thz);
5059 rrv=( roz+ zscrn* zrsin)/(- roz+ zscrn* zrsin);
5060 rrh=( zscrn* roz+ zrsin)/( zscrn* roz- zrsin);
5061 } /* if(( scrwl- d) < 0.) */
5062 else
5063 {
5064 if( ifar == 4)
5065 {
5066 rrv= rrv1;
5067 rrh= rrh1;
5068 } /* if( ifar == 4) */
5069 else
5070 {
5071 if( ifar == 5)
5072 d= dr* phy+ x[i];
5073
5074 if(( cl- d) > 0.)
5075 {
5076 rrv= rrv1;
5077 rrh= rrh1;
5078 }
5079 else
5080 {
5081 rrv= rrv2;
5082 rrh= rrh2;
5083 arg= arg+ darg;
5084 } /* if(( cl- d) > 0.) */
5085
5086 } /* if( ifar == 4) */
5087
5088 } /* if(( scrwl- d) < 0.) */
5089
5090 } /* if( ifar == 3) */
5091
5092 } /* if( ifar == 2) */
5093
5094 /* contribution of each image segment modified by */
5095 /* reflection coef, for cliff and ground screen problems */
5096 exa= cmplx( cos( arg), sin( arg))* cmplx( rr, ri);
5097 tix= exa* cab[i];
5098 tiy= exa* sab[i];
5099 tiz= exa* salp[i];
5100 cdp=( tix* phx+ tiy* phy)*( rrh- rrv);
5101 cix= cix+ tix* rrv+ cdp* phx;
5102 ciy= ciy+ tiy* rrv+ cdp* phy;
5103 ciz= ciz- tiz* rrv;
5104
5105 } /* for( i = 0; i < n; i++ ) */
5106
5107 if( k == 0 )
5108 continue;
5109
5110 /* calculation of contribution of structure image for infinite ground */
5111 if( ifar < 2)
5112 {
5113 cdp=( cix* phx+ ciy* phy)*( rrh- rrv);
5114 cix= ccx+ cix* rrv+ cdp* phx;
5115 ciy= ccy+ ciy* rrv+ cdp* phy;
5116 ciz= ccz- ciz* rrv;
5117 }
5118 else
5119 {
5120 cix= cix+ ccx;
5121 ciy= ciy+ ccy;
5122 ciz= ciz+ ccz;
5123 }
5124
5125 } /* for( k=0; k < ksymp; k++ ) */
5126
5127 if( m > 0)
5128 jump = TRUE;
5129 else
5130 {
5131 *eth=( cix* thx+ ciy* thy+ ciz* thz)* CONST3;
5132 *eph=( cix* phx+ ciy* phy)* CONST3;
5133 return;
5134 }
5135
5136 } /* if( n != 0) */
5137
5138 if( ! jump )
5139 {
5140 cix=CPLX_00;
5141 ciy=CPLX_00;
5142 ciz=CPLX_00;
5143 }
5144
5145 /* electric field components */
5146 roz= rozs;
5147 rfl=-1.;
5148 for( ip = 0; ip < ksymp; ip++ )
5149 {
5150 rfl= - rfl;
5151 rrz= roz* rfl;
5152 fflds( rox, roy, rrz, &cur[n], &gx, &gy, &gz);
5153
5154 if( ip != 1 )
5155 {
5156 ex= gx;
5157 ey= gy;
5158 ez= gz;
5159 continue;
5160 }
5161
5162 if( iperf == 1)
5163 {
5164 gx= - gx;
5165 gy= - gy;
5166 gz= - gz;
5167 }
5168 else
5169 {
5170 rrv= csqrt(1.- zrati* zrati* thz* thz);
5171 rrh= zrati* roz;
5172 rrh=( rrh- rrv)/( rrh+ rrv);
5173 rrv= zrati* rrv;
5174 rrv=-( roz- rrv)/( roz+ rrv);
5175 *eth=( gx* phx+ gy* phy)*( rrh- rrv);
5176 gx= gx* rrv+ *eth* phx;
5177 gy= gy* rrv+ *eth* phy;
5178 gz= gz* rrv;
5179
5180 } /* if( iperf == 1) */
5181
5182 ex= ex+ gx;
5183 ey= ey+ gy;
5184 ez= ez- gz;
5185
5186 } /* for( ip = 0; ip < ksymp; ip++ ) */
5187
5188 ex= ex+ cix* CONST3;
5189 ey= ey+ ciy* CONST3;
5190 ez= ez+ ciz* CONST3;
5191 *eth= ex* thx+ ey* thy+ ez* thz;
5192 *eph= ex* phx+ ey* phy;
5193
5194 return;
5195 }
5196
5197 /*-----------------------------------------------------------------------*/
5198
5199 /* calculates the xyz components of the electric */
5200 /* field due to surface currents */
fflds(double rox,double roy,double roz,complex double * scur,complex double * ex,complex double * ey,complex double * ez)5201 void fflds( double rox, double roy, double roz,
5202 complex double *scur, complex double *ex,
5203 complex double *ey, complex double *ez )
5204 {
5205 double *xs, *ys, *zs, *s;
5206 int j, i, k;
5207 double arg;
5208 complex double ct;
5209
5210 xs = px; ys = py; zs = pz; s = pbi;
5211 *ex=CPLX_00;
5212 *ey=CPLX_00;
5213 *ez=CPLX_00;
5214
5215 i= -1;
5216 for( j = 0; j < m; j++ )
5217 {
5218 i++;
5219 arg= TP*( rox* xs[i]+ roy* ys[i]+ roz* zs[i]);
5220 ct= cmplx( cos( arg)* s[i], sin( arg)* s[i]);
5221 k=3*(j+1)-1;
5222 *ex= *ex+ scur[k-2]* ct;
5223 *ey= *ey+ scur[k-1]* ct;
5224 *ez= *ez+ scur[k ]* ct;
5225 }
5226
5227 ct= rox* *ex+ roy* *ey+ roz* *ez;
5228 *ex= CONST4*( ct* rox- *ex);
5229 *ey= CONST4*( ct* roy- *ey);
5230 *ez= CONST4*( ct* roz- *ez);
5231
5232 return;
5233 }
5234
5235 /*-----------------------------------------------------------------------*/
5236
5237 /* gf computes the integrand exp(jkr)/(kr) for numerical integration. */
gf(double zk,double * co,double * si)5238 void gf( double zk, double *co, double *si )
5239 {
5240 double zdk, rk, rks;
5241
5242 zdk= zk- zpk;
5243 rk= sqrt( rkb2+ zdk* zdk);
5244 *si= sin( rk)/ rk;
5245
5246 if( ija != 0 )
5247 {
5248 *co= cos( rk)/ rk;
5249 return;
5250 }
5251
5252 if( rk >= .2)
5253 {
5254 *co=( cos( rk)-1.)/ rk;
5255 return;
5256 }
5257
5258 rks= rk* rk;
5259 *co=((-1.38888889e-3* rks+4.16666667e-2)* rks-.5)* rk;
5260
5261 return;
5262 }
5263
5264 /*-----------------------------------------------------------------------*/
5265
5266 /* gfld computes the radiated field including ground wave. */
gfld(double rho,double phi,double rz,complex double * eth,complex double * epi,complex double * erd,complex double ux,int ksymp)5267 void gfld( double rho, double phi, double rz,
5268 complex double *eth, complex double *epi,
5269 complex double *erd, complex double ux, int ksymp )
5270 {
5271 int i, k;
5272 double b, r, thet, arg, phx, phy, rx, ry, dx, dy, dz, rix, riy, rhs, rhp;
5273 double rhx, rhy, calp, cbet, sbet, cph, sph, el, rfl, riz, thx, thy, thz;
5274 double rxyz, rnx, rny, rnz, omega, sill, top, bot, a, too, boo, c, rr, ri;
5275 complex double cix, ciy, ciz, exa, erv;
5276 complex double ezv, erh, eph, ezh, ex, ey;
5277
5278 r= sqrt( rho*rho+ rz*rz );
5279 if( (ksymp == 1) || (cabs(ux) > .5) || (r > 1.e5) )
5280 {
5281 /* computation of space wave only */
5282 if( rz >= 1.0e-20)
5283 thet= atan( rho/ rz);
5284 else
5285 thet= PI*.5;
5286
5287 ffld( thet, phi, eth, epi);
5288 arg= - TP* r;
5289 exa= cmplx( cos( arg), sin( arg))/ r;
5290 *eth= *eth* exa;
5291 *epi= *epi* exa;
5292 *erd=CPLX_00;
5293 return;
5294 } /* if( (ksymp == 1) && (cabs(ux) > .5) && (r > 1.e5) ) */
5295
5296 /* computation of space and ground waves. */
5297 u= ux;
5298 u2= u* u;
5299 phx= - sin( phi);
5300 phy= cos( phi);
5301 rx= rho* phy;
5302 ry= - rho* phx;
5303 cix=CPLX_00;
5304 ciy=CPLX_00;
5305 ciz=CPLX_00;
5306
5307 /* summation of field from individual segments */
5308 for( i = 0; i < n; i++ )
5309 {
5310 dx= cab[i];
5311 dy= sab[i];
5312 dz= salp[i];
5313 rix= rx- x[i];
5314 riy= ry- y[i];
5315 rhs= rix* rix+ riy* riy;
5316 rhp= sqrt( rhs);
5317
5318 if( rhp >= 1.0e-6)
5319 {
5320 rhx= rix/ rhp;
5321 rhy= riy/ rhp;
5322 }
5323 else
5324 {
5325 rhx=1.;
5326 rhy=0.;
5327 }
5328
5329 calp=1.- dz* dz;
5330 if( calp >= 1.0e-6)
5331 {
5332 calp= sqrt( calp);
5333 cbet= dx/ calp;
5334 sbet= dy/ calp;
5335 cph= rhx* cbet+ rhy* sbet;
5336 sph= rhy* cbet- rhx* sbet;
5337 }
5338 else
5339 {
5340 cph= rhx;
5341 sph= rhy;
5342 }
5343
5344 el= PI* si[i];
5345 rfl=-1.;
5346
5347 /* integration of (current)*(phase factor) over segment and image for */
5348 /* constant, sine, and cosine current distributions */
5349 for( k = 0; k < 2; k++ )
5350 {
5351 rfl= - rfl;
5352 riz= rz- z[i]* rfl;
5353 rxyz= sqrt( rix* rix+ riy* riy+ riz* riz);
5354 rnx= rix/ rxyz;
5355 rny= riy/ rxyz;
5356 rnz= riz/ rxyz;
5357 omega=-( rnx* dx+ rny* dy+ rnz* dz* rfl);
5358 sill= omega* el;
5359 top= el+ sill;
5360 bot= el- sill;
5361
5362 if( fabs( omega) >= 1.0e-7)
5363 a=2.* sin( sill)/ omega;
5364 else
5365 a=(2.- omega* omega* el* el/3.)* el;
5366
5367 if( fabs( top) >= 1.0e-7)
5368 too= sin( top)/ top;
5369 else
5370 too=1.- top* top/6.;
5371
5372 if( fabs( bot) >= 1.0e-7)
5373 boo= sin( bot)/ bot;
5374 else
5375 boo=1.- bot* bot/6.;
5376
5377 b= el*( boo- too);
5378 c= el*( boo+ too);
5379 rr= a* air[i]+ b* bii[i]+ c* cir[i];
5380 ri= a* aii[i]- b* bir[i]+ c* cii[i];
5381 arg= TP*( x[i]* rnx+ y[i]* rny+ z[i]* rnz* rfl);
5382 exa= cmplx( cos( arg), sin( arg))* cmplx( rr, ri)/ TP;
5383
5384 if( k != 1 )
5385 {
5386 xx1= exa;
5387 r1= rxyz;
5388 zmh= riz;
5389 continue;
5390 }
5391
5392 xx2= exa;
5393 r2= rxyz;
5394 zph= riz;
5395
5396 } /* for( k = 0; k < 2; k++ ) */
5397
5398 /* call subroutine to compute the field */
5399 /* of segment including ground wave. */
5400 gwave( &erv, &ezv, &erh, &ezh, &eph);
5401 erh= erh* cph* calp+ erv* dz;
5402 eph= eph* sph* calp;
5403 ezh= ezh* cph* calp+ ezv* dz;
5404 ex= erh* rhx- eph* rhy;
5405 ey= erh* rhy+ eph* rhx;
5406 cix= cix+ ex;
5407 ciy= ciy+ ey;
5408 ciz= ciz+ ezh;
5409
5410 } /* for( i = 0; i < n; i++ ) */
5411
5412 arg= - TP* r;
5413 exa= cmplx( cos( arg), sin( arg));
5414 cix= cix* exa;
5415 ciy= ciy* exa;
5416 ciz= ciz* exa;
5417 rnx= rx/ r;
5418 rny= ry/ r;
5419 rnz= rz/ r;
5420 thx= rnz* phy;
5421 thy= - rnz* phx;
5422 thz= - rho/ r;
5423 *eth= cix* thx+ ciy* thy+ ciz* thz;
5424 *epi= cix* phx+ ciy* phy;
5425 *erd= cix* rnx+ ciy* rny+ ciz* rnz;
5426
5427 return;
5428 }
5429
5430 /*-----------------------------------------------------------------------*/
5431
5432 /* integrand for h field of a wire */
gh(double zk,double * hr,double * hi)5433 void gh( double zk, double *hr, double *hi)
5434 {
5435 double rs, r, ckr, skr, rr2, rr3;
5436
5437 rs= zk- zpka;
5438 rs= rhks+ rs* rs;
5439 r= sqrt( rs);
5440 ckr= cos( r);
5441 skr= sin( r);
5442 rr2=1./ rs;
5443 rr3= rr2/ r;
5444 *hr= skr* rr2+ ckr* rr3;
5445 *hi= ckr* rr2- skr* rr3;
5446
5447 return;
5448 }
5449
5450 /*-----------------------------------------------------------------------*/
5451
5452 /* gwave computes the electric field, including ground wave, of a */
5453 /* current element over a ground plane using formulas of k.a. norton */
5454 /* (proc. ire, sept., 1937, pp.1203,1236.) */
5455
gwave(complex double * erv,complex double * ezv,complex double * erh,complex double * ezh,complex double * eph)5456 void gwave( complex double *erv, complex double *ezv,
5457 complex double *erh, complex double *ezh, complex double *eph )
5458 {
5459 double sppp, sppp2, cppp2, cppp, spp, spp2, cpp2, cpp;
5460 complex double rk1, rk2, t1, t2, t3, t4, p1, rv;
5461 complex double omr, w, f, q1, rh, v, g, xr1, xr2;
5462 complex double x1, x2, x3, x4, x5, x6, x7;
5463
5464 sppp= zmh/ r1;
5465 sppp2= sppp* sppp;
5466 cppp2=1.- sppp2;
5467
5468 if( cppp2 < 1.0e-20)
5469 cppp2=1.0e-20;
5470
5471 cppp= sqrt( cppp2);
5472 spp= zph/ r2;
5473 spp2= spp* spp;
5474 cpp2=1.- spp2;
5475
5476 if( cpp2 < 1.0e-20)
5477 cpp2=1.0e-20;
5478
5479 cpp= sqrt( cpp2);
5480 rk1= - TPJ* r1;
5481 rk2= - TPJ* r2;
5482 t1=1. -u2* cpp2;
5483 t2= csqrt( t1);
5484 t3=(1. -1./ rk1)/ rk1;
5485 t4=(1. -1./ rk2)/ rk2;
5486 p1= rk2* u2* t1/(2.* cpp2);
5487 rv=( spp- u* t2)/( spp+ u* t2);
5488 omr=1.- rv;
5489 w=1./ omr;
5490 w=(4.0 + 0.0fj)* p1* w* w;
5491 f= fbar( w);
5492 q1= rk2* t1/(2.* u2* cpp2);
5493 rh=( t2- u* spp)/( t2+ u* spp);
5494 v=1./(1.+ rh);
5495 v=(4.0 + 0.0fj)* q1* v* v;
5496 g= fbar( v);
5497 xr1= xx1/ r1;
5498 xr2= xx2/ r2;
5499 x1= cppp2* xr1;
5500 x2= rv* cpp2* xr2;
5501 x3= omr* cpp2* f* xr2;
5502 x4= u* t2* spp*2.* xr2/ rk2;
5503 x5= xr1* t3*(1.-3.* sppp2);
5504 x6= xr2* t4*(1.-3.* spp2);
5505 *ezv=( x1+ x2+ x3- x4- x5- x6)* (-CONST4);
5506 x1= sppp* cppp* xr1;
5507 x2= rv* spp* cpp* xr2;
5508 x3= cpp* omr* u* t2* f* xr2;
5509 x4= spp* cpp* omr* xr2/ rk2;
5510 x5=3.* sppp* cppp* t3* xr1;
5511 x6= cpp* u* t2* omr* xr2/ rk2*.5;
5512 x7=3.* spp* cpp* t4* xr2;
5513 *erv=-( x1+ x2- x3+ x4- x5+ x6- x7)* (-CONST4);
5514 *ezh=-( x1- x2+ x3- x4- x5- x6+ x7)* (-CONST4);
5515 x1= sppp2* xr1;
5516 x2= rv* spp2* xr2;
5517 x4= u2* t1* omr* f* xr2;
5518 x5= t3*(1.-3.* cppp2)* xr1;
5519 x6= t4*(1.-3.* cpp2)*(1.- u2*(1.+ rv)- u2* omr* f)* xr2;
5520 x7= u2* cpp2* omr*(1.-1./ rk2)*( f*( u2* t1- spp2-1./ rk2)+1./rk2)* xr2;
5521 *erh=( x1- x2- x4- x5+ x6+ x7)* (-CONST4);
5522 x1= xr1;
5523 x2= rh* xr2;
5524 x3=( rh+1.)* g* xr2;
5525 x4= t3* xr1;
5526 x5= t4*(1.- u2*(1.+ rv)- u2* omr* f)* xr2;
5527 x6=.5* u2* omr*( f*( u2* t1- spp2-1./ rk2)+1./ rk2)* xr2/ rk2;
5528 *eph=-( x1- x2+ x3- x4+ x5+ x6)* (-CONST4);
5529
5530 return;
5531 }
5532
5533 /*-----------------------------------------------------------------------*/
5534
5535 /* segment end contributions for thin wire approx. */
gx(double zz,double rh,double xk,complex double * gz,complex double * gzp)5536 void gx( double zz, double rh, double xk,
5537 complex double *gz, complex double *gzp)
5538 {
5539 double r, r2, rkz;
5540
5541 r2= zz* zz+ rh* rh;
5542 r= sqrt( r2);
5543 rkz= xk* r;
5544 *gz= cmplx( cos( rkz),- sin( rkz))/ r;
5545 *gzp= - cmplx(1.0, rkz)* *gz/ r2;
5546
5547 return;
5548 }
5549
5550 /*-----------------------------------------------------------------------*/
5551
5552 /* segment end contributions for ext. thin wire approx. */
gxx(double zz,double rh,double a,double a2,double xk,int ira,complex double * g1,complex double * g1p,complex double * g2,complex double * g2p,complex double * g3,complex double * gzp)5553 void gxx( double zz, double rh, double a, double a2, double xk, int ira,
5554 complex double *g1, complex double *g1p, complex double *g2,
5555 complex double *g2p, complex double *g3, complex double *gzp )
5556 {
5557 double r, r2, r4, rk, rk2, rh2, t1, t2;
5558 complex double gz, c1, c2, c3;
5559
5560 r2= zz* zz+ rh* rh;
5561 r= sqrt( r2);
5562 r4= r2* r2;
5563 rk= xk* r;
5564 rk2= rk* rk;
5565 rh2= rh* rh;
5566 t1=.25* a2* rh2/ r4;
5567 t2=.5* a2/ r2;
5568 c1= cmplx(1.0, rk);
5569 c2=3.* c1- rk2;
5570 c3= cmplx(6.0, rk)* rk2-15.* c1;
5571 gz= cmplx( cos( rk),- sin( rk))/ r;
5572 *g2= gz*(1.+ t1* c2);
5573 *g1= *g2- t2* c1* gz;
5574 gz= gz/ r2;
5575 *g2p= gz*( t1* c3- c1);
5576 *gzp= t2* c2* gz;
5577 *g3= *g2p+ *gzp;
5578 *g1p= *g3* zz;
5579
5580 if( ira != 1)
5581 {
5582 *g3=( *g3+ *gzp)* rh;
5583 *gzp= - zz* c1* gz;
5584
5585 if( rh <= 1.0e-10)
5586 {
5587 *g2=0.;
5588 *g2p=0.;
5589 return;
5590 }
5591
5592 *g2= *g2/ rh;
5593 *g2p= *g2p* zz/ rh;
5594 return;
5595
5596 } /* if( ira != 1) */
5597
5598 t2=.5* a;
5599 *g2= - t2* c1* gz;
5600 *g2p= t2* gz* c2/ r2;
5601 *g3= rh2* *g2p- a* gz* c1;
5602 *g2p= *g2p* zz;
5603 *gzp= - zz* c1* gz;
5604
5605 return;
5606 }
5607
5608 /*-----------------------------------------------------------------------*/
5609
5610 /* subroutine helix generates segment geometry */
5611 /* data for a helix of ns segments */
helix(double s,double hl,double a1,double b1,double a2,double b2,double rad,int ns,int itg)5612 void helix( double s, double hl, double a1, double b1,
5613 double a2, double b2, double rad, int ns, int itg )
5614 {
5615 int ist, i, mreq;
5616 double turns, zinc, copy, sangle, hdia, turn, pitch, hmaj, hmin;
5617
5618 ist= n;
5619 n += ns;
5620 np= n;
5621 mp= m;
5622 ipsym=0;
5623
5624 if( ns < 1)
5625 return;
5626
5627 turns= fabs( hl/ s);
5628 zinc= fabs( hl/ ns);
5629
5630 /* Reallocate tags buffer */
5631 mem_realloc( (void *)&itag, (n+m) * sizeof(int) );/*????*/
5632
5633 /* Reallocate wire buffers */
5634 mreq = n * sizeof(double);
5635 mem_realloc( (void *)&x, mreq );
5636 mem_realloc( (void *)&y, mreq );
5637 mem_realloc( (void *)&z, mreq );
5638 mem_realloc( (void *)&x2, mreq );
5639 mem_realloc( (void *)&y2, mreq );
5640 mem_realloc( (void *)&z2, mreq );
5641 mem_realloc( (void *)&bi, mreq );
5642
5643 z[ist]=0.;
5644 for( i = ist; i < n; i++ )
5645 {
5646 bi[i]= rad;
5647 itag[i]= itg;
5648
5649 if( i != ist )
5650 z[i]= z[i-1]+ zinc;
5651
5652 z2[i]= z[i]+ zinc;
5653
5654 if( a2 == a1)
5655 {
5656 if( b1 == 0.)
5657 b1= a1;
5658
5659 x[i]= a1* cos(2.* PI* z[i]/ s);
5660 y[i]= b1* sin(2.* PI* z[i]/ s);
5661 x2[i]= a1* cos(2.* PI* z2[i]/ s);
5662 y2[i]= b1* sin(2.* PI* z2[i]/ s);
5663 }
5664 else
5665 {
5666 if( b2 == 0.)
5667 b2= a2;
5668
5669 x[i]=( a1+( a2- a1)* z[i]/ fabs( hl))* cos(2.* PI* z[i]/ s);
5670 y[i]=( b1+( b2- b1)* z[i]/ fabs( hl))* sin(2.* PI* z[i]/ s);
5671 x2[i]=( a1+( a2- a1)* z2[i]/ fabs( hl))* cos(2.* PI* z2[i]/ s);
5672 y2[i]=( b1+( b2- b1)* z2[i]/ fabs( hl))* sin(2.* PI* z2[i]/ s);
5673
5674 } /* if( a2 == a1) */
5675
5676 if( hl > 0.)
5677 continue;
5678
5679 copy= x[i];
5680 x[i]= y[i];
5681 y[i]= copy;
5682 copy= x2[i];
5683 x2[i]= y2[i];
5684 y2[i]= copy;
5685
5686 } /* for( i = ist; i < n; i++ ) */
5687
5688 if( a2 != a1)
5689 {
5690 sangle= atan( a2/( fabs( hl)+( fabs( hl)* a1)/( a2- a1)));
5691 fprintf( output_fp,
5692 "\n THE CONE ANGLE OF THE SPIRAL IS %10.4f", sangle );
5693 return;
5694 }
5695
5696 if( a1 == b1)
5697 {
5698 hdia=2.* a1;
5699 turn= hdia* PI;
5700 pitch= atan( s/( PI* hdia));
5701 turn= turn/ cos( pitch);
5702 pitch=180.* pitch/ PI;
5703 }
5704 else
5705 {
5706 if( a1 >= b1)
5707 {
5708 hmaj=2.* a1;
5709 hmin=2.* b1;
5710 }
5711 else
5712 {
5713 hmaj=2.* b1;
5714 hmin=2.* a1;
5715 }
5716
5717 hdia= sqrt(( hmaj*hmaj+ hmin*hmin)/2* hmaj);
5718 turn=2.* PI* hdia;
5719 pitch=(180./ PI)* atan( s/( PI* hdia));
5720
5721 } /* if( a1 == b1) */
5722
5723 fprintf( output_fp, "\n"
5724 " THE PITCH ANGLE IS: %.4f THE LENGTH OF WIRE/TURN IS: %.4f",
5725 pitch, turn );
5726
5727 return;
5728 }
5729
5730 /*-----------------------------------------------------------------------*/
5731
5732 /* hfk computes the h field of a uniform current */
5733 /* filament by numerical integration */
hfk(double el1,double el2,double rhk,double zpkx,double * sgr,double * sgi)5734 void hfk( double el1, double el2, double rhk,
5735 double zpkx, double *sgr, double *sgi )
5736 {
5737 int nx = 1, nma = 65536, nts = 4;
5738 int ns, nt;
5739 int flag = TRUE;
5740 double rx = 1.0e-4;
5741 double z, ze, s, ep, zend, dz=0., zp, dzot=0., t00r, g1r, g5r, t00i;
5742 double g1i, g5i, t01r, g3r, t01i, g3i, t10r, t10i, te1i, te1r, t02r;
5743 double g2r, g4r, t02i, g2i, g4i, t11r, t11i, t20r, t20i, te2i, te2r;
5744
5745 zpka= zpkx;
5746 rhks= rhk* rhk;
5747 z= el1;
5748 ze= el2;
5749 s= ze- z;
5750 ep= s/(10.* nma);
5751 zend= ze- ep;
5752 *sgr=0.0;
5753 *sgi=0.0;
5754 ns= nx;
5755 nt=0;
5756 gh( z, &g1r, &g1i);
5757
5758 while( TRUE )
5759 {
5760 if( flag )
5761 {
5762 dz= s/ ns;
5763 zp= z+ dz;
5764
5765 if( zp > ze )
5766 {
5767 dz= ze- z;
5768 if( fabs(dz) <= ep )
5769 {
5770 *sgr= *sgr* rhk*.5;
5771 *sgi= *sgi* rhk*.5;
5772 return;
5773 }
5774 }
5775
5776 dzot= dz*.5;
5777 zp= z+ dzot;
5778 gh( zp, &g3r, &g3i);
5779 zp= z+ dz;
5780 gh( zp, &g5r, &g5i);
5781
5782 } /* if( flag ) */
5783
5784 t00r=( g1r+ g5r)* dzot;
5785 t00i=( g1i+ g5i)* dzot;
5786 t01r=( t00r+ dz* g3r)*0.5;
5787 t01i=( t00i+ dz* g3i)*0.5;
5788 t10r=(4.0* t01r- t00r)/3.0;
5789 t10i=(4.0* t01i- t00i)/3.0;
5790
5791 test( t01r, t10r, &te1r, t01i, t10i, &te1i, 0.);
5792 if( (te1i <= rx) && (te1r <= rx) )
5793 {
5794 *sgr= *sgr+ t10r;
5795 *sgi= *sgi+ t10i;
5796 nt += 2;
5797
5798 z += dz;
5799 if( z >= zend)
5800 {
5801 *sgr= *sgr* rhk*.5;
5802 *sgi= *sgi* rhk*.5;
5803 return;
5804 }
5805
5806 g1r= g5r;
5807 g1i= g5i;
5808 if( nt >= nts)
5809 if( ns > nx)
5810 {
5811 ns= ns/2;
5812 nt=1;
5813 }
5814 flag = TRUE;
5815 continue;
5816
5817 } /* if( (te1i <= rx) && (te1r <= rx) ) */
5818
5819 zp= z+ dz*0.25;
5820 gh( zp, &g2r, &g2i);
5821 zp= z+ dz*0.75;
5822 gh( zp, &g4r, &g4i);
5823 t02r=( t01r+ dzot*( g2r+ g4r))*0.5;
5824 t02i=( t01i+ dzot*( g2i+ g4i))*0.5;
5825 t11r=(4.0* t02r- t01r)/3.0;
5826 t11i=(4.0* t02i- t01i)/3.0;
5827 t20r=(16.0* t11r- t10r)/15.0;
5828 t20i=(16.0* t11i- t10i)/15.0;
5829
5830 test( t11r, t20r, &te2r, t11i, t20i, &te2i, 0.);
5831 if( (te2i > rx) || (te2r > rx) )
5832 {
5833 nt=0;
5834 if( ns >= nma)
5835 fprintf( output_fp, "\n STEP SIZE LIMITED AT Z= %10.5f", z );
5836 else
5837 {
5838 ns= ns*2;
5839 dz= s/ ns;
5840 dzot= dz*0.5;
5841 g5r= g3r;
5842 g5i= g3i;
5843 g3r= g2r;
5844 g3i= g2i;
5845
5846 flag = FALSE;
5847 continue;
5848 }
5849
5850 } /* if( (te2i > rx) || (te2r > rx) ) */
5851
5852 *sgr= *sgr+ t20r;
5853 *sgi= *sgi+ t20i;
5854 nt++;
5855
5856 z += dz;
5857 if( z >= zend)
5858 {
5859 *sgr= *sgr* rhk*.5;
5860 *sgi= *sgi* rhk*.5;
5861 return;
5862 }
5863
5864 g1r= g5r;
5865 g1i= g5i;
5866 if( nt >= nts)
5867 if( ns > nx)
5868 {
5869 ns= ns/2;
5870 nt=1;
5871 }
5872 flag = TRUE;
5873
5874 } /* while( TRUE ) */
5875
5876 }
5877
5878 /*-----------------------------------------------------------------------*/
5879
5880 /* hintg computes the h field of a patch current */
hintg(double xi,double yi,double zi)5881 void hintg( double xi, double yi, double zi )
5882 {
5883 int ip;
5884 double rx, ry, rfl, xymag, pxx, pyy, cth;
5885 double rz, rsq, r, rk, cr, sr, t1zr, t2zr;
5886 complex double gam, f1x, f1y, f1z, f2x, f2y, f2z, rrv, rrh;
5887
5888 rx= xi- xj;
5889 ry= yi- yj;
5890 rfl=-1.;
5891 exk=CPLX_00;
5892 eyk=CPLX_00;
5893 ezk=CPLX_00;
5894 exs=CPLX_00;
5895 eys=CPLX_00;
5896 ezs=CPLX_00;
5897
5898 for( ip = 1; ip <= ksymp; ip++ )
5899 {
5900 rfl= - rfl;
5901 rz= zi- zj* rfl;
5902 rsq= rx* rx+ ry* ry+ rz* rz;
5903
5904 if( rsq < 1.0e-20)
5905 continue;
5906
5907 r = sqrt( rsq );
5908 rk= TP* r;
5909 cr= cos( rk);
5910 sr= sin( rk);
5911 gam=-( cmplx(cr,-sr)+rk*cmplx(sr,cr) )/( FPI*rsq*r )* s;
5912 exc= gam* rx;
5913 eyc= gam* ry;
5914 ezc= gam* rz;
5915 t1zr= t1zj* rfl;
5916 t2zr= t2zj* rfl;
5917 f1x= eyc* t1zr- ezc* t1yj;
5918 f1y= ezc* t1xj- exc* t1zr;
5919 f1z= exc* t1yj- eyc* t1xj;
5920 f2x= eyc* t2zr- ezc* t2yj;
5921 f2y= ezc* t2xj- exc* t2zr;
5922 f2z= exc* t2yj- eyc* t2xj;
5923
5924 if( ip != 1)
5925 {
5926 if( iperf == 1)
5927 {
5928 f1x= - f1x;
5929 f1y= - f1y;
5930 f1z= - f1z;
5931 f2x= - f2x;
5932 f2y= - f2y;
5933 f2z= - f2z;
5934 }
5935 else
5936 {
5937 xymag= sqrt( rx* rx+ ry* ry);
5938 if( xymag <= 1.0e-6)
5939 {
5940 pxx=0.;
5941 pyy=0.;
5942 cth=1.;
5943 rrv=CPLX_10;
5944 }
5945 else
5946 {
5947 pxx= - ry/ xymag;
5948 pyy= rx/ xymag;
5949 cth= rz/ r;
5950 rrv= csqrt(1.- zrati* zrati*(1.- cth* cth));
5951
5952 } /* if( xymag <= 1.0e-6) */
5953
5954 rrh= zrati* cth;
5955 rrh=( rrh- rrv)/( rrh+ rrv);
5956 rrv= zrati* rrv;
5957 rrv=-( cth- rrv)/( cth+ rrv);
5958 gam=( f1x* pxx+ f1y* pyy)*( rrv- rrh);
5959 f1x= f1x* rrh+ gam* pxx;
5960 f1y= f1y* rrh+ gam* pyy;
5961 f1z= f1z* rrh;
5962 gam=( f2x* pxx+ f2y* pyy)*( rrv- rrh);
5963 f2x= f2x* rrh+ gam* pxx;
5964 f2y= f2y* rrh+ gam* pyy;
5965 f2z= f2z* rrh;
5966
5967 } /* if( iperf == 1) */
5968
5969 } /* if( ip != 1) */
5970
5971 exk += f1x;
5972 eyk += f1y;
5973 ezk += f1z;
5974 exs += f2x;
5975 eys += f2y;
5976 ezs += f2z;
5977
5978 } /* for( ip = 1; ip <= ksymp; ip++ ) */
5979
5980 return;
5981 }
5982
5983 /*-----------------------------------------------------------------------*/
5984
5985 /* hsfld computes the h field for constant, sine, and */
5986 /* cosine current on a segment including ground effects. */
hsfld(double xi,double yi,double zi,double ai)5987 void hsfld( double xi, double yi, double zi, double ai )
5988 {
5989 int ip;
5990 double xij, yij, rfl, salpr, zij, zp, rhox, rhoy, rhoz, rh, phx;
5991 double phy, phz, rmag, xymag, xspec, yspec, rhospc, px, py, cth;
5992 complex double hpk, hps, hpc, qx, qy, qz, rrv, rrh, zratx;
5993
5994 xij= xi- xj;
5995 yij= yi- yj;
5996 rfl=-1.;
5997
5998 for( ip = 0; ip < ksymp; ip++ )
5999 {
6000 rfl= - rfl;
6001 salpr= salpj* rfl;
6002 zij= zi- rfl* zj;
6003 zp= xij* cabj+ yij* sabj+ zij* salpr;
6004 rhox= xij- cabj* zp;
6005 rhoy= yij- sabj* zp;
6006 rhoz= zij- salpr* zp;
6007 rh= sqrt( rhox* rhox+ rhoy* rhoy+ rhoz* rhoz+ ai* ai);
6008
6009 if( rh <= 1.0e-10)
6010 {
6011 exk=0.;
6012 eyk=0.;
6013 ezk=0.;
6014 exs=0.;
6015 eys=0.;
6016 ezs=0.;
6017 exc=0.;
6018 eyc=0.;
6019 ezc=0.;
6020 continue;
6021 }
6022
6023 rhox= rhox/ rh;
6024 rhoy= rhoy/ rh;
6025 rhoz= rhoz/ rh;
6026 phx= sabj* rhoz- salpr* rhoy;
6027 phy= salpr* rhox- cabj* rhoz;
6028 phz= cabj* rhoy- sabj* rhox;
6029
6030 hsflx( s, rh, zp, &hpk, &hps, &hpc);
6031
6032 if( ip == 1 )
6033 {
6034 if( iperf != 1 )
6035 {
6036 zratx= zrati;
6037 rmag= sqrt( zp* zp+ rh* rh);
6038 xymag= sqrt( xij* xij+ yij* yij);
6039
6040 /* set parameters for radial wire ground screen. */
6041 if( nradl != 0)
6042 {
6043 xspec=( xi* zj+ zi* xj)/( zi+ zj);
6044 yspec=( yi* zj+ zi* yj)/( zi+ zj);
6045 rhospc= sqrt( xspec* xspec+ yspec* yspec+ t2* t2);
6046
6047 if( rhospc <= scrwl)
6048 {
6049 rrv= t1* rhospc* log( rhospc/ t2);
6050 zratx=( rrv* zrati)/( ETA* zrati+ rrv);
6051 }
6052 }
6053
6054 /* calculation of reflection coefficients when ground is specified. */
6055 if( xymag <= 1.0e-6)
6056 {
6057 px=0.;
6058 py=0.;
6059 cth=1.;
6060 rrv=CPLX_10;
6061 }
6062 else
6063 {
6064 px= - yij/ xymag;
6065 py= xij/ xymag;
6066 cth= zij/ rmag;
6067 rrv= csqrt(1.- zratx* zratx*(1.- cth* cth));
6068 }
6069
6070 rrh= zratx* cth;
6071 rrh=-( rrh- rrv)/( rrh+ rrv);
6072 rrv= zratx* rrv;
6073 rrv=( cth- rrv)/( cth+ rrv);
6074 qy=( phx* px+ phy* py)*( rrv- rrh);
6075 qx= qy* px+ phx* rrh;
6076 qy= qy* py+ phy* rrh;
6077 qz= phz* rrh;
6078 exk= exk- hpk* qx;
6079 eyk= eyk- hpk* qy;
6080 ezk= ezk- hpk* qz;
6081 exs= exs- hps* qx;
6082 eys= eys- hps* qy;
6083 ezs= ezs- hps* qz;
6084 exc= exc- hpc* qx;
6085 eyc= eyc- hpc* qy;
6086 ezc= ezc- hpc* qz;
6087 continue;
6088
6089 } /* if( iperf != 1 ) */
6090
6091 exk= exk- hpk* phx;
6092 eyk= eyk- hpk* phy;
6093 ezk= ezk- hpk* phz;
6094 exs= exs- hps* phx;
6095 eys= eys- hps* phy;
6096 ezs= ezs- hps* phz;
6097 exc= exc- hpc* phx;
6098 eyc= eyc- hpc* phy;
6099 ezc= ezc- hpc* phz;
6100 continue;
6101
6102 } /* if( ip == 1 ) */
6103
6104 exk= hpk* phx;
6105 eyk= hpk* phy;
6106 ezk= hpk* phz;
6107 exs= hps* phx;
6108 eys= hps* phy;
6109 ezs= hps* phz;
6110 exc= hpc* phx;
6111 eyc= hpc* phy;
6112 ezc= hpc* phz;
6113
6114 } /* for( ip = 0; ip < ksymp; ip++ ) */
6115
6116 return;
6117 }
6118
6119 /*-----------------------------------------------------------------------*/
6120
6121 /* calculates h field of sine cosine, and constant current of segment */
hsflx(double s,double rh,double zpx,complex double * hpk,complex double * hps,complex double * hpc)6122 void hsflx( double s, double rh, double zpx,
6123 complex double *hpk, complex double *hps,
6124 complex double *hpc )
6125 {
6126 double r1, r2, zp, z2a, hss, dh, z1;
6127 double rhz, dk, cdk, sdk, hkr, hki, rh2;
6128 complex double fjk, ekr1, ekr2, t1, t2, cons;
6129
6130 fjk = -TPJ;
6131 if( rh >= 1.0e-10)
6132 {
6133 if( zpx >= 0.)
6134 {
6135 zp= zpx;
6136 hss=1.;
6137 }
6138 else
6139 {
6140 zp= - zpx;
6141 hss=-1.;
6142 }
6143
6144 dh=.5* s;
6145 z1= zp+ dh;
6146 z2a= zp- dh;
6147 if( z2a >= 1.0e-7)
6148 rhz= rh/ z2a;
6149 else
6150 rhz=1.;
6151
6152 dk= TP* dh;
6153 cdk= cos( dk);
6154 sdk= sin( dk);
6155 hfk(- dk, dk, rh* TP, zp* TP, &hkr, &hki);
6156 *hpk= cmplx( hkr, hki);
6157
6158 if( rhz >= 1.0e-3)
6159 {
6160 rh2= rh* rh;
6161 r1= sqrt( rh2+ z1* z1);
6162 r2= sqrt( rh2+ z2a* z2a);
6163 ekr1= cexp( fjk* r1);
6164 ekr2= cexp( fjk* r2);
6165 t1= z1* ekr1/ r1;
6166 t2= z2a* ekr2/ r2;
6167 *hps=( cdk*( ekr2- ekr1)- CPLX_01* sdk*( t2+ t1))* hss;
6168 *hpc= - sdk*( ekr2+ ekr1)- CPLX_01* cdk*( t2- t1);
6169 cons= - CPLX_01/(2.* TP* rh);
6170 *hps= cons* *hps;
6171 *hpc= cons* *hpc;
6172 return;
6173
6174 } /* if( rhz >= 1.0e-3) */
6175
6176 ekr1= cmplx( cdk, sdk)/( z2a* z2a);
6177 ekr2= cmplx( cdk,- sdk)/( z1* z1);
6178 t1= TP*(1./ z1-1./ z2a);
6179 t2= cexp( fjk* zp)* rh/ PI8;
6180 *hps= t2*( t1+( ekr1+ ekr2)* sdk)* hss;
6181 *hpc= t2*(- CPLX_01* t1+( ekr1- ekr2)* cdk);
6182 return;
6183
6184 } /* if( rh >= 1.0e-10) */
6185
6186 *hps=CPLX_00;
6187 *hpc=CPLX_00;
6188 *hpk=CPLX_00;
6189
6190 return;
6191 }
6192
6193 /*-----------------------------------------------------------------------*/
6194
6195 /* intrp uses bivariate cubic interpolation to obtain */
6196 /* the values of 4 functions at the point (x,y). */
intrp(double x,double y,complex double * f1,complex double * f2,complex double * f3,complex double * f4)6197 void intrp( double x, double y, complex double *f1,
6198 complex double *f2, complex double *f3, complex double *f4 )
6199 {
6200 static int ix, iy, ixs=-10, iys=-10, igrs=-10, ixeg=0, iyeg=0;
6201 static int nxm2, nym2, nxms, nyms, nd, ndp;
6202 int nda[3]={11,17,9}, ndpa[3]={110,85,72};
6203 int igr, iadd, iadz, i, k, jump;
6204 static double dx = 1., dy = 1., xs = 0., ys = 0., xz, yz;
6205 double xx, yy;
6206 complex double a[4][4], b[4][4], c[4][4], d[4][4];
6207 complex double p1, p2, p3, p4, fx1, fx2, fx3, fx4;
6208
6209 jump = TRUE;
6210 if( (x < xs) || (y < ys) )
6211 jump = FALSE;
6212 else
6213 {
6214 ix= (int)(( x- xs)/ dx)+1;
6215 iy= (int)(( y- ys)/ dy)+1;
6216 }
6217
6218 /* if point lies in same 4 by 4 point region */
6219 /* as previous point, old values are reused. */
6220 if( (ix < ixeg) ||
6221 (iy < iyeg) ||
6222 (abs(ix- ixs) >= 2) ||
6223 (abs(iy- iys) >= 2) ||
6224 (! jump) )
6225 {
6226 /* determine correct grid and grid region */
6227 if( x <= xsa[1])
6228 igr=0;
6229 else
6230 {
6231 if( y > ysa[2])
6232 igr=2;
6233 else
6234 igr=1;
6235 }
6236
6237 if( igr != igrs)
6238 {
6239 igrs= igr;
6240 dx= dxa[igrs];
6241 dy= dya[igrs];
6242 xs= xsa[igrs];
6243 ys= ysa[igrs];
6244 nxm2= nxa[igrs]-2;
6245 nym2= nya[igrs]-2;
6246 nxms=(( nxm2+1)/3)*3+1;
6247 nyms=(( nym2+1)/3)*3+1;
6248 nd= nda[igrs];
6249 ndp= ndpa[igrs];
6250 ix= (int)(( x- xs)/ dx)+1;
6251 iy= (int)(( y- ys)/ dy)+1;
6252
6253 } /* if( igr != igrs) */
6254
6255 ixs=(( ix-1)/3)*3+2;
6256 if( ixs < 2)
6257 ixs=2;
6258 ixeg=-10000;
6259
6260 if( ixs > nxm2)
6261 {
6262 ixs= nxm2;
6263 ixeg= nxms;
6264 }
6265
6266 iys=(( iy-1)/3)*3+2;
6267 if( iys < 2)
6268 iys=2;
6269 iyeg=-10000;
6270
6271 if( iys > nym2)
6272 {
6273 iys= nym2;
6274 iyeg= nyms;
6275 }
6276
6277 /* compute coefficients of 4 cubic polynomials in x for */
6278 /* the 4 grid values of y for each of the 4 functions */
6279 iadz= ixs+( iys-3)* nd- ndp;
6280 for( k = 0; k < 4; k++ )
6281 {
6282 iadz += ndp;
6283 iadd = iadz;
6284
6285 for( i = 0; i < 4; i++ )
6286 {
6287 iadd += nd;
6288
6289 switch( igrs )
6290 {
6291 case 0:
6292 p1= ar1[iadd-2];
6293 p2= ar1[iadd-1];
6294 p3= ar1[iadd];
6295 p4= ar1[iadd+1];
6296 break;
6297
6298 case 1:
6299 p1= ar2[iadd-2];
6300 p2= ar2[iadd-1];
6301 p3= ar2[iadd];
6302 p4= ar2[iadd+1];
6303 break;
6304
6305 case 2:
6306 p1= ar3[iadd-2];
6307 p2= ar3[iadd-1];
6308 p3= ar3[iadd];
6309 p4= ar3[iadd+1];
6310 } /* switch( igrs ) */
6311
6312 a[i][k]=( p4- p1+3.*( p2- p3))*.1666666667;
6313 b[i][k]=( p1-2.* p2+ p3)*.5;
6314 c[i][k]= p3-(2.* p1+3.* p2+ p4)*.1666666667;
6315 d[i][k]= p2;
6316
6317 } /* for( i = 0; i < 4; i++ ) */
6318
6319 } /* for( k = 0; k < 4; k++ ) */
6320
6321 xz=( ixs-1)* dx+ xs;
6322 yz=( iys-1)* dy+ ys;
6323
6324 } /* if( (abs(ix- ixs) >= 2) || */
6325
6326 /* evaluate polymomials in x and use cubic */
6327 /* interpolation in y for each of the 4 functions. */
6328 xx=( x- xz)/ dx;
6329 yy=( y- yz)/ dy;
6330 fx1=(( a[0][0]* xx+ b[0][0])* xx+ c[0][0])* xx+ d[0][0];
6331 fx2=(( a[1][0]* xx+ b[1][0])* xx+ c[1][0])* xx+ d[1][0];
6332 fx3=(( a[2][0]* xx+ b[2][0])* xx+ c[2][0])* xx+ d[2][0];
6333 fx4=(( a[3][0]* xx+ b[3][0])* xx+ c[3][0])* xx+ d[3][0];
6334 p1= fx4- fx1+3.*( fx2- fx3);
6335 p2=3.*( fx1-2.* fx2+ fx3);
6336 p3=6.* fx3-2.* fx1-3.* fx2- fx4;
6337 *f1=(( p1* yy+ p2)* yy+ p3)* yy*.1666666667+ fx2;
6338 fx1=(( a[0][1]* xx+ b[0][1])* xx+ c[0][1])* xx+ d[0][1];
6339 fx2=(( a[1][1]* xx+ b[1][1])* xx+ c[1][1])* xx+ d[1][1];
6340 fx3=(( a[2][1]* xx+ b[2][1])* xx+ c[2][1])* xx+ d[2][1];
6341 fx4=(( a[3][1]* xx+ b[3][1])* xx+ c[3][1])* xx+ d[3][1];
6342 p1= fx4- fx1+3.*( fx2- fx3);
6343 p2=3.*( fx1-2.* fx2+ fx3);
6344 p3=6.* fx3-2.* fx1-3.* fx2- fx4;
6345 *f2=(( p1* yy+ p2)* yy+ p3)* yy*.1666666667+ fx2;
6346 fx1=(( a[0][2]* xx+ b[0][2])* xx+ c[0][2])* xx+ d[0][2];
6347 fx2=(( a[1][2]* xx+ b[1][2])* xx+ c[1][2])* xx+ d[1][2];
6348 fx3=(( a[2][2]* xx+ b[2][2])* xx+ c[2][2])* xx+ d[2][2];
6349 fx4=(( a[3][2]* xx+ b[3][2])* xx+ c[3][2])* xx+ d[3][2];
6350 p1= fx4- fx1+3.*( fx2- fx3);
6351 p2=3.*( fx1-2.* fx2+ fx3);
6352 p3=6.* fx3-2.* fx1-3.* fx2- fx4;
6353 *f3=(( p1* yy+ p2)* yy+ p3)* yy*.1666666667+ fx2;
6354 fx1=(( a[0][3]* xx+ b[0][3])* xx+ c[0][3])* xx+ d[0][3];
6355 fx2=(( a[1][3]* xx+ b[1][3])* xx+ c[1][3])* xx+ d[1][3];
6356 fx3=(( a[2][3]* xx+ b[2][3])* xx+ c[2][3])* xx+ d[2][3];
6357 fx4=(( a[3][3]* xx+ b[3][3])* xx+ c[3][3])* xx+ d[3][3];
6358 p1= fx4- fx1+3.*( fx2- fx3);
6359 p2=3.*( fx1-2.* fx2+ fx3);
6360 p3=6.* fx3-2.* fx1-3.* fx2- fx4;
6361 *f4=(( p1* yy+ p2)* yy+ p3)* yy*.16666666670+ fx2;
6362
6363 return;
6364 }
6365
6366 /*-----------------------------------------------------------------------*/
6367
6368 /* intx performs numerical integration of exp(jkr)/r by the method of */
6369 /* variable interval width romberg integration. the integrand value */
6370 /* is supplied by subroutine gf. */
intx(double el1,double el2,double b,int ij,double * sgr,double * sgi)6371 void intx( double el1, double el2, double b, int ij, double *sgr, double *sgi)
6372 {
6373 int ns, nt;
6374 int nx = 1, nma = 65536, nts = 4;
6375 int flag = TRUE;
6376 double z, s, ze, fnm, ep, zend, fns, dz=0., zp, dzot=0., t00r, g1r, g5r, t00i;
6377 double g1i, g5i, t01r, g3r, t01i, g3i, t10r, t10i, te1i, te1r, t02r;
6378 double g2r, g4r, t02i, g2i, g4i, t11r, t11i, t20r, t20i, te2i, te2r;
6379 double rx = 1.0e-4;
6380
6381 z= el1;
6382 ze= el2;
6383 if( ij == 0)
6384 ze=0.;
6385 s= ze- z;
6386 fnm= nma;
6387 ep= s/(10.* fnm);
6388 zend= ze- ep;
6389 *sgr=0.;
6390 *sgi=0.;
6391 ns= nx;
6392 nt=0;
6393 gf( z, &g1r, &g1i);
6394
6395 while( TRUE )
6396 {
6397 if( flag )
6398 {
6399 fns= ns;
6400 dz= s/ fns;
6401 zp= z+ dz;
6402
6403 if( zp > ze)
6404 {
6405 dz= ze- z;
6406 if( fabs(dz) <= ep)
6407 {
6408 /* add contribution of near singularity for diagonal term */
6409 if(ij == 0)
6410 {
6411 *sgr=2.*( *sgr+ log(( sqrt( b* b+ s* s)+ s)/ b));
6412 *sgi=2.* *sgi;
6413 }
6414 return;
6415 }
6416
6417 } /* if( zp > ze) */
6418
6419 dzot= dz*.5;
6420 zp= z+ dzot;
6421 gf( zp, &g3r, &g3i);
6422 zp= z+ dz;
6423 gf( zp, &g5r, &g5i);
6424
6425 } /* if( flag ) */
6426
6427 t00r=( g1r+ g5r)* dzot;
6428 t00i=( g1i+ g5i)* dzot;
6429 t01r=( t00r+ dz* g3r)*0.5;
6430 t01i=( t00i+ dz* g3i)*0.5;
6431 t10r=(4.0* t01r- t00r)/3.0;
6432 t10i=(4.0* t01i- t00i)/3.0;
6433
6434 /* test convergence of 3 point romberg result. */
6435 test( t01r, t10r, &te1r, t01i, t10i, &te1i, 0.);
6436 if( (te1i <= rx) && (te1r <= rx) )
6437 {
6438 *sgr= *sgr+ t10r;
6439 *sgi= *sgi+ t10i;
6440 nt += 2;
6441
6442 z += dz;
6443 if( z >= zend)
6444 {
6445 /* add contribution of near singularity for diagonal term */
6446 if(ij == 0)
6447 {
6448 *sgr=2.*( *sgr+ log(( sqrt( b* b+ s* s)+ s)/ b));
6449 *sgi=2.* *sgi;
6450 }
6451 return;
6452 }
6453
6454 g1r= g5r;
6455 g1i= g5i;
6456 if( nt >= nts)
6457 if( ns > nx)
6458 {
6459 /* Double step size */
6460 ns= ns/2;
6461 nt=1;
6462 }
6463 flag = TRUE;
6464 continue;
6465
6466 } /* if( (te1i <= rx) && (te1r <= rx) ) */
6467
6468 zp= z+ dz*0.25;
6469 gf( zp, &g2r, &g2i);
6470 zp= z+ dz*0.75;
6471 gf( zp, &g4r, &g4i);
6472 t02r=( t01r+ dzot*( g2r+ g4r))*0.5;
6473 t02i=( t01i+ dzot*( g2i+ g4i))*0.5;
6474 t11r=(4.0* t02r- t01r)/3.0;
6475 t11i=(4.0* t02i- t01i)/3.0;
6476 t20r=(16.0* t11r- t10r)/15.0;
6477 t20i=(16.0* t11i- t10i)/15.0;
6478
6479 /* test convergence of 5 point romberg result. */
6480 test( t11r, t20r, &te2r, t11i, t20i, &te2i, 0.);
6481 if( (te2i > rx) || (te2r > rx) )
6482 {
6483 nt=0;
6484 if( ns >= nma)
6485 fprintf( output_fp, "\n STEP SIZE LIMITED AT Z= %10.5f", z );
6486 else
6487 {
6488 /* halve step size */
6489 ns= ns*2;
6490 fns= ns;
6491 dz= s/ fns;
6492 dzot= dz*0.5;
6493 g5r= g3r;
6494 g5i= g3i;
6495 g3r= g2r;
6496 g3i= g2i;
6497
6498 flag = FALSE;
6499 continue;
6500 }
6501
6502 } /* if( (te2i > rx) || (te2r > rx) ) */
6503
6504 *sgr= *sgr+ t20r;
6505 *sgi= *sgi+ t20i;
6506 nt++;
6507
6508 z += dz;
6509 if( z >= zend)
6510 {
6511 /* add contribution of near singularity for diagonal term */
6512 if(ij == 0)
6513 {
6514 *sgr=2.*( *sgr+ log(( sqrt( b* b+ s* s)+ s)/ b));
6515 *sgi=2.* *sgi;
6516 }
6517 return;
6518 }
6519
6520 g1r= g5r;
6521 g1i= g5i;
6522 if( nt >= nts)
6523 if( ns > nx)
6524 {
6525 /* Double step size */
6526 ns= ns/2;
6527 nt=1;
6528 }
6529 flag = TRUE;
6530
6531 } /* while( TRUE ) */
6532
6533 }
6534
6535 /*-----------------------------------------------------------------------*/
6536
6537 /* isegno returns the segment number of the mth segment having the */
6538 /* tag number itagi. if itagi=0 segment number m is returned. */
isegno(int itagi,int mx)6539 int isegno( int itagi, int mx)
6540 {
6541 int icnt, i, iseg;
6542
6543 if( mx <= 0)
6544 {
6545 fprintf( output_fp,
6546 "\n CHECK DATA, PARAMETER SPECIFYING SEGMENT"
6547 " POSITION IN A GROUP OF EQUAL TAGS MUST NOT BE ZERO" );
6548 stop(-1);
6549 }
6550
6551 icnt=0;
6552 if( itagi == 0)
6553 {
6554 iseg = mx;
6555 return( iseg );
6556 }
6557
6558 if( n > 0)
6559 {
6560 for( i = 0; i < n; i++ )
6561 {
6562 if( itag[i] != itagi )
6563 continue;
6564
6565 icnt++;
6566 if( icnt == mx)
6567 {
6568 iseg= i+1;
6569 return( iseg );
6570 }
6571
6572 } /* for( i = 0; i < n; i++ ) */
6573
6574 } /* if( n > 0) */
6575
6576 fprintf( output_fp, "\n\n"
6577 " NO SEGMENT HAS AN ITAG OF %d", itagi );
6578 stop(-1);
6579
6580 return(0);
6581 }
6582
6583 /*-----------------------------------------------------------------------*/
6584
6585 /* load calculates the impedance of specified */
6586 /* segments for various types of loading */
load(int * ldtyp,int * ldtag,int * ldtagf,int * ldtagt,double * zlr,double * zli,double * zlc)6587 void load( int *ldtyp, int *ldtag, int *ldtagf, int *ldtagt,
6588 double *zlr, double *zli, double *zlc )
6589 {
6590 int i, iwarn, istep, istepx, l1, l2, ldtags, jump, ichk;
6591 complex double zt, tpcj;
6592
6593 tpcj = (0.0+1.883698955e+9fj);
6594 fprintf( output_fp, "\n"
6595 " LOCATION RESISTANCE INDUCTANCE CAPACITANCE "
6596 " IMPEDANCE (OHMS) CONDUCTIVITY CIRCUIT\n"
6597 " ITAG FROM THRU OHMS HENRYS FARADS "
6598 " REAL IMAGINARY MHOS/METER TYPE" );
6599
6600 /* initialize d array, used for temporary */
6601 /* storage of loading information. */
6602 mem_alloc( (void *)&zarray, npm * sizeof(complex double) );
6603 for( i = 0; i < n; i++ )
6604 zarray[i]=CPLX_00;
6605
6606 iwarn=FALSE;
6607 istep=0;
6608
6609 /* cycle over loading cards */
6610 while( TRUE )
6611 {
6612 istepx = istep;
6613 istep++;
6614
6615 if( istep > nload)
6616 {
6617 if( iwarn == TRUE )
6618 fprintf( output_fp,
6619 "\n NOTE, SOME OF THE ABOVE SEGMENTS "
6620 "HAVE BEEN LOADED TWICE - IMPEDANCES ADDED" );
6621
6622 if( nop == 1)
6623 return;
6624
6625 for( i = 0; i < np; i++ )
6626 {
6627 zt= zarray[i];
6628 l1= i;
6629
6630 for( l2 = 1; l2 < nop; l2++ )
6631 {
6632 l1 += np;
6633 zarray[l1]= zt;
6634 }
6635 }
6636 return;
6637
6638 } /* if( istep > nload) */
6639
6640 if( ldtyp[istepx] > 5 )
6641 {
6642 fprintf( output_fp,
6643 "\n IMPROPER LOAD TYPE CHOSEN,"
6644 " REQUESTED TYPE IS %d", ldtyp[istepx] );
6645 stop(-1);
6646 }
6647
6648 /* search segments for proper itags */
6649 ldtags= ldtag[istepx];
6650 jump= ldtyp[istepx]+1;
6651 ichk=0;
6652 l1= 1;
6653 l2= n;
6654
6655 if( ldtags == 0)
6656 {
6657 if( (ldtagf[istepx] != 0) || (ldtagt[istepx] != 0) )
6658 {
6659 l1= ldtagf[istepx];
6660 l2= ldtagt[istepx];
6661
6662 } /* if( (ldtagf[istepx] != 0) || (ldtagt[istepx] != 0) ) */
6663
6664 } /* if( ldtags == 0) */
6665
6666 for( i = l1-1; i < l2; i++ )
6667 {
6668 if( ldtags != 0)
6669 {
6670 if( ldtags != itag[i])
6671 continue;
6672
6673 if( ldtagf[istepx] != 0)
6674 {
6675 ichk++;
6676 if( (ichk < ldtagf[istepx]) || (ichk > ldtagt[istepx]) )
6677 continue;
6678 }
6679 else
6680 ichk=1;
6681
6682 } /* if( ldtags != 0) */
6683 else
6684 ichk=1;
6685
6686 /* calculation of lamda*imped. per unit length, */
6687 /* jump to appropriate section for loading type */
6688 switch( jump )
6689 {
6690 case 1:
6691 zt= zlr[istepx]/ si[i]+ tpcj* zli[istepx]/( si[i]* wlam);
6692 if( fabs( zlc[istepx]) > 1.0e-20)
6693 zt += wlam/( tpcj* si[i]* zlc[istepx]);
6694 break;
6695
6696 case 2:
6697 zt= tpcj* si[i]* zlc[istepx]/ wlam;
6698 if( fabs( zli[istepx]) > 1.0e-20)
6699 zt += si[i]* wlam/( tpcj* zli[istepx]);
6700 if( fabs( zlr[istepx]) > 1.0e-20)
6701 zt += si[i]/ zlr[istepx];
6702 zt=1./ zt;
6703 break;
6704
6705 case 3:
6706 zt= zlr[istepx]* wlam+ tpcj* zli[istepx];
6707 if( fabs( zlc[istepx]) > 1.0e-20)
6708 zt += 1./( tpcj* si[i]* si[i]* zlc[istepx]);
6709 break;
6710
6711 case 4:
6712 zt= tpcj* si[i]* si[i]* zlc[istepx];
6713 if( fabs( zli[istepx]) > 1.0e-20)
6714 zt += 1./( tpcj* zli[istepx]);
6715 if( fabs( zlr[istepx]) > 1.0e-20)
6716 zt += 1./( zlr[istepx]* wlam);
6717 zt=1./ zt;
6718 break;
6719
6720 case 5:
6721 zt= cmplx( zlr[istepx], zli[istepx])/ si[i];
6722 break;
6723
6724 case 6:
6725 zt= zint( zlr[istepx]* wlam, bi[i]);
6726
6727 } /* switch( jump ) */
6728
6729 if(( fabs( creal( zarray[i]))+ fabs( cimag( zarray[i]))) > 1.0e-20)
6730 iwarn=TRUE;
6731 zarray[i] += zt;
6732
6733 } /* for( i = l1-1; i < l2; i++ ) */
6734
6735 if( ichk == 0 )
6736 {
6737 fprintf( output_fp,
6738 "\n LOADING DATA CARD ERROR,"
6739 " NO SEGMENT HAS AN ITAG = %d", ldtags );
6740 stop(-1);
6741 }
6742
6743 /* printing the segment loading data, jump to proper print */
6744 switch( jump )
6745 {
6746 case 1:
6747 prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
6748 zli[istepx], zlc[istepx],0.,0.,0.," SERIES ", 2);
6749 break;
6750
6751 case 2:
6752 prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
6753 zli[istepx], zlc[istepx],0.,0.,0.,"PARALLEL",2);
6754 break;
6755
6756 case 3:
6757 prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
6758 zli[istepx], zlc[istepx],0.,0.,0., "SERIES (PER METER)", 5);
6759 break;
6760
6761 case 4:
6762 prnt( ldtags, ldtagf[istepx], ldtagt[istepx], zlr[istepx],
6763 zli[istepx], zlc[istepx],0.,0.,0.,"PARALLEL (PER METER)",5);
6764 break;
6765
6766 case 5:
6767 prnt( ldtags, ldtagf[istepx], ldtagt[istepx],0.,0.,0.,
6768 zlr[istepx], zli[istepx],0.,"FIXED IMPEDANCE ",4);
6769 break;
6770
6771 case 6:
6772 prnt( ldtags, ldtagf[istepx], ldtagt[istepx],
6773 0.,0.,0.,0.,0., zlr[istepx]," WIRE ",2);
6774
6775 } /* switch( jump ) */
6776
6777 } /* while( TRUE ) */
6778
6779 return;
6780 }
6781
6782 /*-----------------------------------------------------------------------*/
6783
6784 /* subroutine move moves the structure with respect to its */
6785 /* coordinate system or reproduces structure in new positions. */
6786 /* structure is rotated about x,y,z axes by rox,roy,roz */
6787 /* respectively, then shifted by xs,ys,zs */
move(double rox,double roy,double roz,double xs,double ys,double zs,int its,int nrpt,int itgi)6788 void move( double rox, double roy, double roz, double xs,
6789 double ys, double zs, int its, int nrpt, int itgi )
6790 {
6791 int nrp, ix, i1, k, ir, i, ii, mreq;
6792 double sps, cps, sth, cth, sph, cph, xx, xy;
6793 double xz, yx, yy, yz, zx, zy, zz, xi, yi, zi;
6794
6795 if( fabs( rox)+ fabs( roy) > 1.0e-10)
6796 ipsym= ipsym*3;
6797
6798 sps= sin( rox);
6799 cps= cos( rox);
6800 sth= sin( roy);
6801 cth= cos( roy);
6802 sph= sin( roz);
6803 cph= cos( roz);
6804 xx= cph* cth;
6805 xy= cph* sth* sps- sph* cps;
6806 xz= cph* sth* cps+ sph* sps;
6807 yx= sph* cth;
6808 yy= sph* sth* sps+ cph* cps;
6809 yz= sph* sth* cps- cph* sps;
6810 zx= - sth;
6811 zy= cth* sps;
6812 zz= cth* cps;
6813
6814 if( nrpt == 0)
6815 nrp=1;
6816 else
6817 nrp= nrpt;
6818
6819 ix=1;
6820 if( n > 0)
6821 {
6822 i1= isegno( its, 1);
6823 if( i1 < 1)
6824 i1= 1;
6825
6826 ix= i1;
6827 if( nrpt == 0)
6828 k= i1-1;
6829 else
6830 {
6831 k= n;
6832 /* Reallocate tags buffer */
6833 mreq = n+m + (n+1-i1)*nrpt;
6834 mem_realloc( (void *)&itag, mreq * sizeof(int) );
6835
6836 /* Reallocate wire buffers */
6837 mreq = (n+(n+1-i1)*nrpt) * sizeof(double);
6838 mem_realloc( (void *)&x, mreq );
6839 mem_realloc( (void *)&y, mreq );
6840 mem_realloc( (void *)&z, mreq );
6841 mem_realloc( (void *)&x2, mreq );
6842 mem_realloc( (void *)&y2, mreq );
6843 mem_realloc( (void *)&z2, mreq );
6844 mem_realloc( (void *)&bi, mreq );
6845 }
6846
6847 for( ir = 0; ir < nrp; ir++ )
6848 {
6849 for( i = i1-1; i < n; i++ )
6850 {
6851 xi= x[i];
6852 yi= y[i];
6853 zi= z[i];
6854 x[k]= xi* xx+ yi* xy+ zi* xz+ xs;
6855 y[k]= xi* yx+ yi* yy+ zi* yz+ ys;
6856 z[k]= xi* zx+ yi* zy+ zi* zz+ zs;
6857 xi= x2[i];
6858 yi= y2[i];
6859 zi= z2[i];
6860 x2[k]= xi* xx+ yi* xy+ zi* xz+ xs;
6861 y2[k]= xi* yx+ yi* yy+ zi* yz+ ys;
6862 z2[k]= xi* zx+ yi* zy+ zi* zz+ zs;
6863 bi[k]= bi[i];
6864 itag[k]= itag[i];
6865 if( itag[i] != 0)
6866 itag[k]= itag[i]+ itgi;
6867
6868 k++;
6869
6870 } /* for( i = i1; i < n; i++ ) */
6871
6872 i1= n+1;
6873 n= k;
6874
6875 } /* for( ir = 0; ir < nrp; ir++ ) */
6876
6877 } /* if( n >= n2) */
6878
6879 if( m > 0)
6880 {
6881 i1 = 0;
6882 if( nrpt == 0)
6883 k= 0;
6884 else
6885 k = m;
6886
6887 /* Reallocate patch buffers */
6888 mreq = m * (1+nrpt) * sizeof(double);
6889 mem_realloc( (void *)&px, mreq );
6890 mem_realloc( (void *)&py, mreq );
6891 mem_realloc( (void *)&pz, mreq );
6892 mem_realloc( (void *)&t1x, mreq );
6893 mem_realloc( (void *)&t1y, mreq );
6894 mem_realloc( (void *)&t1z, mreq );
6895 mem_realloc( (void *)&t2x, mreq );
6896 mem_realloc( (void *)&t2y, mreq );
6897 mem_realloc( (void *)&t2z, mreq );
6898 mem_realloc( (void *)&pbi, mreq );
6899 mem_realloc( (void *)&psalp, mreq );
6900
6901 for( ii = 0; ii < nrp; ii++ )
6902 {
6903 for( i = i1; i < m; i++ )
6904 {
6905 xi= px[i];
6906 yi= py[i];
6907 zi= pz[i];
6908 px[k]= xi* xx+ yi* xy+ zi* xz+ xs;
6909 py[k]= xi* yx+ yi* yy+ zi* yz+ ys;
6910 pz[k]= xi* zx+ yi* zy+ zi* zz+ zs;
6911 xi= t1x[i];
6912 yi= t1y[i];
6913 zi= t1z[i];
6914 t1x[k]= xi* xx+ yi* xy+ zi* xz;
6915 t1y[k]= xi* yx+ yi* yy+ zi* yz;
6916 t1z[k]= xi* zx+ yi* zy+ zi* zz;
6917 xi= t2x[i];
6918 yi= t2y[i];
6919 zi= t2z[i];
6920 t2x[k]= xi* xx+ yi* xy+ zi* xz;
6921 t2y[k]= xi* yx+ yi* yy+ zi* yz;
6922 t2z[k]= xi* zx+ yi* zy+ zi* zz;
6923 psalp[k]= psalp[i];
6924 pbi[k]= pbi[i];
6925 k++;
6926
6927 } /* for( i = i1; i < m; i++ ) */
6928
6929 i1= m;
6930 m = k;
6931
6932 } /* for( ii = 0; ii < nrp; ii++ ) */
6933
6934 } /* if( m >= m2) */
6935
6936 if( (nrpt == 0) && (ix == 1) )
6937 return;
6938
6939 np= n;
6940 mp= m;
6941 ipsym=0;
6942
6943 return;
6944 }
6945
6946 /*-----------------------------------------------------------------------*/
6947
6948 /* nefld computes the near field at specified points in space after */
6949 /* the structure currents have been computed. */
nefld(double xob,double yob,double zob,complex double * ex,complex double * ey,complex double * ez)6950 void nefld( double xob, double yob, double zob,
6951 complex double *ex, complex double *ey, complex double *ez )
6952 {
6953 int i, ix, ipr, iprx, jc, ipa;
6954 double zp, xi, ax;
6955 complex double acx, bcx, ccx;
6956
6957 *ex=CPLX_00;
6958 *ey=CPLX_00;
6959 *ez=CPLX_00;
6960 ax=0.;
6961
6962 if( n != 0)
6963 {
6964 for( i = 0; i < n; i++ )
6965 {
6966 xj= xob- x[i];
6967 yj= yob- y[i];
6968 zj= zob- z[i];
6969 zp= cab[i]* xj+ sab[i]* yj+ salp[i]* zj;
6970
6971 if( fabs( zp) > 0.5001* si[i])
6972 continue;
6973
6974 zp= xj* xj+ yj* yj+ zj* zj- zp* zp;
6975 xj= bi[i];
6976
6977 if( zp > 0.9* xj* xj)
6978 continue;
6979
6980 ax= xj;
6981 break;
6982
6983 } /* for( i = 0; i < n; i++ ) */
6984
6985 for( i = 0; i < n; i++ )
6986 {
6987 ix = i+1;
6988 s= si[i];
6989 b= bi[i];
6990 xj= x[i];
6991 yj= y[i];
6992 zj= z[i];
6993 cabj= cab[i];
6994 sabj= sab[i];
6995 salpj= salp[i];
6996
6997 if( iexk != 0)
6998 {
6999 ipr= icon1[i];
7000
7001 if( ipr < 0 )
7002 {
7003 ipr = -ipr;
7004 iprx = ipr-1;
7005
7006 if( -icon1[iprx] != ix )
7007 ind1=2;
7008 else
7009 {
7010 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
7011 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.0e-6) )
7012 ind1=2;
7013 else
7014 ind1=0;
7015 }
7016 } /* if( ipr < 0 ) */
7017 else
7018 if( ipr == 0 )
7019 ind1=1;
7020 else
7021 {
7022 iprx = ipr-1;
7023
7024 if( ipr != ix )
7025 {
7026 if( icon2[iprx] != ix )
7027 ind1=2;
7028 else
7029 {
7030 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
7031 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.0e-6) )
7032 ind1=2;
7033 else
7034 ind1=0;
7035 }
7036 } /* if( ipr != ix ) */
7037 else
7038 {
7039 if( cabj* cabj+ sabj* sabj > 1.0e-8)
7040 ind1=2;
7041 else
7042 ind1=0;
7043 }
7044 } /* else */
7045
7046 ipr= icon2[i];
7047
7048 if( ipr < 0 )
7049 {
7050 ipr = -ipr;
7051 iprx = ipr-1;
7052
7053 if( -icon2[iprx] != ix )
7054 ind1=2;
7055 else
7056 {
7057 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
7058 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.0e-6) )
7059 ind1=2;
7060 else
7061 ind1=0;
7062 }
7063 } /* if( ipr < 0 ) */
7064 else
7065 if( ipr == 0 )
7066 ind2=1;
7067 else
7068 {
7069 iprx = ipr-1;
7070
7071 if( ipr != ix )
7072 {
7073 if( icon1[iprx] != ix )
7074 ind2=2;
7075 else
7076 {
7077 xi= fabs( cabj* cab[iprx]+ sabj* sab[iprx]+ salpj* salp[iprx]);
7078 if( (xi < 0.999999) || (fabs(bi[iprx]/b-1.) > 1.0e-6) )
7079 ind2=2;
7080 else
7081 ind2=0;
7082 }
7083 } /* if( ipr != (i+1) ) */
7084 else
7085 {
7086 if( cabj* cabj+ sabj* sabj > 1.0e-8)
7087 ind1=2;
7088 else
7089 ind1=0;
7090 }
7091
7092 } /* else */
7093
7094 } /* if( iexk != 0) */
7095
7096 efld( xob, yob, zob, ax,1);
7097 acx= cmplx( air[i], aii[i]);
7098 bcx= cmplx( bir[i], bii[i]);
7099 ccx= cmplx( cir[i], cii[i]);
7100 *ex += exk* acx+ exs* bcx+ exc* ccx;
7101 *ey += eyk* acx+ eys* bcx+ eyc* ccx;
7102 *ez += ezk* acx+ ezs* bcx+ ezc* ccx;
7103
7104 } /* for( i = 0; i < n; i++ ) */
7105
7106 if( m == 0)
7107 return;
7108
7109 } /* if( n != 0) */
7110
7111 jc= n-1;
7112 for( i = 0; i < m; i++ )
7113 {
7114 s= pbi[i];
7115 xj= px[i];
7116 yj= py[i];
7117 zj= pz[i];
7118 t1xj= t1x[i];
7119 t1yj= t1y[i];
7120 t1zj= t1z[i];
7121 t2xj= t2x[i];
7122 t2yj= t2y[i];
7123 t2zj= t2z[i];
7124 jc += 3;
7125 acx= t1xj* cur[jc-2]+ t1yj* cur[jc-1]+ t1zj* cur[jc];
7126 bcx= t2xj* cur[jc-2]+ t2yj* cur[jc-1]+ t2zj* cur[jc];
7127
7128 for( ipa = 0; ipa < ksymp; ipa++ )
7129 {
7130 ipgnd= ipa+1;
7131 unere( xob, yob, zob);
7132 *ex= *ex+ acx* exk+ bcx* exs;
7133 *ey= *ey+ acx* eyk+ bcx* eys;
7134 *ez= *ez+ acx* ezk+ bcx* ezs;
7135 }
7136
7137 } /* for( i = 0; i < m; i++ ) */
7138
7139 return;
7140 }
7141
7142 /*-----------------------------------------------------------------------*/
7143
7144 /* subroutine netwk solves for structure currents for a given */
7145 /* excitation including the effect of non-radiating networks if */
7146 /* present. */
netwk(complex double * cm,complex double * cmb,complex double * cmc,complex double * cmd,int * ip,complex double * einc)7147 void netwk( complex double *cm, complex double *cmb,
7148 complex double *cmc, complex double *cmd, int *ip,
7149 complex double *einc )
7150 {
7151 int *ipnt = NULL, *nteqa = NULL, *ntsca = NULL;
7152 int jump1, jump2, nteq=0, ntsc=0, nseg2, irow2=0, j, ndimn;
7153 int neqz2, neqt, irow1=0, i, nseg1, isc1=0, isc2=0;
7154 double asmx, asa, pwr, y11r, y11i, y12r, y12i, y22r, y22i;
7155 complex double *vsrc = NULL, *rhs = NULL, *cmn = NULL;
7156 complex double *rhnt = NULL, *rhnx = NULL, ymit, vlt, cux;
7157
7158 neqz2= neq2;
7159 if( neqz2 == 0)
7160 neqz2=1;
7161
7162 pin=0.;
7163 pnls=0.;
7164 neqt= neq+ neq2;
7165 ndimn = j = (2*nonet + nsant);
7166
7167 /* Allocate network buffers */
7168 if( nonet > 0 )
7169 {
7170 mem_alloc( (void *)&rhs, np3m * sizeof(complex double) );
7171
7172 i = j * sizeof(complex double);
7173 mem_alloc( (void *)&rhnt, i );
7174 mem_alloc( (void *)&rhnx, i );
7175 mem_alloc( (void *)&cmn, i * j );
7176
7177 i = j * sizeof(int);
7178 mem_alloc( (void *)&ntsca, i );
7179 mem_alloc( (void *)&nteqa, i );
7180 mem_alloc( (void *)&ipnt, i );
7181
7182 mem_alloc( (void *)&vsrc, nsant * sizeof(complex double) );
7183 }
7184
7185 if( ntsol == 0)
7186 {
7187 /* compute relative matrix asymmetry */
7188 if( masym != 0)
7189 {
7190 irow1=0;
7191 if( nonet != 0)
7192 {
7193 for( i = 0; i < nonet; i++ )
7194 {
7195 nseg1= iseg1[i];
7196 for( isc1 = 0; isc1 < 2; isc1++ )
7197 {
7198 if( irow1 == 0)
7199 {
7200 ipnt[irow1]= nseg1;
7201 nseg1= iseg2[i];
7202 irow1++;
7203 continue;
7204 }
7205
7206 for( j = 0; j < irow1; j++ )
7207 if( nseg1 == ipnt[j])
7208 break;
7209
7210 if( j == irow1 )
7211 {
7212 ipnt[irow1]= nseg1;
7213 irow1++;
7214 }
7215
7216 nseg1= iseg2[i];
7217
7218 } /* for( isc1 = 0; isc1 < 2; isc1++ ) */
7219
7220 } /* for( i = 0; i < nonet; i++ ) */
7221
7222 } /* if( nonet != 0) */
7223
7224 if( nsant != 0)
7225 {
7226 for( i = 0; i < nsant; i++ )
7227 {
7228 nseg1= isant[i];
7229 if( irow1 == 0)
7230 {
7231 ipnt[irow1]= nseg1;
7232 irow1++;
7233 continue;
7234 }
7235
7236 for( j = 0; j < irow1; j++ )
7237 if( nseg1 == ipnt[j])
7238 break;
7239
7240 if( j == irow1 )
7241 {
7242 ipnt[irow1]= nseg1;
7243 irow1++;
7244 }
7245
7246 } /* for( i = 0; i < nsant; i++ ) */
7247
7248 } /* if( nsant != 0) */
7249
7250 if( irow1 >= 2)
7251 {
7252 for( i = 0; i < irow1; i++ )
7253 {
7254 isc1= ipnt[i]-1;
7255 asmx= si[isc1];
7256
7257 for( j = 0; j < neqt; j++ )
7258 rhs[j] = CPLX_00;
7259
7260 rhs[isc1] = CPLX_10;
7261 solves( cm, ip, rhs, neq, 1, np, n, mp, m);
7262 cabc( rhs);
7263
7264 for( j = 0; j < irow1; j++ )
7265 {
7266 isc1= ipnt[j]-1;
7267 cmn[j+i*ndimn]= rhs[isc1]/ asmx;
7268 }
7269
7270 } /* for( i = 0; i < irow1; i++ ) */
7271
7272 asmx=0.;
7273 asa=0.;
7274
7275 for( i = 1; i < irow1; i++ )
7276 {
7277 isc1= i;
7278 for( j = 0; j < isc1; j++ )
7279 {
7280 cux= cmn[i+j*ndimn];
7281 pwr= cabs(( cux- cmn[j+i*ndimn])/ cux);
7282 asa += pwr* pwr;
7283
7284 if( pwr < asmx)
7285 continue;
7286
7287 asmx= pwr;
7288 nteq= ipnt[i];
7289 ntsc= ipnt[j];
7290
7291 } /* for( j = 0; j < isc1; j++ ) */
7292
7293 } /* for( i = 1; i < irow1; i++ ) */
7294
7295 asa= sqrt( asa*2./ (double)( irow1*( irow1-1)));
7296 fprintf( output_fp, "\n\n"
7297 " MAXIMUM RELATIVE ASYMMETRY OF THE DRIVING POINT ADMITTANCE\n"
7298 " MATRIX IS %10.3E FOR SEGMENTS %d AND %d\n"
7299 " RMS RELATIVE ASYMMETRY IS %10.3E",
7300 asmx, nteq, ntsc, asa );
7301
7302 } /* if( irow1 >= 2) */
7303
7304 } /* if( masym != 0) */
7305
7306 /* solution of network equations */
7307 if( nonet != 0)
7308 {
7309 for( i = 0; i < ndimn; i++ )
7310 {
7311 rhnx[i]=CPLX_00;
7312 for( j = 0; j < ndimn; j++ )
7313 cmn[j+i*ndimn]=CPLX_00;
7314 }
7315
7316 nteq=0;
7317 ntsc=0;
7318
7319 /* sort network and source data and */
7320 /* assign equation numbers to segments */
7321 for( j = 0; j < nonet; j++ )
7322 {
7323 nseg1= iseg1[j];
7324 nseg2= iseg2[j];
7325
7326 if( ntyp[j] <= 1)
7327 {
7328 y11r= x11r[j];
7329 y11i= x11i[j];
7330 y12r= x12r[j];
7331 y12i= x12i[j];
7332 y22r= x22r[j];
7333 y22i= x22i[j];
7334 }
7335 else
7336 {
7337 y22r= TP* x11i[j]/ wlam;
7338 y12r=0.;
7339 y12i=1./( x11r[j]* sin( y22r));
7340 y11r= x12r[j];
7341 y11i= - y12i* cos( y22r);
7342 y22r= x22r[j];
7343 y22i= y11i+ x22i[j];
7344 y11i= y11i+ x12i[j];
7345
7346 if( ntyp[j] != 2)
7347 {
7348 y12r= - y12r;
7349 y12i= - y12i;
7350 }
7351
7352 } /* if( ntyp[j] <= 1) */
7353
7354 jump1 = FALSE;
7355 if( nsant != 0)
7356 {
7357 for( i = 0; i < nsant; i++ )
7358 if( nseg1 == isant[i])
7359 {
7360 isc1 = i;
7361 jump1 = TRUE;
7362 break;
7363 }
7364
7365 } /* if( nsant != 0) */
7366
7367 jump2 = FALSE;
7368 if( ! jump1 )
7369 {
7370 isc1=-1;
7371
7372 if( nteq != 0)
7373 {
7374 for( i = 0; i < nteq; i++ )
7375 if( nseg1 == nteqa[i])
7376 {
7377 irow1 = i;
7378 jump2 = TRUE;
7379 break;
7380 }
7381
7382 } /* if( nteq != 0) */
7383
7384 if( ! jump2 )
7385 {
7386 irow1= nteq;
7387 nteqa[nteq]= nseg1;
7388 nteq++;
7389 }
7390
7391 } /* if( ! jump1 ) */
7392 else
7393 {
7394 if( ntsc != 0)
7395 {
7396 for( i = 0; i < ntsc; i++ )
7397 {
7398 if( nseg1 == ntsca[i])
7399 {
7400 irow1 = ndimn- (i+1);
7401 jump2 = TRUE;
7402 break;
7403 }
7404 }
7405
7406 } /* if( ntsc != 0) */
7407
7408 if( ! jump2 )
7409 {
7410 irow1= ndimn- (ntsc+1);
7411 ntsca[ntsc]= nseg1;
7412 vsrc[ntsc]= vsant[isc1];
7413 ntsc++;
7414 }
7415
7416 } /* if( ! jump1 ) */
7417
7418 jump1 = FALSE;
7419 if( nsant != 0)
7420 {
7421 for( i = 0; i < nsant; i++ )
7422 {
7423 if( nseg2 == isant[i])
7424 {
7425 isc2= i;
7426 jump1 = TRUE;
7427 break;
7428 }
7429 }
7430
7431 } /* if( nsant != 0) */
7432
7433 jump2 = FALSE;
7434 if( ! jump1 )
7435 {
7436 isc2=-1;
7437
7438 if( nteq != 0)
7439 {
7440 for( i = 0; i < nteq; i++ )
7441 if( nseg2 == nteqa[i])
7442 {
7443 irow2= i;
7444 jump2 = TRUE;
7445 break;
7446 }
7447
7448 } /* if( nteq != 0) */
7449
7450 if( ! jump2 )
7451 {
7452 irow2= nteq;
7453 nteqa[nteq]= nseg2;
7454 nteq++;
7455 }
7456
7457 } /* if( ! jump1 ) */
7458 else
7459 {
7460 if( ntsc != 0)
7461 {
7462 for( i = 0; i < ntsc; i++ )
7463 if( nseg2 == ntsca[i])
7464 {
7465 irow2 = ndimn- (i+1);
7466 jump2 = TRUE;
7467 break;
7468 }
7469
7470 } /* if( ntsc != 0) */
7471
7472 if( ! jump2 )
7473 {
7474 irow2= ndimn- (ntsc+1);
7475 ntsca[ntsc]= nseg2;
7476 vsrc[ntsc]= vsant[isc2];
7477 ntsc++;
7478 }
7479
7480 } /* if( ! jump1 ) */
7481
7482 /* fill network equation matrix and right hand side vector with */
7483 /* network short-circuit admittance matrix coefficients. */
7484 if( isc1 == -1)
7485 {
7486 cmn[irow1+irow1*ndimn] -= cmplx( y11r, y11i)* si[nseg1-1];
7487 cmn[irow1+irow2*ndimn] -= cmplx( y12r, y12i)* si[nseg1-1];
7488 }
7489 else
7490 {
7491 rhnx[irow1] += cmplx( y11r, y11i)* vsant[isc1]/wlam;
7492 rhnx[irow2] += cmplx( y12r, y12i)* vsant[isc1]/wlam;
7493 }
7494
7495 if( isc2 == -1)
7496 {
7497 cmn[irow2+irow2*ndimn] -= cmplx( y22r, y22i)* si[nseg2-1];
7498 cmn[irow2+irow1*ndimn] -= cmplx( y12r, y12i)* si[nseg2-1];
7499 }
7500 else
7501 {
7502 rhnx[irow1] += cmplx( y12r, y12i)* vsant[isc2]/wlam;
7503 rhnx[irow2] += cmplx( y22r, y22i)* vsant[isc2]/wlam;
7504 }
7505
7506 } /* for( j = 0; j < nonet; j++ ) */
7507
7508 /* add interaction matrix admittance */
7509 /* elements to network equation matrix */
7510 for( i = 0; i < nteq; i++ )
7511 {
7512 for( j = 0; j < neqt; j++ )
7513 rhs[j] = CPLX_00;
7514
7515 irow1= nteqa[i]-1;
7516 rhs[irow1]=CPLX_10;
7517 solves( cm, ip, rhs, neq, 1, np, n, mp, m);
7518 cabc( rhs);
7519
7520 for( j = 0; j < nteq; j++ )
7521 {
7522 irow1= nteqa[j]-1;
7523 cmn[i+j*ndimn] += rhs[irow1];
7524 }
7525
7526 } /* for( i = 0; i < nteq; i++ ) */
7527
7528 /* factor network equation matrix */
7529 factr( nteq, cmn, ipnt, ndimn);
7530
7531 } /* if( nonet != 0) */
7532
7533 } /* if( ntsol != 0) */
7534
7535 if( nonet != 0)
7536 {
7537 /* add to network equation right hand side */
7538 /* the terms due to element interactions */
7539 for( i = 0; i < neqt; i++ )
7540 rhs[i]= einc[i];
7541
7542 solves( cm, ip, rhs, neq, 1, np, n, mp, m);
7543 cabc( rhs);
7544
7545 for( i = 0; i < nteq; i++ )
7546 {
7547 irow1= nteqa[i]-1;
7548 rhnt[i]= rhnx[i]+ rhs[irow1];
7549 }
7550
7551 /* solve network equations */
7552 solve( nteq, cmn, ipnt, rhnt, ndimn);
7553
7554 /* add fields due to network voltages to electric fields */
7555 /* applied to structure and solve for induced current */
7556 for( i = 0; i < nteq; i++ )
7557 {
7558 irow1= nteqa[i]-1;
7559 einc[irow1] -= rhnt[i];
7560 }
7561
7562 solves( cm, ip, einc, neq, 1, np, n, mp, m);
7563 cabc( einc);
7564
7565 if( nprint == 0)
7566 {
7567 fprintf( output_fp, "\n\n\n"
7568 " "
7569 "--------- STRUCTURE EXCITATION DATA AT NETWORK CONNECTION POINTS --------" );
7570
7571 fprintf( output_fp, "\n"
7572 " TAG SEG VOLTAGE (VOLTS) CURRENT (AMPS) "
7573 " IMPEDANCE (OHMS) ADMITTANCE (MHOS) POWER\n"
7574 " No: No: REAL IMAGINARY REAL IMAGINARY "
7575 " REAL IMAGINARY REAL IMAGINARY (WATTS)" );
7576 }
7577
7578 for( i = 0; i < nteq; i++ )
7579 {
7580 irow1= nteqa[i]-1;
7581 vlt= rhnt[i]* si[irow1]* wlam;
7582 cux= einc[irow1]* wlam;
7583 ymit= cux/ vlt;
7584 zped= vlt/ cux;
7585 irow2= itag[irow1];
7586 pwr=.5* creal( vlt* conj( cux));
7587 pnls= pnls- pwr;
7588
7589 if( nprint == 0)
7590 fprintf( output_fp, "\n"
7591 " %4d %5d %11.4E %11.4E %11.4E %11.4E"
7592 " %11.4E %11.4E %11.4E %11.4E %11.4E",
7593 irow2, irow1+1, creal(vlt), cimag(vlt), creal(cux), cimag(cux),
7594 creal(zped), cimag(zped), creal(ymit), cimag(ymit), pwr );
7595 }
7596
7597 if( ntsc != 0)
7598 {
7599 for( i = 0; i < ntsc; i++ )
7600 {
7601 irow1= ntsca[i]-1;
7602 vlt= vsrc[i];
7603 cux= einc[irow1]* wlam;
7604 ymit= cux/ vlt;
7605 zped= vlt/ cux;
7606 irow2= itag[irow1];
7607 pwr=.5* creal( vlt* conj( cux));
7608 pnls= pnls- pwr;
7609
7610 if( nprint == 0)
7611 fprintf( output_fp, "\n"
7612 " %4d %5d %11.4E %11.4E %11.4E %11.4E"
7613 " %11.4E %11.4E %11.4E %11.4E %11.4E",
7614 irow2, irow1+1, creal(vlt), cimag(vlt), creal(cux), cimag(cux),
7615 creal(zped), cimag(zped), creal(ymit), cimag(ymit), pwr );
7616
7617 } /* for( i = 0; i < ntsc; i++ ) */
7618
7619 } /* if( ntsc != 0) */
7620
7621 } /* if( nonet != 0) */
7622 else
7623 {
7624 /* solve for currents when no networks are present */
7625 solves( cm, ip, einc, neq, 1, np, n, mp, m);
7626 cabc( einc);
7627 ntsc=0;
7628 }
7629
7630 if( (nsant+nvqd) == 0)
7631 return;
7632
7633 fprintf( output_fp, "\n\n\n"
7634 " "
7635 "--------- ANTENNA INPUT PARAMETERS ---------" );
7636
7637 fprintf( output_fp, "\n"
7638 " TAG SEG VOLTAGE (VOLTS) "
7639 "CURRENT (AMPS) IMPEDANCE (OHMS) "
7640 " ADMITTANCE (MHOS) POWER\n"
7641 " No: No: REAL IMAGINARY"
7642 " REAL IMAGINARY REAL "
7643 "IMAGINARY REAL IMAGINARY (WATTS)" );
7644
7645 if( nsant != 0)
7646 {
7647 for( i = 0; i < nsant; i++ )
7648 {
7649 isc1= isant[i]-1;
7650 vlt= vsant[i];
7651
7652 if( ntsc == 0)
7653 {
7654 cux= einc[isc1]* wlam;
7655 irow1=0;
7656 }
7657 else
7658 {
7659 for( j = 0; j < ntsc; j++ )
7660 if( ntsca[j] == isc1+1)
7661 {
7662 irow1= ndimn- (j+1);
7663 cux= rhnx[irow1];
7664 for( j = 0; j < nteq; j++ )
7665 cux -= cmn[j+irow1*ndimn]*rhnt[j];
7666 cux=(einc[isc1]+ cux)* wlam;
7667 irow1++;
7668 }
7669
7670 } /* if( ntsc == 0) */
7671
7672 ymit= cux/ vlt;
7673 zped= vlt/ cux;
7674 pwr=.5* creal( vlt* conj( cux));
7675 pin= pin+ pwr;
7676
7677 if( irow1 != 0)
7678 pnls= pnls+ pwr;
7679
7680 irow2= itag[isc1];
7681 fprintf( output_fp, "\n"
7682 " %4d %5d %11.4E %11.4E %11.4E %11.4E"
7683 " %11.4E %11.4E %11.4E %11.4E %11.4E",
7684 irow2, isc1+1, creal(vlt), cimag(vlt), creal(cux), cimag(cux),
7685 creal(zped), cimag(zped), creal(ymit), cimag(ymit), pwr );
7686
7687 } /* for( i = 0; i < nsant; i++ ) */
7688
7689 } /* if( nsant != 0) */
7690
7691 if( nvqd == 0)
7692 return;
7693
7694 for( i = 0; i < nvqd; i++ )
7695 {
7696 isc1= ivqd[i]-1;
7697 vlt= vqd[i];
7698 cux= cmplx( air[isc1], aii[isc1]);
7699 ymit= cmplx( bir[isc1], bii[isc1]);
7700 zped= cmplx( cir[isc1], cii[isc1]);
7701 pwr= si[isc1]* TP*.5;
7702 cux=( cux- ymit* sin( pwr)+ zped* cos( pwr))* wlam;
7703 ymit= cux/ vlt;
7704 zped= vlt/ cux;
7705 pwr=.5* creal( vlt* conj( cux));
7706 pin= pin+ pwr;
7707 irow2= itag[isc1];
7708
7709 fprintf( output_fp, "\n"
7710 " %4d %5d %11.4E %11.4E %11.4E %11.4E"
7711 " %11.4E %11.4E %11.4E %11.4E %11.4E",
7712 irow2, isc1+1, creal(vlt), cimag(vlt), creal(cux), cimag(cux),
7713 creal(zped), cimag(zped), creal(ymit), cimag(ymit), pwr );
7714
7715 } /* for( i = 0; i < nvqd; i++ ) */
7716
7717 /* Free network buffers */
7718 free_ptr( (void *)&ipnt );
7719 free_ptr( (void *)&nteqa );
7720 free_ptr( (void *)&ntsca );
7721 free_ptr( (void *)&vsrc );
7722 free_ptr( (void *)&rhs );
7723 free_ptr( (void *)&cmn );
7724 free_ptr( (void *)&rhnt );
7725 free_ptr( (void *)&rhnx );
7726
7727 return;
7728 }
7729
7730 /*-----------------------------------------------------------------------*/
7731
7732 /* compute near e or h fields over a range of points */
nfpat(void)7733 void nfpat( void )
7734 {
7735 int i, j, kk;
7736 double znrt, cth=0., sth=0., ynrt, cph=0., sph=0., xnrt, xob, yob;
7737 double zob, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, xxx;
7738 complex double ex, ey, ez;
7739
7740 if( nfeh != 1)
7741 {
7742 fprintf( output_fp, "\n\n\n"
7743 " "
7744 "-------- NEAR ELECTRIC FIELDS --------\n"
7745 " ------- LOCATION ------- ------- EX ------ ------- EY ------ ------- EZ ------\n"
7746 " X Y Z MAGNITUDE PHASE MAGNITUDE PHASE MAGNITUDE PHASE\n"
7747 " METERS METERS METERS VOLTS/M DEGREES VOLTS/M DEGREES VOLTS/M DEGREES" );
7748 }
7749 else
7750 {
7751 fprintf( output_fp, "\n\n\n"
7752 " "
7753 "-------- NEAR MAGNETIC FIELDS ---------\n\n"
7754 " ------- LOCATION ------- ------- HX ------ ------- HY ------ ------- HZ ------\n"
7755 " X Y Z MAGNITUDE PHASE MAGNITUDE PHASE MAGNITUDE PHASE\n"
7756 " METERS METERS METERS AMPS/M DEGREES AMPS/M DEGREES AMPS/M DEGREES" );
7757 }
7758
7759 znrt= znr- dznr;
7760 for( i = 0; i < nrz; i++ )
7761 {
7762 znrt += dznr;
7763 if( near != 0)
7764 {
7765 cth= cos( TA* znrt);
7766 sth= sin( TA* znrt);
7767 }
7768
7769 ynrt= ynr- dynr;
7770 for( j = 0; j < nry; j++ )
7771 {
7772 ynrt += dynr;
7773 if( near != 0)
7774 {
7775 cph= cos( TA* ynrt);
7776 sph= sin( TA* ynrt);
7777 }
7778
7779 xnrt= xnr- dxnr;
7780 for( kk = 0; kk < nrx; kk++ )
7781 {
7782 xnrt += dxnr;
7783 if( near != 0)
7784 {
7785 xob= xnrt* sth* cph;
7786 yob= xnrt* sth* sph;
7787 zob= xnrt* cth;
7788 }
7789 else
7790 {
7791 xob= xnrt;
7792 yob= ynrt;
7793 zob= znrt;
7794 }
7795
7796 tmp1= xob/ wlam;
7797 tmp2= yob/ wlam;
7798 tmp3= zob/ wlam;
7799
7800 if( nfeh != 1)
7801 nefld( tmp1, tmp2, tmp3, &ex, &ey, &ez);
7802 else
7803 nhfld( tmp1, tmp2, tmp3, &ex, &ey, &ez);
7804
7805 tmp1= cabs( ex);
7806 tmp2= cang( ex);
7807 tmp3= cabs( ey);
7808 tmp4= cang( ey);
7809 tmp5= cabs( ez);
7810 tmp6= cang( ez);
7811
7812 fprintf( output_fp, "\n"
7813 " %9.4f %9.4f %9.4f %11.4E %7.2f %11.4E %7.2f %11.4E %7.2f",
7814 xob, yob, zob, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6 );
7815
7816 if( iplp1 != 2)
7817 continue;
7818
7819 if( iplp4 < 0 )
7820 xxx= xob;
7821 else
7822 if( iplp4 == 0 )
7823 xxx= yob;
7824 else
7825 xxx= zob;
7826
7827 if( iplp2 == 2)
7828 {
7829 switch( iplp3 )
7830 {
7831 case 1:
7832 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", xxx, tmp1, tmp2 );
7833 break;
7834 case 2:
7835 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", xxx, tmp3, tmp4 );
7836 break;
7837 case 3:
7838 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", xxx, tmp5, tmp6 );
7839 break;
7840 case 4:
7841 fprintf( plot_fp, "%12.4E %12.4E %12.4E %12.4E %12.4E %12.4E %12.4E\n",
7842 xxx, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6 );
7843 }
7844 continue;
7845 }
7846
7847 if( iplp2 != 1)
7848 continue;
7849
7850 switch( iplp3 )
7851 {
7852 case 1:
7853 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", xxx, creal(ex), cimag(ex) );
7854 break;
7855 case 2:
7856 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", xxx, creal(ey), cimag(ey) );
7857 break;
7858 case 3:
7859 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", xxx, creal(ez), cimag(ez) );
7860 break;
7861 case 4:
7862 fprintf( plot_fp, "%12.4E %12.4E %12.4E %12.4E %12.4E %12.4E %12.4E\n",
7863 xxx,creal(ex),cimag(ex),creal(ey),cimag(ey),creal(ez),cimag(ez) );
7864 }
7865 } /* for( kk = 0; kk < nrx; kk++ ) */
7866
7867 } /* for( j = 0; j < nry; j++ ) */
7868
7869 } /* for( i = 0; i < nrz; i++ ) */
7870
7871 return;
7872 }
7873
7874 /*-----------------------------------------------------------------------*/
7875
7876 /* nhfld computes the near field at specified points in space after */
7877 /* the structure currents have been computed. */
7878
nhfld(double xob,double yob,double zob,complex double * hx,complex double * hy,complex double * hz)7879 void nhfld( double xob, double yob, double zob,
7880 complex double *hx, complex double *hy, complex double *hz )
7881 {
7882 int i, jc;
7883 double ax, zp;
7884 complex double acx, bcx, ccx;
7885
7886 *hx=CPLX_00;
7887 *hy=CPLX_00;
7888 *hz=CPLX_00;
7889 ax=0.;
7890
7891 if( n != 0)
7892 {
7893 for( i = 0; i < n; i++ )
7894 {
7895 xj= xob- x[i];
7896 yj= yob- y[i];
7897 zj= zob- z[i];
7898 zp= cab[i]* xj+ sab[i]* yj+ salp[i]* zj;
7899
7900 if( fabs( zp) > 0.5001* si[i])
7901 continue;
7902
7903 zp= xj* xj+ yj* yj+ zj* zj- zp* zp;
7904 xj= bi[i];
7905
7906 if( zp > 0.9* xj* xj)
7907 continue;
7908
7909 ax= xj;
7910 break;
7911 }
7912
7913 for( i = 0; i < n; i++ )
7914 {
7915 s= si[i];
7916 b= bi[i];
7917 xj= x[i];
7918 yj= y[i];
7919 zj= z[i];
7920 cabj= cab[i];
7921 sabj= sab[i];
7922 salpj= salp[i];
7923 hsfld( xob, yob, zob, ax);
7924 acx= cmplx( air[i], aii[i]);
7925 bcx= cmplx( bir[i], bii[i]);
7926 ccx= cmplx( cir[i], cii[i]);
7927 *hx += exk* acx+ exs* bcx+ exc* ccx;
7928 *hy += eyk* acx+ eys* bcx+ eyc* ccx;
7929 *hz += ezk* acx+ ezs* bcx+ ezc* ccx;
7930 }
7931
7932 if( m == 0)
7933 return;
7934
7935 } /* if( n != 0) */
7936
7937 jc= n-1;
7938 for( i = 0; i < m; i++ )
7939 {
7940 s= pbi[i];
7941 xj= px[i];
7942 yj= py[i];
7943 zj= pz[i];
7944 t1xj= t1x[i];
7945 t1yj= t1y[i];
7946 t1zj= t1z[i];
7947 t2xj= t2x[i];
7948 t2yj= t2y[i];
7949 t2zj= t2z[i];
7950 hintg( xob, yob, zob);
7951 jc += 3;
7952 acx= t1xj* cur[jc-2]+ t1yj* cur[jc-1]+ t1zj* cur[jc];
7953 bcx= t2xj* cur[jc-2]+ t2yj* cur[jc-1]+ t2zj* cur[jc];
7954 *hx= *hx+ acx* exk+ bcx* exs;
7955 *hy= *hy+ acx* eyk+ bcx* eys;
7956 *hz= *hz+ acx* ezk+ bcx* ezs;
7957 }
7958
7959 return;
7960 }
7961
7962 /*-----------------------------------------------------------------------*/
7963
7964 /* patch generates and modifies patch geometry data */
patch(int nx,int ny,double ax1,double ay1,double az1,double ax2,double ay2,double az2,double ax3,double ay3,double az3,double ax4,double ay4,double az4)7965 void patch( int nx, int ny,
7966 double ax1, double ay1, double az1,
7967 double ax2, double ay2, double az2,
7968 double ax3, double ay3, double az3,
7969 double ax4, double ay4, double az4 )
7970 {
7971 int mi, ntp, iy, ix, mreq;
7972 double s1x=0., s1y=0., s1z=0., s2x=0., s2y=0., s2z=0., xst=0.;
7973 double znv, xnv, ynv, xa, xn2, yn2, zn2, salpn, xs, ys, zs, xt, yt, zt;
7974
7975 /* new patches. for nx=0, ny=1,2,3,4 patch is (respectively) */;
7976 /* arbitrary, rectagular, triangular, or quadrilateral. */
7977 /* for nx and ny > 0 a rectangular surface is produced with */
7978 /* nx by ny rectangular patches. */
7979
7980 m++;
7981 mi= m-1;
7982
7983 /* Reallocate patch buffers */
7984 mreq = m * sizeof(double);
7985 mem_realloc( (void *)&px, mreq );
7986 mem_realloc( (void *)&py, mreq );
7987 mem_realloc( (void *)&pz, mreq );
7988 mem_realloc( (void *)&t1x, mreq );
7989 mem_realloc( (void *)&t1y, mreq );
7990 mem_realloc( (void *)&t1z, mreq );
7991 mem_realloc( (void *)&t2x, mreq );
7992 mem_realloc( (void *)&t2y, mreq );
7993 mem_realloc( (void *)&t2z, mreq );
7994 mem_realloc( (void *)&pbi, mreq );
7995 mem_realloc( (void *)&psalp, mreq );
7996
7997 if( nx > 0)
7998 ntp=2;
7999 else
8000 ntp= ny;
8001
8002 if( ntp <= 1)
8003 {
8004 px[mi]= ax1;
8005 py[mi]= ay1;
8006 pz[mi]= az1;
8007 pbi[mi]= az2;
8008 znv= cos( ax2);
8009 xnv= znv* cos( ay2);
8010 ynv= znv* sin( ay2);
8011 znv= sin( ax2);
8012 xa= sqrt( xnv* xnv+ ynv* ynv);
8013
8014 if( xa >= 1.0e-6)
8015 {
8016 t1x[mi]= - ynv/ xa;
8017 t1y[mi]= xnv/ xa;
8018 t1z[mi]=0.;
8019 }
8020 else
8021 {
8022 t1x[mi]=1.;
8023 t1y[mi]=0.;
8024 t1z[mi]=0.;
8025 }
8026
8027 } /* if( ntp <= 1) */
8028 else
8029 {
8030 s1x= ax2- ax1;
8031 s1y= ay2- ay1;
8032 s1z= az2- az1;
8033 s2x= ax3- ax2;
8034 s2y= ay3- ay2;
8035 s2z= az3- az2;
8036
8037 if( nx != 0)
8038 {
8039 s1x= s1x/ nx;
8040 s1y= s1y/ nx;
8041 s1z= s1z/ nx;
8042 s2x= s2x/ ny;
8043 s2y= s2y/ ny;
8044 s2z= s2z/ ny;
8045 }
8046
8047 xnv= s1y* s2z- s1z* s2y;
8048 ynv= s1z* s2x- s1x* s2z;
8049 znv= s1x* s2y- s1y* s2x;
8050 xa= sqrt( xnv* xnv+ ynv* ynv+ znv* znv);
8051 xnv= xnv/ xa;
8052 ynv= ynv/ xa;
8053 znv= znv/ xa;
8054 xst= sqrt( s1x* s1x+ s1y* s1y+ s1z* s1z);
8055 t1x[mi]= s1x/ xst;
8056 t1y[mi]= s1y/ xst;
8057 t1z[mi]= s1z/ xst;
8058
8059 if( ntp <= 2)
8060 {
8061 px[mi]= ax1+.5*( s1x+ s2x);
8062 py[mi]= ay1+.5*( s1y+ s2y);
8063 pz[mi]= az1+.5*( s1z+ s2z);
8064 pbi[mi]= xa;
8065 }
8066 else
8067 {
8068 if( ntp != 4)
8069 {
8070 px[mi]=( ax1+ ax2+ ax3)/3.;
8071 py[mi]=( ay1+ ay2+ ay3)/3.;
8072 pz[mi]=( az1+ az2+ az3)/3.;
8073 pbi[mi]=.5* xa;
8074 }
8075 else
8076 {
8077 s1x= ax3- ax1;
8078 s1y= ay3- ay1;
8079 s1z= az3- az1;
8080 s2x= ax4- ax1;
8081 s2y= ay4- ay1;
8082 s2z= az4- az1;
8083 xn2= s1y* s2z- s1z* s2y;
8084 yn2= s1z* s2x- s1x* s2z;
8085 zn2= s1x* s2y- s1y* s2x;
8086 xst= sqrt( xn2* xn2+ yn2* yn2+ zn2* zn2);
8087 salpn=1./(3.*( xa+ xst));
8088 px[mi]=( xa*( ax1+ ax2+ ax3)+ xst*( ax1+ ax3+ ax4))* salpn;
8089 py[mi]=( xa*( ay1+ ay2+ ay3)+ xst*( ay1+ ay3+ ay4))* salpn;
8090 pz[mi]=( xa*( az1+ az2+ az3)+ xst*( az1+ az3+ az4))* salpn;
8091 pbi[mi]=.5*( xa+ xst);
8092 s1x=( xnv* xn2+ ynv* yn2+ znv* zn2)/ xst;
8093
8094 if( s1x <= 0.9998)
8095 {
8096 fprintf( output_fp,
8097 "\n ERROR -- CORNERS OF QUADRILATERAL"
8098 " PATCH DO NOT LIE IN A PLANE" );
8099 stop(-1);
8100 }
8101
8102 } /* if( ntp != 4) */
8103
8104 } /* if( ntp <= 2) */
8105
8106 } /* if( ntp <= 1) */
8107
8108 t2x[mi]= ynv* t1z[mi]- znv* t1y[mi];
8109 t2y[mi]= znv* t1x[mi]- xnv* t1z[mi];
8110 t2z[mi]= xnv* t1y[mi]- ynv* t1x[mi];
8111 psalp[mi]=1.;
8112
8113 if( nx != 0)
8114 {
8115 m += nx*ny-1;
8116
8117 /* Reallocate patch buffers */
8118 mreq = m * sizeof(double);
8119 mem_realloc( (void *)&px, mreq );
8120 mem_realloc( (void *)&py, mreq );
8121 mem_realloc( (void *)&pz, mreq );
8122 mem_realloc( (void *)&t1x, mreq );
8123 mem_realloc( (void *)&t1y, mreq );
8124 mem_realloc( (void *)&t1z, mreq );
8125 mem_realloc( (void *)&t2x, mreq );
8126 mem_realloc( (void *)&t2y, mreq );
8127 mem_realloc( (void *)&t2z, mreq );
8128 mem_realloc( (void *)&pbi, mreq );
8129 mem_realloc( (void *)&psalp, mreq );
8130
8131 xn2= px[mi]- s1x- s2x;
8132 yn2= py[mi]- s1y- s2y;
8133 zn2= pz[mi]- s1z- s2z;
8134 xs= t1x[mi];
8135 ys= t1y[mi];
8136 zs= t1z[mi];
8137 xt= t2x[mi];
8138 yt= t2y[mi];
8139 zt= t2z[mi];
8140
8141 for( iy = 0; iy < ny; iy++ )
8142 {
8143 xn2 += s2x;
8144 yn2 += s2y;
8145 zn2 += s2z;
8146
8147 for( ix = 1; ix <= nx; ix++ )
8148 {
8149 xst= (double)ix;
8150 px[mi]= xn2+ xst* s1x;
8151 py[mi]= yn2+ xst* s1y;
8152 pz[mi]= zn2+ xst* s1z;
8153 pbi[mi]= xa;
8154 psalp[mi]=1.;
8155 t1x[mi]= xs;
8156 t1y[mi]= ys;
8157 t1z[mi]= zs;
8158 t2x[mi]= xt;
8159 t2y[mi]= yt;
8160 t2z[mi]= zt;
8161 mi++;
8162 } /* for( ix = 0; ix < nx; ix++ ) */
8163
8164 } /* for( iy = 0; iy < ny; iy++ ) */
8165
8166 } /* if( nx != 0) */
8167
8168 ipsym=0;
8169 np= n;
8170 mp= m;
8171
8172 return;
8173 }
8174
8175 /*-----------------------------------------------------------------------*/
8176
8177 /*** this function was an 'entry point' (part of) 'patch()' ***/
subph(int nx,int ny)8178 void subph( int nx, int ny )
8179 {
8180 int mia, ix, iy, mi, mreq;
8181 double xs, ys, zs, xa, xst, s1x, s1y, s1z, s2x, s2y, s2z, saln, xt, yt;
8182
8183 /* Shift patches to make room for new ones */
8184 m += 3;
8185
8186 /* Reallocate patch buffers */
8187 mreq = m * sizeof(double);
8188 mem_realloc( (void *)&px, mreq );
8189 mem_realloc( (void *)&py, mreq );
8190 mem_realloc( (void *)&pz, mreq );
8191 mem_realloc( (void *)&t1x, mreq );
8192 mem_realloc( (void *)&t1y, mreq );
8193 mem_realloc( (void *)&t1z, mreq );
8194 mem_realloc( (void *)&t2x, mreq );
8195 mem_realloc( (void *)&t2y, mreq );
8196 mem_realloc( (void *)&t2z, mreq );
8197 mem_realloc( (void *)&pbi, mreq );
8198 mem_realloc( (void *)&psalp, mreq );
8199
8200 if( (ny == 0) && (nx != m) )
8201 {
8202 for( iy = m-1; iy >= nx; iy-- )
8203 {
8204 px[iy]= px[iy-3];
8205 py[iy]= py[iy-3];
8206 pz[iy]= pz[iy-3];
8207 pbi[iy]= pbi[iy-3];
8208 psalp[iy]= psalp[iy-3];
8209 t1x[iy]= t1x[iy-3];
8210 t1y[iy]= t1y[iy-3];
8211 t1z[iy]= t1z[iy-3];
8212 t2x[iy]= t2x[iy-3];
8213 t2y[iy]= t2y[iy-3];
8214 t2z[iy]= t2z[iy-3];
8215 }
8216
8217 } /* if( (ny <= 0) || (nx != m) ) */
8218
8219 /* divide patch for connection */
8220 mi= nx-1;
8221 xs= px[mi];
8222 ys= py[mi];
8223 zs= pz[mi];
8224 xa= pbi[mi]/4.;
8225 xst= sqrt( xa)/2.;
8226 s1x= t1x[mi];
8227 s1y= t1y[mi];
8228 s1z= t1z[mi];
8229 s2x= t2x[mi];
8230 s2y= t2y[mi];
8231 s2z= t2z[mi];
8232 saln= psalp[mi];
8233 xt= xst;
8234 yt= xst;
8235
8236 if( ny == 0)
8237 mia= mi;
8238 else
8239 {
8240 mp++;
8241 mia= m-1;
8242 }
8243
8244 for( ix = 1; ix <= 4; ix++ )
8245 {
8246 px[mia]= xs+ xt* s1x+ yt* s2x;
8247 py[mia]= ys+ xt* s1y+ yt* s2y;
8248 pz[mia]= zs+ xt* s1z+ yt* s2z;
8249 pbi[mia]= xa;
8250 t1x[mia]= s1x;
8251 t1y[mia]= s1y;
8252 t1z[mia]= s1z;
8253 t2x[mia]= s2x;
8254 t2y[mia]= s2y;
8255 t2z[mia]= s2z;
8256 psalp[mia]= saln;
8257
8258 if( ix == 2)
8259 yt= - yt;
8260
8261 if( (ix == 1) || (ix == 3) )
8262 xt= - xt;
8263
8264 mia++;
8265 }
8266
8267 if( nx <= mp)
8268 mp += 3;
8269
8270 if( ny > 0 )
8271 pz[mi]=10000.;
8272
8273 return;
8274 }
8275
8276 /*-----------------------------------------------------------------------*/
8277
8278 /* integrate over patches at wire connection point */
pcint(double xi,double yi,double zi,double cabi,double sabi,double salpi,complex double * e)8279 void pcint( double xi, double yi, double zi, double cabi,
8280 double sabi, double salpi, complex double *e )
8281 {
8282 int nint, i1, i2;
8283 double d, ds, da, gcon, fcon, xxj, xyj, xzj, xs, s1;
8284 double xss, yss, zss, s2x, s2, g1, g2, g3, g4, f2, f1;
8285 complex double e1, e2, e3, e4, e5, e6, e7, e8, e9;
8286
8287 nint = 10;
8288 d= sqrt( s)*.5;
8289 ds=4.* d/ (double) nint;
8290 da= ds* ds;
8291 gcon=1./ s;
8292 fcon=1./(2.* TP* d);
8293 xxj= xj;
8294 xyj= yj;
8295 xzj= zj;
8296 xs= s;
8297 s= da;
8298 s1= d+ ds*.5;
8299 xss= xj+ s1*( t1xj+ t2xj);
8300 yss= yj+ s1*( t1yj+ t2yj);
8301 zss= zj+ s1*( t1zj+ t2zj);
8302 s1= s1+ d;
8303 s2x= s1;
8304 e1=CPLX_00;
8305 e2=CPLX_00;
8306 e3=CPLX_00;
8307 e4=CPLX_00;
8308 e5=CPLX_00;
8309 e6=CPLX_00;
8310 e7=CPLX_00;
8311 e8=CPLX_00;
8312 e9=CPLX_00;
8313
8314 for( i1 = 0; i1 < nint; i1++ )
8315 {
8316 s1= s1- ds;
8317 s2= s2x;
8318 xss= xss- ds* t1xj;
8319 yss= yss- ds* t1yj;
8320 zss= zss- ds* t1zj;
8321 xj= xss;
8322 yj= yss;
8323 zj= zss;
8324
8325 for( i2 = 0; i2 < nint; i2++ )
8326 {
8327 s2= s2- ds;
8328 xj= xj- ds* t2xj;
8329 yj= yj- ds* t2yj;
8330 zj= zj- ds* t2zj;
8331 unere( xi, yi, zi);
8332 exk= exk* cabi+ eyk* sabi+ ezk* salpi;
8333 exs= exs* cabi+ eys* sabi+ ezs* salpi;
8334 g1=( d+ s1)*( d+ s2)* gcon;
8335 g2=( d- s1)*( d+ s2)* gcon;
8336 g3=( d- s1)*( d- s2)* gcon;
8337 g4=( d+ s1)*( d- s2)* gcon;
8338 f2=( s1* s1+ s2* s2)* TP;
8339 f1= s1/ f2-( g1- g2- g3+ g4)* fcon;
8340 f2= s2/ f2-( g1+ g2- g3- g4)* fcon;
8341 e1= e1+ exk* g1;
8342 e2= e2+ exk* g2;
8343 e3= e3+ exk* g3;
8344 e4= e4+ exk* g4;
8345 e5= e5+ exs* g1;
8346 e6= e6+ exs* g2;
8347 e7= e7+ exs* g3;
8348 e8= e8+ exs* g4;
8349 e9= e9+ exk* f1+ exs* f2;
8350
8351 } /* for( i2 = 0; i2 < nint; i2++ ) */
8352
8353 } /* for( i1 = 0; i1 < nint; i1++ ) */
8354
8355 e[0]= e1;
8356 e[1]= e2;
8357 e[2]= e3;
8358 e[3]= e4;
8359 e[4]= e5;
8360 e[5]= e6;
8361 e[6]= e7;
8362 e[7]= e8;
8363 e[8]= e9;
8364 xj= xxj;
8365 yj= xyj;
8366 zj= xzj;
8367 s= xs;
8368
8369 return;
8370 }
8371
8372 /*-----------------------------------------------------------------------*/
8373
8374 /* prnt sets up the print formats for impedance loading */
prnt(int in1,int in2,int in3,double fl1,double fl2,double fl3,double fl4,double fl5,double fl6,char * ia,int ichar)8375 void prnt( int in1, int in2, int in3, double fl1, double fl2,
8376 double fl3, double fl4, double fl5, double fl6, char *ia, int ichar )
8377 {
8378 /* record to be output and buffer used to make it */
8379 char record[101+ichar*4], buf[15];
8380 int in[3], i1, i;
8381 double fl[6];
8382
8383 in[0]= in1;
8384 in[1]= in2;
8385 in[2]= in3;
8386 fl[0]= fl1;
8387 fl[1]= fl2;
8388 fl[2]= fl3;
8389 fl[3]= fl4;
8390 fl[4]= fl5;
8391 fl[5]= fl6;
8392
8393 /* integer format */
8394 i1=0;
8395 strcpy( record, "\n " );
8396
8397 if( (in1 == 0) && (in2 == 0) && (in3 == 0) )
8398 {
8399 strcat( record, " ALL" );
8400 i1=1;
8401 }
8402
8403 for( i = i1; i < 3; i++ )
8404 {
8405 if( in[i] == 0)
8406 strcat( record, " " );
8407 else
8408 {
8409 sprintf( buf, "%5d", in[i] );
8410 strcat( record, buf );
8411 }
8412 }
8413
8414 /* floating point format */
8415 for( i = 0; i < 6; i++ )
8416 {
8417 if( fabs( fl[i]) >= 1.0e-20 )
8418 {
8419 sprintf( buf, " %11.4E", fl[i] );
8420 strcat( record, buf );
8421 }
8422 else
8423 strcat( record, " " );
8424 }
8425
8426 strcat( record, " " );
8427 strcat( record, ia );
8428 fprintf( output_fp, "%s", record );
8429
8430 return;
8431 }
8432
8433 /*-----------------------------------------------------------------------*/
8434
8435 /* fill incident field array for charge discontinuity voltage source */
qdsrc(int is,complex double v,complex double * e)8436 void qdsrc( int is, complex double v, complex double *e )
8437 {
8438 int i, jx, j, jp1, ipr, ij, i1;
8439 double xi, yi, zi, ai, cabi, sabi, salpi, tx, ty, tz;
8440 complex double curd, etk, ets, etc;
8441
8442 is--;
8443 i= icon1[is];
8444 icon1[is]=0;
8445 tbf( is+1,0);
8446 icon1[is]= i;
8447 s= si[is]*.5;
8448 curd= CCJ* v/(( log(2.* s/ bi[is])-1.)*( bx[jsno-1]*
8449 cos( TP* s)+ cx[jsno-1]* sin( TP* s))* wlam);
8450 vqds[nqds]= v;
8451 iqds[nqds]= is+1;
8452 nqds++;
8453
8454 for( jx = 0; jx < jsno; jx++ )
8455 {
8456 j= jco[jx]-1;
8457 jp1 = j+1;
8458 s= si[j];
8459 b= bi[j];
8460 xj= x[j];
8461 yj= y[j];
8462 zj= z[j];
8463 cabj= cab[j];
8464 sabj= sab[j];
8465 salpj= salp[j];
8466
8467 if( iexk != 0)
8468 {
8469 ipr= icon1[j];
8470
8471 if( ipr < 0 )
8472 {
8473 ipr= - ipr;
8474 ipr--;
8475 if( -icon1[ipr-1] != jp1 )
8476 ind1=2;
8477 else
8478 {
8479 xi= fabs( cabj* cab[ipr]+ sabj* sab[ipr]+ salpj* salp[ipr]);
8480 if( (xi < 0.999999) || (fabs(bi[ipr]/b-1.) > 1.0e-6) )
8481 ind1=2;
8482 else
8483 ind1=0;
8484 }
8485 } /* if( ipr < 0 ) */
8486 else
8487 if( ipr == 0 )
8488 ind1=1;
8489 else /* ipr > 0 */
8490 {
8491 ipr--;
8492 if( ipr != j )
8493 {
8494 if( icon2[ipr] != jp1)
8495 ind1=2;
8496 else
8497 {
8498 xi= fabs( cabj* cab[ipr]+ sabj* sab[ipr]+ salpj* salp[ipr]);
8499 if( (xi < 0.999999) || (fabs(bi[ipr]/b-1.) > 1.0e-6) )
8500 ind1=2;
8501 else
8502 ind1=0;
8503 }
8504 } /* if( ipr != j ) */
8505 else
8506 {
8507 if( cabj* cabj+ sabj* sabj > 1.0e-8)
8508 ind1=2;
8509 else
8510 ind1=0;
8511 }
8512 } /* else */
8513
8514 ipr= icon2[j];
8515 if( ipr < 0 )
8516 {
8517 ipr = -ipr;
8518 ipr--;
8519 if( -icon2[ipr] != jp1 )
8520 ind1=2;
8521 else
8522 {
8523 xi= fabs( cabj* cab[ipr]+ sabj* sab[ipr]+ salpj* salp[ipr]);
8524 if( (xi < 0.999999) || (fabs(bi[ipr]/b-1.) > 1.0e-6) )
8525 ind1=2;
8526 else
8527 ind1=0;
8528 }
8529 } /* if( ipr < 0 ) */
8530 else
8531 if( ipr == 0 )
8532 ind2=1;
8533 else /* ipr > 0 */
8534 {
8535 ipr--;
8536 if( ipr != j )
8537 {
8538 if( icon1[ipr] != jp1)
8539 ind2=2;
8540 else
8541 {
8542 xi= fabs( cabj* cab[ipr]+ sabj* sab[ipr]+ salpj* salp[ipr]);
8543 if( (xi < 0.999999) || (fabs(bi[ipr]/b-1.) > 1.0e-6) )
8544 ind2=2;
8545 else
8546 ind2=0;
8547 }
8548 } /* if( ipr != j )*/
8549 else
8550 {
8551 if( cabj* cabj+ sabj* sabj > 1.0e-8)
8552 ind1=2;
8553 else
8554 ind1=0;
8555 }
8556 } /* else */
8557
8558 } /* if( iexk != 0) */
8559
8560 for( i = 0; i < n; i++ )
8561 {
8562 ij= i- j;
8563 xi= x[i];
8564 yi= y[i];
8565 zi= z[i];
8566 ai= bi[i];
8567 efld( xi, yi, zi, ai, ij);
8568 cabi= cab[i];
8569 sabi= sab[i];
8570 salpi= salp[i];
8571 etk= exk* cabi+ eyk* sabi+ ezk* salpi;
8572 ets= exs* cabi+ eys* sabi+ ezs* salpi;
8573 etc= exc* cabi+ eyc* sabi+ ezc* salpi;
8574 e[i]= e[i]-( etk* ax[jx]+ ets* bx[jx]+ etc* cx[jx])* curd;
8575 }
8576
8577 if( m != 0)
8578 {
8579 i1= n-1;
8580 for( i = 0; i < m; i++ )
8581 {
8582 xi= px[i];
8583 yi= py[i];
8584 zi= pz[i];
8585 hsfld( xi, yi, zi,0.);
8586 i1++;
8587 tx= t2x[i];
8588 ty= t2y[i];
8589 tz= t2z[i];
8590 etk= exk* tx+ eyk* ty+ ezk* tz;
8591 ets= exs* tx+ eys* ty+ ezs* tz;
8592 etc= exc* tx+ eyc* ty+ ezc* tz;
8593 e[i1] += ( etk* ax[jx]+ ets* bx[jx]+ etc* cx[jx] )* curd* psalp[i];
8594 i1++;
8595 tx= t1x[i];
8596 ty= t1y[i];
8597 tz= t1z[i];
8598 etk= exk* tx+ eyk* ty+ ezk* tz;
8599 ets= exs* tx+ eys* ty+ ezs* tz;
8600 etc= exc* tx+ eyc* ty+ ezc* tz;
8601 e[i1] += ( etk* ax[jx]+ ets* bx[jx]+ etc* cx[jx])* curd* psalp[i];
8602 }
8603
8604 } /* if( m != 0) */
8605
8606 if( nload > 0 )
8607 e[j] += zarray[j]* curd*(ax[jx]+ cx[jx]);
8608
8609 } /* for( jx = 0; jx < jsno; jx++ ) */
8610
8611 return;
8612 }
8613
8614 /*-----------------------------------------------------------------------*/
8615
8616 /* compute radiation pattern, gain, normalized gain */
rdpat(void)8617 void rdpat( void )
8618 {
8619 char *hpol[3] = { "LINEAR", "RIGHT ", "LEFT " };
8620 char hcir[] = " CIRCLE";
8621 char *igtp[2] = { "----- POWER GAINS ----- ", "--- DIRECTIVE GAINS ---" };
8622 char *igax[4] = { " MAJOR", " MINOR", " VERTC", " HORIZ" };
8623 char *igntp[5] = { " MAJOR AXIS", " MINOR AXIS",
8624 " VERTICAL", " HORIZONTAL", " TOTAL " };
8625
8626 char *hclif=NULL, *isens;
8627 int i, j, jump, itmp1, itmp2, kth, kph, itmp3, itmp4;
8628 double exrm=0., exra=0., prad, gcon, gcop, gmax, pint, tmp1, tmp2;
8629 double phi, pha, thet, tha, erdm=0., erda=0., ethm2, ethm, *gain = NULL;
8630 double etha, ephm2, ephm, epha, tilta, emajr2, eminr2, axrat;
8631 double dfaz, dfaz2, cdfaz, tstor1=0., tstor2, stilta, gnmj;
8632 double gnmn, gnv, gnh, gtot, tmp3, tmp4, da, tmp5, tmp6;
8633 complex double eth, eph, erd;
8634
8635 /* Allocate memory to gain buffer */
8636 if( inor > 0 )
8637 mem_alloc( (void *)&gain, nth*nph * sizeof(double) );
8638
8639 if( ifar >= 2)
8640 {
8641 fprintf( output_fp, "\n\n\n"
8642 " "
8643 "------ FAR FIELD GROUND PARAMETERS ------\n\n" );
8644
8645 jump = FALSE;
8646 if( ifar > 3)
8647 {
8648 fprintf( output_fp, "\n"
8649 " "
8650 "RADIAL WIRE GROUND SCREEN\n"
8651 " "
8652 "%5d WIRES\n"
8653 " "
8654 "WIRE LENGTH= %8.2f METERS\n"
8655 " "
8656 "WIRE RADIUS= %10.3E METERS",
8657 nradl, scrwlt, scrwrt );
8658
8659 if( ifar == 4)
8660 jump = TRUE;
8661
8662 } /* if( ifar > 3) */
8663
8664 if( ! jump )
8665 {
8666 if( (ifar == 2) || (ifar == 5) )
8667 hclif= hpol[0];
8668 if( (ifar == 3) || (ifar == 6) )
8669 hclif= hcir;
8670
8671 cl= clt/ wlam;
8672 ch= cht/ wlam;
8673 zrati2= csqrt(1./ cmplx( epsr2,- sig2* wlam*59.96));
8674
8675 fprintf( output_fp, "\n"
8676 " "
8677 "%6s CLIFF\n"
8678 " "
8679 "EDGE DISTANCE= %9.2f METERS\n"
8680 " "
8681 "HEIGHT= %8.2f METERS\n"
8682 " "
8683 "SECOND MEDIUM -\n"
8684 " "
8685 "RELATIVE DIELECTRIC CONST.= %7.3f\n"
8686 " "
8687 "CONDUCTIVITY= %10.3f MHOS",
8688 hclif, clt, cht, epsr2, sig2 );
8689
8690 } /* if( ! jump ) */
8691
8692 } /* if( ifar >= 2) */
8693
8694 if( ifar == 1)
8695 {
8696 fprintf( output_fp, "\n\n\n"
8697 " "
8698 "------- RADIATED FIELDS NEAR GROUND --------\n\n"
8699 " ------- LOCATION ------- --- E(THETA) --- "
8700 " ---- E(PHI) ---- --- E(RADIAL) ---\n"
8701 " RHO PHI Z MAG PHASE "
8702 " MAG PHASE MAG PHASE\n"
8703 " METERS DEGREES METERS VOLTS/M DEGREES "
8704 " VOLTS/M DEGREES VOLTS/M DEGREES" );
8705 }
8706 else
8707 {
8708 itmp1=2* iax;
8709 itmp2= itmp1+1;
8710
8711 fprintf( output_fp, "\n\n\n"
8712 " "
8713 "---------- RADIATION PATTERNS -----------\n" );
8714
8715 if( rfld >= 1.0e-20)
8716 {
8717 exrm=1./ rfld;
8718 exra= rfld/ wlam;
8719 exra=-360.*( exra- floor( exra));
8720
8721 fprintf( output_fp, "\n"
8722 " "
8723 "RANGE: %13.6E METERS\n"
8724 " "
8725 "EXP(-JKR)/R: %12.5E AT PHASE: %7.2f DEGREES\n",
8726 rfld, exrm, exra );
8727 }
8728
8729 fprintf( output_fp, "\n"
8730 " ---- ANGLES ----- %23s ---- POLARIZATION ---- "
8731 " ---- E(THETA) ---- ----- E(PHI) ------\n"
8732 " THETA PHI %6s %6s TOTAL AXIAL "
8733 " TILT SENSE MAGNITUDE PHASE MAGNITUDE PHASE\n"
8734 " DEGREES DEGREES DB DB DB RATIO "
8735 " DEGREES VOLTS/M DEGREES VOLTS/M DEGREES",
8736 igtp[ipd], igax[itmp1], igax[itmp2] );
8737
8738 } /* if( ifar == 1) */
8739
8740 if( (ixtyp == 0) || (ixtyp == 5) )
8741 {
8742 gcop= wlam* wlam*2.* PI/(376.73* pinr);
8743 prad= pinr- ploss- pnlr;
8744 gcon= gcop;
8745 if( ipd != 0)
8746 gcon= gcon* pinr/ prad;
8747 }
8748 else
8749 if( ixtyp == 4)
8750 {
8751 pinr=394.51* xpr6* xpr6* wlam* wlam;
8752 gcop= wlam* wlam*2.* PI/(376.73* pinr);
8753 prad= pinr- ploss- pnlr;
8754 gcon= gcop;
8755 if( ipd != 0)
8756 gcon= gcon* pinr/ prad;
8757 }
8758 else
8759 {
8760 prad=0.;
8761 gcon=4.* PI/(1.+ xpr6* xpr6);
8762 gcop= gcon;
8763 }
8764
8765 i=0;
8766 gmax=-1.e+10;
8767 pint=0.;
8768 tmp1= dph* TA;
8769 tmp2=.5* dth* TA;
8770 phi= phis- dph;
8771
8772 for( kph = 1; kph <= nph; kph++ )
8773 {
8774 phi += dph;
8775 pha= phi* TA;
8776 thet= thets- dth;
8777
8778 for( kth = 1; kth <= nth; kth++ )
8779 {
8780 thet += dth;
8781 if( (ksymp == 2) && (thet > 90.01) && (ifar != 1) )
8782 continue;
8783
8784 tha= thet* TA;
8785 if( ifar != 1)
8786 ffld( tha, pha, ð, &eph);
8787 else
8788 {
8789 gfld( rfld/wlam, pha, thet/wlam,
8790 ð, &eph, &erd, zrati, ksymp);
8791 erdm= cabs( erd);
8792 erda= cang( erd);
8793 }
8794
8795 ethm2= creal( eth* conj( eth));
8796 ethm= sqrt( ethm2);
8797 etha= cang( eth);
8798 ephm2= creal( eph* conj( eph));
8799 ephm= sqrt( ephm2);
8800 epha= cang( eph);
8801
8802 /* elliptical polarization calc. */
8803 if( ifar != 1)
8804 {
8805 if( (ethm2 <= 1.0e-20) && (ephm2 <= 1.0e-20) )
8806 {
8807 tilta=0.;
8808 emajr2=0.;
8809 eminr2=0.;
8810 axrat=0.;
8811 isens= " ";
8812 }
8813 else
8814 {
8815 dfaz= epha- etha;
8816 if( epha >= 0.)
8817 dfaz2= dfaz-360.;
8818 else
8819 dfaz2= dfaz+360.;
8820
8821 if( fabs(dfaz) > fabs(dfaz2) )
8822 dfaz= dfaz2;
8823
8824 cdfaz= cos( dfaz* TA);
8825 tstor1= ethm2- ephm2;
8826 tstor2=2.* ephm* ethm* cdfaz;
8827 tilta=.5* atan2( tstor2, tstor1);
8828 stilta= sin( tilta);
8829 tstor1= tstor1* stilta* stilta;
8830 tstor2= tstor2* stilta* cos( tilta);
8831 emajr2= - tstor1+ tstor2+ ethm2;
8832 eminr2= tstor1- tstor2+ ephm2;
8833 if( eminr2 < 0.)
8834 eminr2=0.;
8835
8836 axrat= sqrt( eminr2/ emajr2);
8837 tilta= tilta* TD;
8838 if( axrat <= 1.0e-5)
8839 isens= hpol[0];
8840 else
8841 if( dfaz <= 0.)
8842 isens= hpol[1];
8843 else
8844 isens= hpol[2];
8845
8846 } /* if( (ethm2 <= 1.0e-20) && (ephm2 <= 1.0e-20) ) */
8847
8848 gnmj= db10( gcon* emajr2);
8849 gnmn= db10( gcon* eminr2);
8850 gnv = db10( gcon* ethm2);
8851 gnh = db10( gcon* ephm2);
8852 gtot= db10( gcon*(ethm2+ ephm2) );
8853
8854 if( inor > 0)
8855 {
8856 i++;
8857 switch( inor )
8858 {
8859 case 1:
8860 tstor1= gnmj;
8861 break;
8862
8863 case 2:
8864 tstor1= gnmn;
8865 break;
8866
8867 case 3:
8868 tstor1= gnv;
8869 break;
8870
8871 case 4:
8872 tstor1= gnh;
8873 break;
8874
8875 case 5:
8876 tstor1= gtot;
8877 }
8878
8879 gain[i-1]= tstor1;
8880 if( tstor1 > gmax)
8881 gmax= tstor1;
8882
8883 } /* if( inor > 0) */
8884
8885 if( iavp != 0)
8886 {
8887 tstor1= gcop*( ethm2+ ephm2);
8888 tmp3= tha- tmp2;
8889 tmp4= tha+ tmp2;
8890
8891 if( kth == 1)
8892 tmp3= tha;
8893 else
8894 if( kth == nth)
8895 tmp4= tha;
8896
8897 da= fabs( tmp1*( cos( tmp3)- cos( tmp4)));
8898 if( (kph == 1) || (kph == nph) )
8899 da *=.5;
8900 pint += tstor1* da;
8901
8902 if( iavp == 2)
8903 continue;
8904 }
8905
8906 if( iax != 1)
8907 {
8908 tmp5= gnmj;
8909 tmp6= gnmn;
8910 }
8911 else
8912 {
8913 tmp5= gnv;
8914 tmp6= gnh;
8915 }
8916
8917 ethm= ethm* wlam;
8918 ephm= ephm* wlam;
8919
8920 if( rfld >= 1.0e-20 )
8921 {
8922 ethm= ethm* exrm;
8923 etha= etha+ exra;
8924 ephm= ephm* exrm;
8925 epha= epha+ exra;
8926 }
8927
8928 fprintf( output_fp, "\n"
8929 " %7.2f %9.2f %8.2f %8.2f %8.2f %11.4f"
8930 " %9.2f %6s %11.4E %9.2f %11.4E %9.2f",
8931 thet, phi, tmp5, tmp6, gtot, axrat,
8932 tilta, isens, ethm, etha, ephm, epha );
8933
8934 if( iplp1 != 3)
8935 continue;
8936
8937 if( iplp3 != 0)
8938 {
8939 if( iplp2 == 1 )
8940 {
8941 if( iplp3 == 1 )
8942 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", thet, ethm, etha );
8943 else
8944 if( iplp3 == 2 )
8945 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", thet, ephm, epha );
8946 }
8947
8948 if( iplp2 == 2 )
8949 {
8950 if( iplp3 == 1 )
8951 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", phi, ethm, etha );
8952 else
8953 if( iplp3 == 2 )
8954 fprintf( plot_fp, "%12.4E %12.4E %12.4E\n", phi, ephm, epha );
8955 }
8956 }
8957
8958 if( iplp4 == 0 )
8959 continue;
8960
8961 if( iplp2 == 1 )
8962 {
8963 switch( iplp4 )
8964 {
8965 case 1:
8966 fprintf( plot_fp, "%12.4E %12.4E\n", thet, tmp5 );
8967 break;
8968 case 2:
8969 fprintf( plot_fp, "%12.4E %12.4E\n", thet, tmp6 );
8970 break;
8971 case 3:
8972 fprintf( plot_fp, "%12.4E %12.4E\n", thet, gtot );
8973 }
8974 }
8975
8976 if( iplp2 == 2 )
8977 {
8978 switch( iplp4 )
8979 {
8980 case 1:
8981 fprintf( plot_fp, "%12.4E %12.4E\n", phi, tmp5 );
8982 break;
8983 case 2:
8984 fprintf( plot_fp, "%12.4E %12.4E\n", phi, tmp6 );
8985 break;
8986 case 3:
8987 fprintf( plot_fp, "%12.4E %12.4E\n", phi, gtot );
8988 }
8989 }
8990
8991 continue;
8992 } /* if( ifar != 1) */
8993
8994 fprintf( output_fp, "\n"
8995 " %9.2f %7.2f %9.2f %11.4E %7.2f %11.4E %7.2f %11.4E %7.2f",
8996 rfld, phi, thet, ethm, etha, ephm, epha, erdm, erda );
8997
8998 } /* for( kth = 1; kth <= nth; kth++ ) */
8999
9000 } /* for( kph = 1; kph <= nph; kph++ ) */
9001
9002 if( iavp != 0)
9003 {
9004 tmp3= thets* TA;
9005 tmp4= tmp3+ dth* TA* (double)( nth-1);
9006 tmp3= fabs( dph* TA* (double)( nph-1)*( cos( tmp3)- cos( tmp4)));
9007 pint /= tmp3;
9008 tmp3 /= PI;
9009
9010 fprintf( output_fp, "\n\n\n"
9011 " AVERAGE POWER GAIN: %11.4E - SOLID ANGLE"
9012 " USED IN AVERAGING: (%+7.4f)*PI STERADIANS",
9013 pint, tmp3 );
9014 }
9015
9016 if( inor == 0)
9017 return;
9018
9019 if( fabs( gnor) > 1.0e-20)
9020 gmax= gnor;
9021 itmp1=( inor-1);
9022
9023 fprintf( output_fp, "\n\n\n"
9024 " "
9025 " ---------- NORMALIZED GAIN ----------\n"
9026 " %6s GAIN\n"
9027 " "
9028 " NORMALIZATION FACTOR: %.2f db\n\n"
9029 " ---- ANGLES ---- ---- ANGLES ----"
9030 " ---- ANGLES ----\n"
9031 " THETA PHI GAIN THETA PHI "
9032 " GAIN THETA PHI GAIN\n"
9033 " DEGREES DEGREES DB DEGREES DEGREES "
9034 " DB DEGREES DEGREES DB",
9035 igntp[itmp1], gmax );
9036
9037 itmp2= nph* nth;
9038 itmp1=( itmp2+2)/3;
9039 itmp2= itmp1*3- itmp2;
9040 itmp3= itmp1;
9041 itmp4=2* itmp1;
9042
9043 if( itmp2 == 2)
9044 itmp4--;
9045
9046 for( i = 0; i < itmp1; i++ )
9047 {
9048 itmp3++;
9049 itmp4++;
9050 j= i/ nth;
9051 tmp1= thets+ (double)( i - j*nth )* dth;
9052 tmp2= phis+ (double)(j)* dph;
9053 j=( itmp3-1)/ nth;
9054 tmp3= thets+ (double)( itmp3- j* nth-1)* dth;
9055 tmp4= phis+ (double)(j)* dph;
9056 j=( itmp4-1)/ nth;
9057 tmp5= thets+ (double)( itmp4- j* nth-1)* dth;
9058 tmp6= phis+ (double)(j)* dph;
9059 tstor1= gain[i]- gmax;
9060
9061 if( ((i+1) == itmp1) && (itmp2 != 0) )
9062 {
9063 if( itmp2 != 2)
9064 {
9065 tstor2= gain[itmp3-1]- gmax;
9066 fprintf( output_fp, "\n"
9067 " %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f ",
9068 tmp1, tmp2, tstor1, tmp3, tmp4, tstor2 );
9069 return;
9070 }
9071
9072 fprintf( output_fp, "\n"
9073 " %9.2f %9.2f %9.2f ",
9074 tmp1, tmp2, tstor1 );
9075 return;
9076
9077 } /* if( ((i+1) == itmp1) && (itmp2 != 0) ) */
9078
9079 tstor2= gain[itmp3-1]- gmax;
9080 pint= gain[itmp4-1]- gmax;
9081
9082 fprintf( output_fp, "\n"
9083 " %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f",
9084 tmp1, tmp2, tstor1, tmp3, tmp4, tstor2, tmp5, tmp6, pint );
9085
9086 } /* for( i = 0; i < itmp1; i++ ) */
9087
9088 free_ptr( (void *)&gain );
9089
9090 return;
9091 }
9092
9093 /*-----------------------------------------------------------------------*/
9094
readgm(char * gm,int * i1,int * i2,double * x1,double * y1,double * z1,double * x2,double * y2,double * z2,double * rad)9095 void readgm( char *gm, int *i1, int *i2, double *x1, double *y1,
9096 double *z1, double *x2, double *y2, double *z2, double *rad )
9097 {
9098 char line_buf[134];
9099 int nlin, i, line_idx;
9100 int nint = 2, nflt = 7;
9101 int iarr[2] = { 0, 0 };
9102 double rarr[7] = { 0., 0., 0., 0., 0., 0., 0. };
9103
9104
9105 /* read a line from input file */
9106 load_line( line_buf, input_fp );
9107
9108 /* get line length */
9109 nlin= strlen( line_buf );
9110
9111 /* abort if card's mnemonic too short or missing */
9112 if( nlin < 2 )
9113 {
9114 fprintf( output_fp,
9115 "\n GEOMETRY DATA CARD ERROR:"
9116 "\n CARD'S MNEMONIC CODE TOO SHORT OR MISSING." );
9117 stop(-1);
9118 }
9119
9120 /* extract card's mnemonic code */
9121 strncpy( gm, line_buf, 2 );
9122 gm[2] = '\0';
9123
9124 /* Exit if "XT" command read (for testing) */
9125 if( strcmp( gm, "XT" ) == 0 )
9126 {
9127 fprintf( stderr,
9128 "\nnec2c: Exiting after an \"XT\" command in readgm()\n" );
9129 fprintf( output_fp,
9130 "\n\n nec2c: Exiting after an \"XT\" command in readgm()" );
9131 stop(0);
9132 }
9133
9134 /* Return if only mnemonic on card */
9135 if( nlin == 2 )
9136 {
9137 *i1 = *i2 = 0;
9138 *x1 = *y1 = *z1 = *x2 = *y2 = *z2 = *rad = 0.;
9139 return;
9140 }
9141
9142 /* read integers from line */
9143 line_idx = 1;
9144 for( i = 0; i < nint; i++ )
9145 {
9146 /* Find first numerical character */
9147 while( ((line_buf[++line_idx] < '0') ||
9148 (line_buf[ line_idx] > '9')) &&
9149 (line_buf[ line_idx] != '+') &&
9150 (line_buf[ line_idx] != '-') )
9151 if( line_buf[line_idx] == '\0')
9152 {
9153 *i1= iarr[0];
9154 *i2= iarr[1];
9155 *x1= rarr[0];
9156 *y1= rarr[1];
9157 *z1= rarr[2];
9158 *x2= rarr[3];
9159 *y2= rarr[4];
9160 *z2= rarr[5];
9161 *rad= rarr[6];
9162 return;
9163 }
9164
9165 /* read an integer from line */
9166 iarr[i] = atoi( &line_buf[line_idx] );
9167
9168 /* traverse numerical field to next ' ' or ',' or '\0' */
9169 line_idx--;
9170 while( (line_buf[++line_idx] != ' ') &&
9171 (line_buf[ line_idx] != ',') &&
9172 (line_buf[ line_idx] != '\0') )
9173 {
9174 /* test for non-numerical characters */
9175 if( ((line_buf[line_idx] < '0') ||
9176 (line_buf[line_idx] > '9')) &&
9177 (line_buf[line_idx] != '+') &&
9178 (line_buf[line_idx] != '-') )
9179 {
9180 fprintf( output_fp,
9181 "\n GEOMETRY DATA CARD \"%s\" ERROR:"
9182 "\n NON-NUMERICAL CHARACTER '%c' IN INTEGER FIELD AT CHAR. %d\n",
9183 gm, line_buf[line_idx], (line_idx+1) );
9184 stop(-1);
9185 }
9186
9187 } /* while( (line_buff[++line_idx] ... */
9188
9189 /* Return on end of line */
9190 if( line_buf[line_idx] == '\0' )
9191 {
9192 *i1= iarr[0];
9193 *i2= iarr[1];
9194 *x1= rarr[0];
9195 *y1= rarr[1];
9196 *z1= rarr[2];
9197 *x2= rarr[3];
9198 *y2= rarr[4];
9199 *z2= rarr[5];
9200 *rad= rarr[6];
9201 return;
9202 }
9203
9204 } /* for( i = 0; i < nint; i++ ) */
9205
9206 /* read doubles from line */
9207 for( i = 0; i < nflt; i++ )
9208 {
9209 /* Find first numerical character */
9210 while( ((line_buf[++line_idx] < '0') ||
9211 (line_buf[ line_idx] > '9')) &&
9212 (line_buf[ line_idx] != '+') &&
9213 (line_buf[ line_idx] != '-') &&
9214 (line_buf[ line_idx] != '.') )
9215 if( line_buf[line_idx] == '\0')
9216 {
9217 *i1= iarr[0];
9218 *i2= iarr[1];
9219 *x1= rarr[0];
9220 *y1= rarr[1];
9221 *z1= rarr[2];
9222 *x2= rarr[3];
9223 *y2= rarr[4];
9224 *z2= rarr[5];
9225 *rad= rarr[6];
9226 return;
9227 }
9228
9229 /* read a double from line */
9230 rarr[i] = atof( &line_buf[line_idx] );
9231
9232 /* traverse numerical field to next ' ' or ',' or '\0' */
9233 line_idx--;
9234 while( (line_buf[++line_idx] != ' ') &&
9235 (line_buf[ line_idx] != ',') &&
9236 (line_buf[ line_idx] != '\0') )
9237 {
9238 /* test for non-numerical characters */
9239 if( ((line_buf[line_idx] < '0') ||
9240 (line_buf[line_idx] > '9')) &&
9241 (line_buf[line_idx] != '.') &&
9242 (line_buf[line_idx] != '+') &&
9243 (line_buf[line_idx] != '-') &&
9244 (line_buf[line_idx] != 'E') &&
9245 (line_buf[line_idx] != 'e') )
9246 {
9247 fprintf( output_fp,
9248 "\n GEOMETRY DATA CARD \"%s\" ERROR:"
9249 "\n NON-NUMERICAL CHARACTER '%c' IN FLOAT FIELD AT CHAR. %d.\n",
9250 gm, line_buf[line_idx], (line_idx+1) );
9251 stop(-1);
9252 }
9253
9254 } /* while( (line_buff[++line_idx] ... */
9255
9256 /* Return on end of line */
9257 if( line_buf[line_idx] == '\0' )
9258 {
9259 *i1= iarr[0];
9260 *i2= iarr[1];
9261 *x1= rarr[0];
9262 *y1= rarr[1];
9263 *z1= rarr[2];
9264 *x2= rarr[3];
9265 *y2= rarr[4];
9266 *z2= rarr[5];
9267 *rad= rarr[6];
9268 return;
9269 }
9270
9271 } /* for( i = 0; i < nflt; i++ ) */
9272
9273 *i1 = iarr[0];
9274 *i2 = iarr[1];
9275 *x1 = rarr[0];
9276 *y1 = rarr[1];
9277 *z1 = rarr[2];
9278 *x2 = rarr[3];
9279 *y2 = rarr[4];
9280 *z2 = rarr[5];
9281 *rad = rarr[6];
9282
9283 return;
9284 }
9285
9286 /*-----------------------------------------------------------------------*/
9287
readmn(char * gm,int * i1,int * i2,int * i3,int * i4,double * f1,double * f2,double * f3,double * f4,double * f5,double * f6)9288 void readmn( char *gm, int *i1, int *i2, int *i3, int *i4,
9289 double *f1, double *f2, double *f3,
9290 double *f4, double *f5, double *f6 )
9291 {
9292 char line_buf[134];
9293 int nlin, i, line_idx;
9294 int nint = 4, nflt = 6;
9295 int iarr[4] = { 0, 0, 0, 0 };
9296 double rarr[6] = { 0., 0., 0., 0., 0., 0. };
9297
9298 /* read a line from input file */
9299 load_line( line_buf, input_fp );
9300
9301 /* get line length */
9302 nlin= strlen( line_buf );
9303
9304 /* abort if card's mnemonic too short or missing */
9305 if( nlin < 2 )
9306 {
9307 fprintf( output_fp,
9308 "\n COMMAND DATA CARD ERROR:"
9309 "\n CARD'S MNEMONIC CODE TOO SHORT OR MISSING." );
9310 stop(-1);
9311 }
9312
9313 /* extract card's mnemonic code */
9314 strncpy( gm, line_buf, 2 );
9315 gm[2] = '\0';
9316
9317 /* Exit if "XT" command read (for testing) */
9318 if( strcmp( gm, "XT" ) == 0 )
9319 {
9320 fprintf( stderr,
9321 "\nnec2c: Exiting after an \"XT\" command in readgm()\n" );
9322 fprintf( output_fp,
9323 "\n\n nec2c: Exiting after an \"XT\" command in readgm()" );
9324 stop(0);
9325 }
9326
9327 /* Return if only mnemonic on card */
9328 if( nlin == 2 )
9329 {
9330 *i1 = *i2 = *i3 = *i4 = 0;
9331 *f1 = *f2 = *f3 = *f4 = *f5 = *f6 = 0.0;
9332 return;
9333 }
9334
9335 /* read integers from line */
9336 line_idx = 1;
9337 for( i = 0; i < nint; i++ )
9338 {
9339 /* Find first numerical character */
9340 while( ((line_buf[++line_idx] < '0') ||
9341 (line_buf[ line_idx] > '9')) &&
9342 (line_buf[ line_idx] != '+') &&
9343 (line_buf[ line_idx] != '-') )
9344 if( line_buf[line_idx] == '\0')
9345 {
9346 *i1= iarr[0];
9347 *i2= iarr[1];
9348 *i3= iarr[2];
9349 *i4= iarr[3];
9350 *f1= rarr[0];
9351 *f2= rarr[1];
9352 *f3= rarr[2];
9353 *f4= rarr[3];
9354 *f5= rarr[4];
9355 *f6= rarr[5];
9356 return;
9357 }
9358
9359 /* read an integer from line */
9360 iarr[i] = atoi( &line_buf[line_idx] );
9361
9362 /* traverse numerical field to next ' ' or ',' or '\0' */
9363 line_idx--;
9364 while( (line_buf[++line_idx] != ' ') &&
9365 (line_buf[ line_idx] != ',') &&
9366 (line_buf[ line_idx] != '\0') )
9367 {
9368 /* test for non-numerical characters */
9369 if( ((line_buf[line_idx] < '0') ||
9370 (line_buf[line_idx] > '9')) &&
9371 (line_buf[line_idx] != '+') &&
9372 (line_buf[line_idx] != '-') )
9373 {
9374 fprintf( output_fp,
9375 "\n COMMAND DATA CARD \"%s\" ERROR:"
9376 "\n NON-NUMERICAL CHARACTER '%c' IN INTEGER FIELD AT CHAR. %d\n",
9377 gm, line_buf[line_idx], (line_idx+1) );
9378 stop(-1);
9379 }
9380
9381 } /* while( (line_buff[++line_idx] ... */
9382
9383 /* Return on end of line */
9384 if( line_buf[line_idx] == '\0' )
9385 {
9386 *i1= iarr[0];
9387 *i2= iarr[1];
9388 *i3= iarr[2];
9389 *i4= iarr[3];
9390 *f1= rarr[0];
9391 *f2= rarr[1];
9392 *f3= rarr[2];
9393 *f4= rarr[3];
9394 *f5= rarr[4];
9395 *f6= rarr[5];
9396 return;
9397 }
9398
9399 } /* for( i = 0; i < nint; i++ ) */
9400
9401 /* read doubles from line */
9402 for( i = 0; i < nflt; i++ )
9403 {
9404 /* Find first numerical character */
9405 while( ((line_buf[++line_idx] < '0') ||
9406 (line_buf[ line_idx] > '9')) &&
9407 (line_buf[ line_idx] != '+') &&
9408 (line_buf[ line_idx] != '-') &&
9409 (line_buf[ line_idx] != '.') )
9410 if( line_buf[line_idx] == '\0')
9411 {
9412 *i1= iarr[0];
9413 *i2= iarr[1];
9414 *i3= iarr[2];
9415 *i4= iarr[3];
9416 *f1= rarr[0];
9417 *f2= rarr[1];
9418 *f3= rarr[2];
9419 *f4= rarr[3];
9420 *f5= rarr[4];
9421 *f6= rarr[5];
9422 return;
9423 }
9424
9425 /* read a double from line */
9426 rarr[i] = atof( &line_buf[line_idx] );
9427
9428 /* traverse numerical field to next ' ' or ',' */
9429 line_idx--;
9430 while( (line_buf[++line_idx] != ' ') &&
9431 (line_buf[ line_idx] != ',') &&
9432 (line_buf[ line_idx] != '\0') )
9433 {
9434 /* test for non-numerical characters */
9435 if( ((line_buf[line_idx] < '0') ||
9436 (line_buf[line_idx] > '9')) &&
9437 (line_buf[line_idx] != '.') &&
9438 (line_buf[line_idx] != '+') &&
9439 (line_buf[line_idx] != '-') &&
9440 (line_buf[line_idx] != 'E') &&
9441 (line_buf[line_idx] != 'e') )
9442 {
9443 fprintf( output_fp,
9444 "\n COMMAND DATA CARD \"%s\" ERROR:"
9445 "\n NON-NUMERICAL CHARACTER '%c' IN FLOAT FIELD AT CHAR. %d\n",
9446 gm, line_buf[line_idx], (line_idx+1) );
9447 stop(-1);
9448 }
9449
9450 } /* while( (line_buff[++line_idx] ... */
9451
9452 /* Return on end of line */
9453 if( line_buf[line_idx] == '\0' )
9454 {
9455 *i1= iarr[0];
9456 *i2= iarr[1];
9457 *i3= iarr[2];
9458 *i4= iarr[3];
9459 *f1= rarr[0];
9460 *f2= rarr[1];
9461 *f3= rarr[2];
9462 *f4= rarr[3];
9463 *f5= rarr[4];
9464 *f6= rarr[5];
9465 return;
9466 }
9467
9468 } /* for( i = 0; i < nflt; i++ ) */
9469
9470 *i1= iarr[0];
9471 *i2= iarr[1];
9472 *i3= iarr[2];
9473 *i4= iarr[3];
9474 *f1= rarr[0];
9475 *f2= rarr[1];
9476 *f3= rarr[2];
9477 *f4= rarr[3];
9478 *f5= rarr[4];
9479 *f6= rarr[5];
9480
9481 return;
9482 }
9483
9484 /*-----------------------------------------------------------------------*/
9485
9486 /* reflc reflects partial structure along x,y, or z axes or rotates */
9487 /* structure to complete a symmetric structure. */
reflc(int ix,int iy,int iz,int itx,int nop)9488 void reflc( int ix, int iy, int iz, int itx, int nop )
9489 {
9490 int iti, i, nx, itagi, k, mreq;
9491 double e1, e2, fnop, sam, cs, ss, xk, yk;
9492
9493 np= n;
9494 mp= m;
9495 ipsym=0;
9496 iti= itx;
9497
9498 if( ix >= 0)
9499 {
9500 if( nop == 0)
9501 return;
9502
9503 ipsym=1;
9504
9505 /* reflect along z axis */
9506 if( iz != 0)
9507 {
9508 ipsym=2;
9509
9510 if( n > 0 )
9511 {
9512 /* Reallocate tags buffer */
9513 mem_realloc( (void *)&itag, (2*n+m) * sizeof(int) );
9514
9515 /* Reallocate wire buffers */
9516 mreq = 2*n * sizeof(double);
9517 mem_realloc( (void *)&x, mreq );
9518 mem_realloc( (void *)&y, mreq );
9519 mem_realloc( (void *)&z, mreq );
9520 mem_realloc( (void *)&x2, mreq );
9521 mem_realloc( (void *)&y2, mreq );
9522 mem_realloc( (void *)&z2, mreq );
9523 mem_realloc( (void *)&bi, mreq );
9524
9525 for( i = 0; i < n; i++ )
9526 {
9527 nx= i+ n;
9528 e1= z[i];
9529 e2= z2[i];
9530
9531 if( (fabs(e1)+fabs(e2) <= 1.0e-5) || (e1*e2 < -1.0e-6) )
9532 {
9533 fprintf( output_fp,
9534 "\n GEOMETRY DATA ERROR--SEGMENT %d"
9535 " LIES IN PLANE OF SYMMETRY", i+1 );
9536 stop(-1);
9537 }
9538
9539 x[nx]= x[i];
9540 y[nx]= y[i];
9541 z[nx]= - e1;
9542 x2[nx]= x2[i];
9543 y2[nx]= y2[i];
9544 z2[nx]= - e2;
9545 itagi= itag[i];
9546
9547 if( itagi == 0)
9548 itag[nx]=0;
9549 if( itagi != 0)
9550 itag[nx]= itagi+ iti;
9551
9552 bi[nx]= bi[i];
9553
9554 } /* for( i = 0; i < n; i++ ) */
9555
9556 n= n*2;
9557 iti= iti*2;
9558
9559 } /* if( n > 0) */
9560
9561 if( m > 0 )
9562 {
9563 /* Reallocate patch buffers */
9564 mreq = 2*m * sizeof(double);
9565 mem_realloc( (void *)&px, mreq );
9566 mem_realloc( (void *)&py, mreq );
9567 mem_realloc( (void *)&pz, mreq );
9568 mem_realloc( (void *)&t1x, mreq );
9569 mem_realloc( (void *)&t1y, mreq );
9570 mem_realloc( (void *)&t1z, mreq );
9571 mem_realloc( (void *)&t2x, mreq );
9572 mem_realloc( (void *)&t2y, mreq );
9573 mem_realloc( (void *)&t2z, mreq );
9574 mem_realloc( (void *)&pbi, mreq );
9575 mem_realloc( (void *)&psalp, mreq );
9576
9577 for( i = 0; i < m; i++ )
9578 {
9579 nx = i+m;
9580 if( fabs(pz[i]) <= 1.0e-10)
9581 {
9582 fprintf( output_fp,
9583 "\n GEOMETRY DATA ERROR--PATCH %d"
9584 " LIES IN PLANE OF SYMMETRY", i+1 );
9585 stop(-1);
9586 }
9587
9588 px[nx]= px[i];
9589 py[nx]= py[i];
9590 pz[nx]= - pz[i];
9591 t1x[nx]= t1x[i];
9592 t1y[nx]= t1y[i];
9593 t1z[nx]= - t1z[i];
9594 t2x[nx]= t2x[i];
9595 t2y[nx]= t2y[i];
9596 t2z[nx]= - t2z[i];
9597 psalp[nx]= - psalp[i];
9598 pbi[nx]= pbi[i];
9599 }
9600
9601 m= m*2;
9602
9603 } /* if( m >= m2) */
9604
9605 } /* if( iz != 0) */
9606
9607 /* reflect along y axis */
9608 if( iy != 0)
9609 {
9610 if( n > 0)
9611 {
9612 /* Reallocate tags buffer */
9613 mem_realloc( (void *)&itag, (2*n+m) * sizeof(int) );/*????*/
9614
9615 /* Reallocate wire buffers */
9616 mreq = 2*n * sizeof(double);
9617 mem_realloc( (void *)&x, mreq );
9618 mem_realloc( (void *)&y, mreq );
9619 mem_realloc( (void *)&z, mreq );
9620 mem_realloc( (void *)&x2, mreq );
9621 mem_realloc( (void *)&y2, mreq );
9622 mem_realloc( (void *)&z2, mreq );
9623 mem_realloc( (void *)&bi, mreq );
9624
9625 for( i = 0; i < n; i++ )
9626 {
9627 nx= i+ n;
9628 e1= y[i];
9629 e2= y2[i];
9630
9631 if( (fabs(e1)+fabs(e2) <= 1.0e-5) || (e1*e2 < -1.0e-6) )
9632 {
9633 fprintf( output_fp,
9634 "\n GEOMETRY DATA ERROR--SEGMENT %d"
9635 " LIES IN PLANE OF SYMMETRY", i+1 );
9636 stop(-1);
9637 }
9638
9639 x[nx]= x[i];
9640 y[nx]= - e1;
9641 z[nx]= z[i];
9642 x2[nx]= x2[i];
9643 y2[nx]= - e2;
9644 z2[nx]= z2[i];
9645 itagi= itag[i];
9646
9647 if( itagi == 0)
9648 itag[nx]=0;
9649 if( itagi != 0)
9650 itag[nx]= itagi+ iti;
9651
9652 bi[nx]= bi[i];
9653
9654 } /* for( i = n2-1; i < n; i++ ) */
9655
9656 n= n*2;
9657 iti= iti*2;
9658
9659 } /* if( n >= n2) */
9660
9661 if( m > 0 )
9662 {
9663 /* Reallocate patch buffers */
9664 mreq = 2*m * sizeof(double);
9665 mem_realloc( (void *)&px, mreq );
9666 mem_realloc( (void *)&py, mreq );
9667 mem_realloc( (void *)&pz, mreq );
9668 mem_realloc( (void *)&t1x, mreq );
9669 mem_realloc( (void *)&t1y, mreq );
9670 mem_realloc( (void *)&t1z, mreq );
9671 mem_realloc( (void *)&t2x, mreq );
9672 mem_realloc( (void *)&t2y, mreq );
9673 mem_realloc( (void *)&t2z, mreq );
9674 mem_realloc( (void *)&pbi, mreq );
9675 mem_realloc( (void *)&psalp, mreq );
9676
9677 for( i = 0; i < m; i++ )
9678 {
9679 nx= i+m;
9680 if( fabs( py[i]) <= 1.0e-10)
9681 {
9682 fprintf( output_fp,
9683 "\n GEOMETRY DATA ERROR--PATCH %d"
9684 " LIES IN PLANE OF SYMMETRY", i+1 );
9685 stop(-1);
9686 }
9687
9688 px[nx]= px[i];
9689 py[nx]= - py[i];
9690 pz[nx]= pz[i];
9691 t1x[nx]= t1x[i];
9692 t1y[nx]= - t1y[i];
9693 t1z[nx]= t1z[i];
9694 t2x[nx]= t2x[i];
9695 t2y[nx]= - t2y[i];
9696 t2z[nx]= t2z[i];
9697 psalp[nx]= - psalp[i];
9698 pbi[nx]= pbi[i];
9699
9700 } /* for( i = m2; i <= m; i++ ) */
9701
9702 m= m*2;
9703
9704 } /* if( m >= m2) */
9705
9706 } /* if( iy != 0) */
9707
9708 /* reflect along x axis */
9709 if( ix == 0 )
9710 return;
9711
9712 if( n > 0 )
9713 {
9714 /* Reallocate tags buffer */
9715 mem_realloc( (void *)&itag, (2*n+m) * sizeof(int) );/*????*/
9716
9717 /* Reallocate wire buffers */
9718 mreq = 2*n * sizeof(double);
9719 mem_realloc( (void *)&x, mreq );
9720 mem_realloc( (void *)&y, mreq );
9721 mem_realloc( (void *)&z, mreq );
9722 mem_realloc( (void *)&x2, mreq );
9723 mem_realloc( (void *)&y2, mreq );
9724 mem_realloc( (void *)&z2, mreq );
9725 mem_realloc( (void *)&bi, mreq );
9726
9727 for( i = 0; i < n; i++ )
9728 {
9729 nx= i+ n;
9730 e1= x[i];
9731 e2= x2[i];
9732
9733 if( (fabs(e1)+fabs(e2) <= 1.0e-5) || (e1*e2 < -1.0e-6) )
9734 {
9735 fprintf( output_fp,
9736 "\n GEOMETRY DATA ERROR--SEGMENT %d"
9737 " LIES IN PLANE OF SYMMETRY", i+1 );
9738 stop(-1);
9739 }
9740
9741 x[nx]= - e1;
9742 y[nx]= y[i];
9743 z[nx]= z[i];
9744 x2[nx]= - e2;
9745 y2[nx]= y2[i];
9746 z2[nx]= z2[i];
9747 itagi= itag[i];
9748
9749 if( itagi == 0)
9750 itag[nx]=0;
9751 if( itagi != 0)
9752 itag[nx]= itagi+ iti;
9753
9754 bi[nx]= bi[i];
9755 }
9756
9757 n= n*2;
9758
9759 } /* if( n > 0) */
9760
9761 if( m == 0 )
9762 return;
9763
9764 /* Reallocate patch buffers */
9765 mreq = 2*m * sizeof(double);
9766 mem_realloc( (void *)&px, mreq );
9767 mem_realloc( (void *)&py, mreq );
9768 mem_realloc( (void *)&pz, mreq );
9769 mem_realloc( (void *)&t1x, mreq );
9770 mem_realloc( (void *)&t1y, mreq );
9771 mem_realloc( (void *)&t1z, mreq );
9772 mem_realloc( (void *)&t2x, mreq );
9773 mem_realloc( (void *)&t2y, mreq );
9774 mem_realloc( (void *)&t2z, mreq );
9775 mem_realloc( (void *)&pbi, mreq );
9776 mem_realloc( (void *)&psalp, mreq );
9777
9778 for( i = 0; i < m; i++ )
9779 {
9780 nx= i+m;
9781 if( fabs( px[i]) <= 1.0e-10)
9782 {
9783 fprintf( output_fp,
9784 "\n GEOMETRY DATA ERROR--PATCH %d"
9785 " LIES IN PLANE OF SYMMETRY", i+1 );
9786 stop(-1);
9787 }
9788
9789 px[nx]= - px[i];
9790 py[nx]= py[i];
9791 pz[nx]= pz[i];
9792 t1x[nx]= - t1x[i];
9793 t1y[nx]= t1y[i];
9794 t1z[nx]= t1z[i];
9795 t2x[nx]= - t2x[i];
9796 t2y[nx]= t2y[i];
9797 t2z[nx]= t2z[i];
9798 psalp[nx]= - psalp[i];
9799 pbi[nx]= pbi[i];
9800 }
9801
9802 m= m*2;
9803 return;
9804
9805 } /* if( ix >= 0) */
9806
9807 /* reproduce structure with rotation to form cylindrical structure */
9808 fnop= (double)nop;
9809 ipsym=-1;
9810 sam=TP/ fnop;
9811 cs= cos( sam);
9812 ss= sin( sam);
9813
9814 if( n > 0)
9815 {
9816 n *= nop;
9817 nx= np;
9818
9819 /* Reallocate tags buffer */
9820 mem_realloc( (void *)&itag, (n+m) * sizeof(int) );/*????*/
9821
9822 /* Reallocate wire buffers */
9823 mreq = n * sizeof(double);
9824 mem_realloc( (void *)&x, mreq );
9825 mem_realloc( (void *)&y, mreq );
9826 mem_realloc( (void *)&z, mreq );
9827 mem_realloc( (void *)&x2, mreq );
9828 mem_realloc( (void *)&y2, mreq );
9829 mem_realloc( (void *)&z2, mreq );
9830 mem_realloc( (void *)&bi, mreq );
9831
9832 for( i = nx; i < n; i++ )
9833 {
9834 k= i- np;
9835 xk= x[k];
9836 yk= y[k];
9837 x[i]= xk* cs- yk* ss;
9838 y[i]= xk* ss+ yk* cs;
9839 z[i]= z[k];
9840 xk= x2[k];
9841 yk= y2[k];
9842 x2[i]= xk* cs- yk* ss;
9843 y2[i]= xk* ss+ yk* cs;
9844 z2[i]= z2[k];
9845 bi[i]= bi[k];
9846 itagi= itag[k];
9847
9848 if( itagi == 0)
9849 itag[i]=0;
9850 if( itagi != 0)
9851 itag[i]= itagi+ iti;
9852 }
9853
9854 } /* if( n >= n2) */
9855
9856 if( m == 0 )
9857 return;
9858
9859 m *= nop;
9860 nx= mp;
9861
9862 /* Reallocate patch buffers */
9863 mreq = m * sizeof(double);
9864 mem_realloc( (void *)&px, mreq );
9865 mem_realloc( (void *)&py, mreq );
9866 mem_realloc( (void *)&pz, mreq );
9867 mem_realloc( (void *)&t1x, mreq );
9868 mem_realloc( (void *)&t1y, mreq );
9869 mem_realloc( (void *)&t1z, mreq );
9870 mem_realloc( (void *)&t2x, mreq );
9871 mem_realloc( (void *)&t2y, mreq );
9872 mem_realloc( (void *)&t2z, mreq );
9873 mem_realloc( (void *)&pbi, mreq );
9874 mem_realloc( (void *)&psalp, mreq );
9875
9876 for( i = nx; i < m; i++ )
9877 {
9878 k = i-mp;
9879 xk= px[k];
9880 yk= py[k];
9881 px[i]= xk* cs- yk* ss;
9882 py[i]= xk* ss+ yk* cs;
9883 pz[i]= pz[k];
9884 xk= t1x[k];
9885 yk= t1y[k];
9886 t1x[i]= xk* cs- yk* ss;
9887 t1y[i]= xk* ss+ yk* cs;
9888 t1z[i]= t1z[k];
9889 xk= t2x[k];
9890 yk= t2y[k];
9891 t2x[i]= xk* cs- yk* ss;
9892 t2y[i]= xk* ss+ yk* cs;
9893 t2z[i]= t2z[k];
9894 psalp[i]= psalp[k];
9895 pbi[i]= pbi[k];
9896
9897 } /* for( i = nx; i < m; i++ ) */
9898
9899 return;
9900 }
9901
9902 /*-----------------------------------------------------------------------*/
9903
9904 /* for the sommerfeld ground option, rom2 integrates over the source */
9905 /* segment to obtain the total field due to ground. the method of */
9906 /* variable interval width romberg integration is used. there are 9 */
9907 /* field components - the x, y, and z components due to constant, */
9908 /* sine, and cosine current distributions. */
rom2(double a,double b,complex double * sum,double dmin)9909 void rom2( double a, double b, complex double *sum, double dmin )
9910 {
9911 int i, ns, nt, flag=TRUE;
9912 int nts = 4, nx = 1, n = 9;
9913 double ze, ep, zend, dz=0., dzot=0., tmag1, tmag2, tr, ti;
9914 double z, s; /***also global***/
9915 double rx = 1.0e-4;
9916 complex double g1[9], g2[9], g3[9], g4[9], g5[9];
9917 complex double t00, t01[9], t10[9], t02, t11, t20[9];
9918
9919 z= a;
9920 ze= b;
9921 s= b- a;
9922
9923 if( s <= 0.)
9924 {
9925 fprintf( output_fp, "\n ERROR - B LESS THAN A IN ROM2" );
9926 stop(-1);
9927 }
9928
9929 ep= s/(1.e4* npm);
9930 zend= ze- ep;
9931
9932 for( i = 0; i < n; i++ )
9933 sum[i]=CPLX_00;
9934
9935 ns= nx;
9936 nt=0;
9937 sflds( z, g1);
9938
9939 while( TRUE )
9940 {
9941 if( flag )
9942 {
9943 dz= s/ ns;
9944 if( z+ dz > ze)
9945 {
9946 dz= ze- z;
9947 if( dz <= ep)
9948 return;
9949 }
9950
9951 dzot= dz*.5;
9952 sflds( z+ dzot, g3);
9953 sflds( z+ dz, g5);
9954
9955 } /* if( flag ) */
9956
9957 tmag1=0.;
9958 tmag2=0.;
9959
9960 /* evaluate 3 point romberg result and test convergence. */
9961 for( i = 0; i < n; i++ )
9962 {
9963 t00=( g1[i]+ g5[i])* dzot;
9964 t01[i]=( t00+ dz* g3[i])*.5;
9965 t10[i]=(4.* t01[i]- t00)/3.;
9966 if( i > 2)
9967 continue;
9968
9969 tr= creal( t01[i]);
9970 ti= cimag( t01[i]);
9971 tmag1= tmag1+ tr* tr+ ti* ti;
9972 tr= creal( t10[i]);
9973 ti= cimag( t10[i]);
9974 tmag2= tmag2+ tr* tr+ ti* ti;
9975
9976 } /* for( i = 0; i < n; i++ ) */
9977
9978 tmag1= sqrt( tmag1);
9979 tmag2= sqrt( tmag2);
9980 test( tmag1, tmag2, &tr, 0., 0., &ti, dmin);
9981
9982 if( tr <= rx)
9983 {
9984 for( i = 0; i < n; i++ )
9985 sum[i] += t10[i];
9986 nt += 2;
9987
9988 z += dz;
9989 if( z > zend)
9990 return;
9991
9992 for( i = 0; i < n; i++ )
9993 g1[i]= g5[i];
9994
9995 if( (nt >= nts) && (ns > nx) )
9996 {
9997 ns= ns/2;
9998 nt=1;
9999 }
10000 flag = TRUE;
10001 continue;
10002
10003 } /* if( tr <= rx) */
10004
10005 sflds( z+ dz*.25, g2);
10006 sflds( z+ dz*.75, g4);
10007 tmag1=0.;
10008 tmag2=0.;
10009
10010 /* evaluate 5 point romberg result and test convergence. */
10011 for( i = 0; i < n; i++ )
10012 {
10013 t02=( t01[i]+ dzot*( g2[i]+ g4[i]))*.5;
10014 t11=( 4.0 * t02- t01[i] )/3.;
10015 t20[i]=(16.* t11- t10[i])/15.;
10016 if( i > 2)
10017 continue;
10018
10019 tr= creal( t11);
10020 ti= cimag( t11);
10021 tmag1= tmag1+ tr* tr+ ti* ti;
10022 tr= creal( t20[i]);
10023 ti= cimag( t20[i]);
10024 tmag2= tmag2+ tr* tr+ ti* ti;
10025
10026 } /* for( i = 0; i < n; i++ ) */
10027
10028 tmag1= sqrt( tmag1);
10029 tmag2= sqrt( tmag2);
10030 test( tmag1, tmag2, &tr, 0.,0., &ti, dmin);
10031
10032 if( tr > rx)
10033 {
10034 nt=0;
10035 if( ns < npm )
10036 {
10037 ns= ns*2;
10038 dz= s/ ns;
10039 dzot= dz*.5;
10040
10041 for( i = 0; i < n; i++ )
10042 {
10043 g5[i]= g3[i];
10044 g3[i]= g2[i];
10045 }
10046
10047 flag=FALSE;
10048 continue;
10049
10050 } /* if( ns < npm) */
10051
10052 fprintf( output_fp,
10053 "\n ROM2 -- STEP SIZE LIMITED AT Z = %12.5E", z );
10054
10055 } /* if( tr > rx) */
10056
10057 for( i = 0; i < n; i++ )
10058 sum[i]= sum[i]+ t20[i];
10059 nt= nt+1;
10060
10061 z= z+ dz;
10062 if( z > zend)
10063 return;
10064
10065 for( i = 0; i < n; i++ )
10066 g1[i]= g5[i];
10067
10068 flag = TRUE;
10069 if( (nt < nts) || (ns <= nx) )
10070 continue;
10071
10072 ns= ns/2;
10073 nt=1;
10074
10075 } /* while( TRUE ) */
10076
10077 }
10078
10079 /*-----------------------------------------------------------------------*/
10080
10081 /* compute component of basis function i on segment is. */
sbf(int i,int is,double * aa,double * bb,double * cc)10082 void sbf( int i, int is, double *aa, double *bb, double *cc )
10083 {
10084 int ix, jsno, june, jcox, jcoxx, jend, iend, njun1=0, njun2;
10085 double d, sig, pp, sdh, cdh, sd, omc, aj, pm=0, cd, ap, qp, qm, xxi;
10086
10087 *aa=0.;
10088 *bb=0.;
10089 *cc=0.;
10090 june=0;
10091 jsno=0;
10092 pp=0.;
10093 ix=i-1;
10094
10095 jcox= icon1[ix];
10096 if( jcox > PCHCON)
10097 jcox= i;
10098 jcoxx = jcox-1;
10099
10100 jend=-1;
10101 iend=-1;
10102 sig=-1.;
10103
10104 do
10105 {
10106 if( jcox != 0 )
10107 {
10108 if( jcox < 0 )
10109 jcox= - jcox;
10110 else
10111 {
10112 sig= - sig;
10113 jend= - jend;
10114 }
10115
10116 jcoxx = jcox-1;
10117 jsno++;
10118 d= PI* si[jcoxx];
10119 sdh= sin( d);
10120 cdh= cos( d);
10121 sd=2.* sdh* cdh;
10122
10123 if( d <= 0.015)
10124 {
10125 omc=4.* d* d;
10126 omc=((1.3888889e-3* omc -4.1666666667e-2)* omc +.5)* omc;
10127 }
10128 else
10129 omc=1.- cdh* cdh+ sdh* sdh;
10130
10131 aj=1./( log(1./( PI* bi[jcoxx]))-.577215664);
10132 pp -= omc/ sd* aj;
10133
10134 if( jcox == is)
10135 {
10136 *aa= aj/ sd* sig;
10137 *bb= aj/(2.* cdh);
10138 *cc= - aj/(2.* sdh)* sig;
10139 june= iend;
10140 }
10141
10142 if( jcox != i )
10143 {
10144 if( jend != 1)
10145 jcox= icon1[jcoxx];
10146 else
10147 jcox= icon2[jcoxx];
10148
10149 if( abs(jcox) != i )
10150 {
10151 if( jcox == 0 )
10152 {
10153 fprintf( output_fp,
10154 "\n SBF - SEGMENT CONNECTION ERROR FOR SEGMENT %d", i);
10155 stop(-1);
10156 }
10157 else
10158 continue;
10159 }
10160
10161 } /* if( jcox != i ) */
10162 else
10163 if( jcox == is)
10164 *bb= - *bb;
10165
10166 if( iend == 1)
10167 break;
10168
10169 } /* if( jcox != 0 ) */
10170
10171 pm= - pp;
10172 pp=0.;
10173 njun1= jsno;
10174
10175 jcox= icon2[ix];
10176 if( jcox > PCHCON)
10177 jcox= i;
10178
10179 jend=1;
10180 iend=1;
10181 sig=-1.;
10182
10183 } /* do */
10184 while( jcox != 0 );
10185
10186 njun2= jsno- njun1;
10187 d= PI* si[ix];
10188 sdh= sin( d);
10189 cdh= cos( d);
10190 sd=2.* sdh* cdh;
10191 cd= cdh* cdh- sdh* sdh;
10192
10193 if( d <= 0.015)
10194 {
10195 omc=4.* d* d;
10196 omc=((1.3888889e-3* omc -4.1666666667e-2)* omc +.5)* omc;
10197 }
10198 else
10199 omc=1.- cd;
10200
10201 ap=1./( log(1./( PI* bi[ix])) -.577215664);
10202 aj= ap;
10203
10204 if( njun1 == 0)
10205 {
10206 if( njun2 == 0)
10207 {
10208 *aa =-1.;
10209 qp= PI* bi[ix];
10210 xxi= qp* qp;
10211 xxi= qp*(1.-.5* xxi)/(1.- xxi);
10212 *cc=1./( cdh- xxi* sdh);
10213 return;
10214 }
10215
10216 qp= PI* bi[ix];
10217 xxi= qp* qp;
10218 xxi= qp*(1.-.5* xxi)/(1.- xxi);
10219 qp=-( omc+ xxi* sd)/( sd*( ap+ xxi* pp)+ cd*( xxi* ap- pp));
10220
10221 if( june == 1)
10222 {
10223 *aa= - *aa* qp;
10224 *bb= *bb* qp;
10225 *cc= - *cc* qp;
10226 if( i != is)
10227 return;
10228 }
10229
10230 *aa -= 1.;
10231 d = cd - xxi * sd;
10232 *bb += (sdh + ap * qp * (cdh - xxi * sdh)) / d;
10233 *cc += (cdh + ap * qp * (sdh + xxi * cdh)) / d;
10234 return;
10235
10236 } /* if( njun1 == 0) */
10237
10238 if( njun2 == 0)
10239 {
10240 qm= PI* bi[ix];
10241 xxi= qm* qm;
10242 xxi= qm*(1.-.5* xxi)/(1.- xxi);
10243 qm=( omc+ xxi* sd)/( sd*( aj- xxi* pm)+ cd*( pm+ xxi* aj));
10244
10245 if( june == -1)
10246 {
10247 *aa= *aa* qm;
10248 *bb= *bb* qm;
10249 *cc= *cc* qm;
10250 if( i != is)
10251 return;
10252 }
10253
10254 *aa -= 1.;
10255 d= cd- xxi* sd;
10256 *bb += ( aj* qm*( cdh- xxi* sdh)- sdh)/ d;
10257 *cc += ( cdh- aj* qm*( sdh+ xxi* cdh))/ d;
10258 return;
10259
10260 } /* if( njun2 == 0) */
10261
10262 qp= sd*( pm* pp+ aj* ap)+ cd*( pm* ap- pp* aj);
10263 qm=( ap* omc- pp* sd)/ qp;
10264 qp=-( aj* omc+ pm* sd)/ qp;
10265
10266 if( june != 0 )
10267 {
10268 if( june < 0 )
10269 {
10270 *aa= *aa* qm;
10271 *bb= *bb* qm;
10272 *cc= *cc* qm;
10273 }
10274 else
10275 {
10276 *aa= - *aa* qp;
10277 *bb= *bb* qp;
10278 *cc= - *cc* qp;
10279 }
10280
10281 if( i != is)
10282 return;
10283
10284 } /* if( june != 0 ) */
10285
10286 *aa -= 1.;
10287 *bb += ( aj* qm+ ap* qp)* sdh/ sd;
10288 *cc += ( aj* qm- ap* qp)* cdh/ sd;
10289
10290 return;
10291 }
10292
10293 /*-----------------------------------------------------------------------*/
10294
10295 /* sfldx returns the field due to ground for a current element on */
10296 /* the source segment at t relative to the segment center. */
sflds(double t,complex double * e)10297 void sflds( double t, complex double *e )
10298 {
10299 double xt, yt, zt, rhx, rhy, rhs, rho, phx, phy;
10300 double cph, sph, zphs, r2s, rk, sfac, thet;
10301 complex double erv, ezv, erh, ezh, eph, er, et, hrv, hzv, hrh;
10302
10303 xt= xj+ t* cabj;
10304 yt= yj+ t* sabj;
10305 zt= zj+ t* salpj;
10306 rhx= xo- xt;
10307 rhy= yo- yt;
10308 rhs= rhx* rhx+ rhy* rhy;
10309 rho= sqrt( rhs);
10310
10311 if( rho <= 0.)
10312 {
10313 rhx=1.;
10314 rhy=0.;
10315 phx=0.;
10316 phy=1.;
10317 }
10318 else
10319 {
10320 rhx= rhx/ rho;
10321 rhy= rhy/ rho;
10322 phx= - rhy;
10323 phy= rhx;
10324 }
10325
10326 cph= rhx* xsn+ rhy* ysn;
10327 sph= rhy* xsn- rhx* ysn;
10328
10329 if( fabs( cph) < 1.0e-10)
10330 cph=0.;
10331 if( fabs( sph) < 1.0e-10)
10332 sph=0.;
10333
10334 zph= zo+ zt;
10335 zphs= zph* zph;
10336 r2s= rhs+ zphs;
10337 r2= sqrt( r2s);
10338 rk= r2* TP;
10339 xx2= cmplx( cos( rk),- sin( rk));
10340
10341 /* use norton approximation for field due to ground. current is */
10342 /* lumped at segment center with current moment for constant, sine, */
10343 /* or cosine distribution. */
10344 if( isnor != 1)
10345 {
10346 zmh=1.;
10347 r1=1.;
10348 xx1=0.;
10349 gwave( &erv, &ezv, &erh, &ezh, &eph);
10350
10351 et=-CONST1* frati* xx2/( r2s* r2);
10352 er=2.* et* cmplx(1.0, rk);
10353 et= et* cmplx(1.0 - rk* rk, rk);
10354 hrv=( er+ et)* rho* zph/ r2s;
10355 hzv=( zphs* er- rhs* et)/ r2s;
10356 hrh=( rhs* er- zphs* et)/ r2s;
10357 erv= erv- hrv;
10358 ezv= ezv- hzv;
10359 erh= erh+ hrh;
10360 ezh= ezh+ hrv;
10361 eph= eph+ et;
10362 erv= erv* salpj;
10363 ezv= ezv* salpj;
10364 erh= erh* sn* cph;
10365 ezh= ezh* sn* cph;
10366 eph= eph* sn* sph;
10367 erh= erv+ erh;
10368 e[0]=( erh* rhx+ eph* phx)* s;
10369 e[1]=( erh* rhy+ eph* phy)* s;
10370 e[2]=( ezv+ ezh)* s;
10371 e[3]=0.;
10372 e[4]=0.;
10373 e[5]=0.;
10374 sfac= PI* s;
10375 sfac= sin( sfac)/ sfac;
10376 e[6]= e[0]* sfac;
10377 e[7]= e[1]* sfac;
10378 e[8]= e[2]* sfac;
10379
10380 return;
10381 } /* if( isnor != 1) */
10382
10383 /* interpolate in sommerfeld field tables */
10384 if( rho >= 1.0e-12)
10385 thet= atan( zph/ rho);
10386 else
10387 thet= POT;
10388
10389 /* combine vertical and horizontal components and convert */
10390 /* to x,y,z components. multiply by exp(-jkr)/r. */
10391 intrp( r2, thet, &erv, &ezv, &erh, &eph );
10392 xx2= xx2/ r2;
10393 sfac= sn* cph;
10394 erh= xx2*( salpj* erv+ sfac* erh);
10395 ezh= xx2*( salpj* ezv- sfac* erv);
10396 /* x,y,z fields for constant current */
10397 eph= sn* sph* xx2* eph;
10398 e[0]= erh* rhx+ eph* phx;
10399 e[1]= erh* rhy+ eph* phy;
10400 e[2]= ezh;
10401 /* x,y,z fields for sine current */
10402 rk= TP* t;
10403 sfac= sin( rk);
10404 e[3]= e[0]* sfac;
10405 e[4]= e[1]* sfac;
10406 /* x,y,z fields for cosine current */
10407 e[5]= e[2]* sfac;
10408 sfac= cos( rk);
10409 e[6]= e[0]* sfac;
10410 e[7]= e[1]* sfac;
10411 e[8]= e[2]* sfac;
10412
10413 return;
10414 }
10415
10416 /*-----------------------------------------------------------------------*/
10417
10418 /* subroutine to solve the matrix equation lu*x=b where l is a unit */
10419 /* lower triangular matrix and u is an upper triangular matrix both */
10420 /* of which are stored in a. the rhs vector b is input and the */
10421 /* solution is returned through vector b. (matrix transposed. */
solve(int n,complex double * a,int * ip,complex double * b,int ndim)10422 void solve( int n, complex double *a, int *ip,
10423 complex double *b, int ndim )
10424 {
10425 int i, ip1, j, k, pia;
10426 complex double sum, *scm = NULL;
10427
10428 /* Allocate to scratch memory */
10429 mem_alloc( (void *)&scm, np2m * sizeof(complex double) );
10430
10431 /* forward substitution */
10432 for( i = 0; i < n; i++ )
10433 {
10434 pia= ip[i]-1;
10435 scm[i]= b[pia];
10436 b[pia]= b[i];
10437 ip1= i+1;
10438
10439 if( ip1 < n)
10440 for( j = ip1; j < n; j++ )
10441 b[j] -= a[j+i*ndim]* scm[i];
10442 }
10443
10444 /* backward substitution */
10445 for( k = 0; k < n; k++ )
10446 {
10447 i= n-k-1;
10448 sum=CPLX_00;
10449 ip1= i+1;
10450
10451 if( ip1 < n)
10452 for( j = ip1; j < n; j++ )
10453 sum += a[i+j*ndim]* b[j];
10454
10455 b[i]=( scm[i]- sum)/ a[i+i*ndim];
10456 }
10457
10458 free_ptr( (void *)&scm );
10459
10460 return;
10461 }
10462
10463 /*-----------------------------------------------------------------------*/
10464
10465 /* subroutine solves, for symmetric structures, handles the */
10466 /* transformation of the right hand side vector and solution */
10467 /* of the matrix eq. */
solves(complex double * a,int * ip,complex double * b,int neq,int nrh,int np,int n,int mp,int m)10468 void solves( complex double *a, int *ip, complex double *b,
10469 int neq, int nrh, int np, int n, int mp, int m)
10470 {
10471 int npeq, nrow, ic, i, kk, ia, ib, j, k;
10472 double fnop, fnorm;
10473 complex double sum, *scm = NULL;
10474
10475 npeq= np+ 2*mp;
10476 fnop= nop;
10477 fnorm=1./ fnop;
10478 nrow= neq;
10479
10480 /* Allocate to scratch memory */
10481 mem_alloc( (void *)&scm, np2m * sizeof(complex double) );
10482
10483 if( nop != 1)
10484 {
10485 for( ic = 0; ic < nrh; ic++ )
10486 {
10487 if( (n != 0) && (m != 0) )
10488 {
10489 for( i = 0; i < neq; i++ )
10490 scm[i]= b[i+ic*neq];
10491
10492 kk=2* mp;
10493 ia= np-1;
10494 ib= n-1;
10495 j= np-1;
10496
10497 for( k = 0; k < nop; k++ )
10498 {
10499 if( k != 0 )
10500 {
10501 for( i = 0; i < np; i++ )
10502 {
10503 ia++;
10504 j++;
10505 b[j+ic*neq]= scm[ia];
10506 }
10507
10508 if( k == (nop-1) )
10509 continue;
10510
10511 } /* if( k != 0 ) */
10512
10513 for( i = 0; i < kk; i++ )
10514 {
10515 ib++;
10516 j++;
10517 b[j+ic*neq]= scm[ib];
10518 }
10519
10520 } /* for( k = 0; k < nop; k++ ) */
10521
10522 } /* if( (n != 0) && (m != 0) ) */
10523
10524 /* transform matrix eq. rhs vector according to symmetry modes */
10525 for( i = 0; i < npeq; i++ )
10526 {
10527 for( k = 0; k < nop; k++ )
10528 {
10529 ia= i+ k* npeq;
10530 scm[k]= b[ia+ic*neq];
10531 }
10532
10533 sum= scm[0];
10534 for( k = 1; k < nop; k++ )
10535 sum += scm[k];
10536
10537 b[i+ic*neq]= sum* fnorm;
10538
10539 for( k = 1; k < nop; k++ )
10540 {
10541 ia= i+ k* npeq;
10542 sum= scm[0];
10543
10544 for( j = 1; j < nop; j++ )
10545 sum += scm[j]* conj( ssx[k+j*nop]);
10546
10547 b[ia+ic*neq]= sum* fnorm;
10548 }
10549
10550 } /* for( i = 0; i < npeq; i++ ) */
10551
10552 } /* for( ic = 0; ic < nrh; ic++ ) */
10553
10554 } /* if( nop != 1) */
10555
10556 /* solve each mode equation */
10557 for( kk = 0; kk < nop; kk++ )
10558 {
10559 ia= kk* npeq;
10560 ib= ia;
10561
10562 for( ic = 0; ic < nrh; ic++ )
10563 solve( npeq, &a[ib], &ip[ia], &b[ia+ic*neq], nrow );
10564
10565 } /* for( kk = 0; kk < nop; kk++ ) */
10566
10567 if( nop == 1)
10568 {
10569 free_ptr( (void *)&scm );
10570 return;
10571 }
10572
10573 /* inverse transform the mode solutions */
10574 for( ic = 0; ic < nrh; ic++ )
10575 {
10576 for( i = 0; i < npeq; i++ )
10577 {
10578 for( k = 0; k < nop; k++ )
10579 {
10580 ia= i+ k* npeq;
10581 scm[k]= b[ia+ic*neq];
10582 }
10583
10584 sum= scm[0];
10585 for( k = 1; k < nop; k++ )
10586 sum += scm[k];
10587
10588 b[i+ic*neq]= sum;
10589 for( k = 1; k < nop; k++ )
10590 {
10591 ia= i+ k* npeq;
10592 sum= scm[0];
10593
10594 for( j = 1; j < nop; j++ )
10595 sum += scm[j]* ssx[k+j*nop];
10596
10597 b[ia+ic*neq]= sum;
10598 }
10599
10600 } /* for( i = 0; i < npeq; i++ ) */
10601
10602 if( (n == 0) || (m == 0) )
10603 continue;
10604
10605 for( i = 0; i < neq; i++ )
10606 scm[i]= b[i+ic*neq];
10607
10608 kk=2* mp;
10609 ia= np-1;
10610 ib= n-1;
10611 j= np-1;
10612
10613 for( k = 0; k < nop; k++ )
10614 {
10615 if( k != 0 )
10616 {
10617 for( i = 0; i < np; i++ )
10618 {
10619 ia++;
10620 j++;
10621 b[ia+ic*neq]= scm[j];
10622 }
10623
10624 if( k == nop)
10625 continue;
10626
10627 } /* if( k != 0 ) */
10628
10629 for( i = 0; i < kk; i++ )
10630 {
10631 ib++;
10632 j++;
10633 b[ib+ic*neq]= scm[j];
10634 }
10635
10636 } /* for( k = 0; k < nop; k++ ) */
10637
10638 } /* for( ic = 0; ic < nrh; ic++ ) */
10639
10640 free_ptr( (void *)&scm );
10641
10642 return;
10643 }
10644
10645 /*-----------------------------------------------------------------------*/
10646
10647 /* compute basis function i */
tbf(int i,int icap)10648 void tbf( int i, int icap )
10649 {
10650 int ix, jcox, jcoxx, jend, iend, njun1=0, njun2, jsnop, jsnox;
10651 double pp, sdh, cdh, sd, omc, aj, pm=0, cd, ap, qp, qm, xxi;
10652 double d, sig; /*** also global ***/
10653
10654 jsno=0;
10655 pp=0.;
10656 ix = i-1;
10657 jcox= icon1[ix];
10658
10659 if( jcox > PCHCON)
10660 jcox= i;
10661
10662 jend=-1;
10663 iend=-1;
10664 sig=-1.;
10665
10666 do
10667 {
10668 if( jcox != 0 )
10669 {
10670 if( jcox < 0 )
10671 jcox= - jcox;
10672 else
10673 {
10674 sig= - sig;
10675 jend= - jend;
10676 }
10677
10678 jcoxx = jcox-1;
10679 jsno++;
10680 jsnox = jsno-1;
10681 jco[jsnox]= jcox;
10682 d= PI* si[jcoxx];
10683 sdh= sin( d);
10684 cdh= cos( d);
10685 sd=2.* sdh* cdh;
10686
10687 if( d <= 0.015)
10688 {
10689 omc=4.* d* d;
10690 omc=((1.3888889e-3* omc-4.1666666667e-2)* omc+.5)* omc;
10691 }
10692 else
10693 omc=1.- cdh* cdh+ sdh* sdh;
10694
10695 aj=1./( log(1./( PI* bi[jcoxx]))-.577215664);
10696 pp= pp- omc/ sd* aj;
10697 ax[jsnox]= aj/ sd* sig;
10698 bx[jsnox]= aj/(2.* cdh);
10699 cx[jsnox]= - aj/(2.* sdh)* sig;
10700
10701 if( jcox != i)
10702 {
10703 if( jend == 1)
10704 jcox= icon2[jcoxx];
10705 else
10706 jcox= icon1[jcoxx];
10707
10708 if( abs(jcox) != i )
10709 {
10710 if( jcox != 0 )
10711 continue;
10712 else
10713 {
10714 fprintf( output_fp,
10715 "\n TBF - SEGMENT CONNECTION ERROR FOR SEGMENT %5d", i );
10716 stop(-1);
10717 }
10718 }
10719
10720 } /* if( jcox != i) */
10721 else
10722 bx[jsnox] = - bx[jsnox];
10723
10724 if( iend == 1)
10725 break;
10726
10727 } /* if( jcox != 0 ) */
10728
10729 pm= - pp;
10730 pp=0.;
10731 njun1= jsno;
10732
10733 jcox= icon2[ix];
10734 if( jcox > PCHCON)
10735 jcox= i;
10736
10737 jend=1;
10738 iend=1;
10739 sig=-1.;
10740
10741 } /* do */
10742 while( jcox != 0 );
10743
10744 njun2= jsno- njun1;
10745 jsnop= jsno;
10746 jco[jsnop]= i;
10747 d= PI* si[ix];
10748 sdh= sin( d);
10749 cdh= cos( d);
10750 sd=2.* sdh* cdh;
10751 cd= cdh* cdh- sdh* sdh;
10752
10753 if( d <= 0.015)
10754 {
10755 omc=4.* d* d;
10756 omc=((1.3888889e-3* omc-4.1666666667e-2)* omc+.5)* omc;
10757 }
10758 else
10759 omc=1.- cd;
10760
10761 ap=1./( log(1./( PI* bi[ix]))-.577215664);
10762 aj= ap;
10763
10764 if( njun1 == 0)
10765 {
10766 if( njun2 == 0)
10767 {
10768 bx[jsnop]=0.;
10769
10770 if( icap == 0)
10771 xxi=0.;
10772 else
10773 {
10774 qp= PI* bi[ix];
10775 xxi= qp* qp;
10776 xxi= qp*(1.-.5* xxi)/(1.- xxi);
10777 }
10778
10779 cx[jsnop]=1./( cdh- xxi* sdh);
10780 jsno= jsnop+1;
10781 ax[jsnop]=-1.;
10782 return;
10783
10784 } /* if( njun2 == 0) */
10785
10786 if( icap == 0)
10787 xxi=0.;
10788 else
10789 {
10790 qp= PI* bi[ix];
10791 xxi= qp* qp;
10792 xxi= qp*(1.-.5* xxi)/(1.- xxi);
10793 }
10794
10795 qp=-( omc+ xxi* sd)/( sd*( ap+ xxi* pp)+ cd*( xxi* ap- pp));
10796 d= cd- xxi* sd;
10797 bx[jsnop]=( sdh+ ap* qp*( cdh- xxi* sdh))/ d;
10798 cx[jsnop]=( cdh+ ap* qp*( sdh+ xxi* cdh))/ d;
10799
10800 for( iend = 0; iend < njun2; iend++ )
10801 {
10802 ax[iend]= - ax[iend]* qp;
10803 bx[iend]= bx[iend]* qp;
10804 cx[iend]= - cx[iend]* qp;
10805 }
10806
10807 jsno= jsnop+1;
10808 ax[jsnop]=-1.;
10809 return;
10810
10811 } /* if( njun1 == 0) */
10812
10813 if( njun2 == 0)
10814 {
10815 if( icap == 0)
10816 xxi=0.;
10817 else
10818 {
10819 qm= PI* bi[ix];
10820 xxi= qm* qm;
10821 xxi= qm*(1.-.5* xxi)/(1.- xxi);
10822 }
10823
10824 qm=( omc+ xxi* sd)/( sd*( aj- xxi* pm)+ cd*( pm+ xxi* aj));
10825 d= cd- xxi* sd;
10826 bx[jsnop]=( aj* qm*( cdh- xxi* sdh)- sdh)/ d;
10827 cx[jsnop]=( cdh- aj* qm*( sdh+ xxi* cdh))/ d;
10828
10829 for( iend = 0; iend < njun1; iend++ )
10830 {
10831 ax[iend]= ax[iend]* qm;
10832 bx[iend]= bx[iend]* qm;
10833 cx[iend]= cx[iend]* qm;
10834 }
10835
10836 jsno= jsnop+1;
10837 ax[jsnop]=-1.;
10838 return;
10839
10840 } /* if( njun2 == 0) */
10841
10842 qp= sd*( pm* pp+ aj* ap)+ cd*( pm* ap- pp* aj);
10843 qm=( ap* omc- pp* sd)/ qp;
10844 qp=-( aj* omc+ pm* sd)/ qp;
10845 bx[jsnop]=( aj* qm+ ap* qp)* sdh/ sd;
10846 cx[jsnop]=( aj* qm- ap* qp)* cdh/ sd;
10847
10848 for( iend = 0; iend < njun1; iend++ )
10849 {
10850 ax[iend]= ax[iend]* qm;
10851 bx[iend]= bx[iend]* qm;
10852 cx[iend]= cx[iend]* qm;
10853 }
10854
10855 jend= njun1;
10856 for( iend = jend; iend < jsno; iend++ )
10857 {
10858 ax[iend]= - ax[iend]* qp;
10859 bx[iend]= bx[iend]* qp;
10860 cx[iend]= - cx[iend]* qp;
10861 }
10862
10863 jsno= jsnop+1;
10864 ax[jsnop]=-1.;
10865 }
10866
10867 /*-----------------------------------------------------------------------*/
10868
10869 /* test for convergence in numerical integration */
test(double f1r,double f2r,double * tr,double f1i,double f2i,double * ti,double dmin)10870 void test( double f1r, double f2r, double *tr,
10871 double f1i, double f2i, double *ti, double dmin )
10872 {
10873 double den;
10874
10875 den= fabs( f2r);
10876 *tr= fabs( f2i);
10877
10878 if( den < *tr)
10879 den= *tr;
10880 if( den < dmin)
10881 den= dmin;
10882
10883 if( den < 1.0e-37)
10884 {
10885 *tr=0.;
10886 *ti=0.;
10887 return;
10888 }
10889
10890 *tr= fabs(( f1r- f2r)/ den);
10891 *ti= fabs(( f1i- f2i)/ den);
10892
10893 return;
10894 }
10895
10896 /*-----------------------------------------------------------------------*/
10897
10898 /* compute the components of all basis functions on segment j */
trio(int j)10899 void trio( int j )
10900 {
10901 int jcox, jcoxx, jsnox, jx, jend=0, iend=0;
10902
10903 jsno=0;
10904 jx = j-1;
10905 jcox= icon1[jx];
10906 jcoxx = jcox-1;
10907
10908 if( jcox <= PCHCON)
10909 {
10910 jend=-1;
10911 iend=-1;
10912 }
10913
10914 if( (jcox == 0) || (jcox > PCHCON) )
10915 {
10916 jcox= icon2[jx];
10917 jcoxx = jcox-1;
10918
10919 if( jcox <= PCHCON)
10920 {
10921 jend=1;
10922 iend=1;
10923 }
10924
10925 if( jcox == 0 || (jcox > PCHCON) )
10926 {
10927 jsnox = jsno;
10928 jsno++;
10929
10930 /* Allocate to connections buffers */
10931 if( jsno >= maxcon )
10932 {
10933 maxcon = jsno +1;
10934 mem_realloc( (void *)&jco, maxcon * sizeof(int) );
10935 mem_realloc( (void *) &ax, maxcon * sizeof(double) );
10936 mem_realloc( (void *) &bx, maxcon * sizeof(double) );
10937 mem_realloc( (void *) &cx, maxcon * sizeof(double) );
10938 }
10939
10940 sbf( j, j, &ax[jsnox], &bx[jsnox], &cx[jsnox]);
10941 jco[jsnox]= j;
10942 return;
10943 }
10944
10945 } /* if( (jcox == 0) || (jcox > PCHCON) ) */
10946
10947 do
10948 {
10949 if( jcox < 0 )
10950 jcox= - jcox;
10951 else
10952 jend= - jend;
10953 jcoxx = jcox-1;
10954
10955 if( jcox != j)
10956 {
10957 jsnox = jsno;
10958 jsno++;
10959
10960 /* Allocate to connections buffers */
10961 if( jsno >= maxcon )
10962 {
10963 maxcon = jsno +1;
10964 mem_realloc( (void *)&jco, maxcon * sizeof(int) );
10965 mem_realloc( (void *) &ax, maxcon * sizeof(double) );
10966 mem_realloc( (void *) &bx, maxcon * sizeof(double) );
10967 mem_realloc( (void *) &cx, maxcon * sizeof(double) );
10968 }
10969
10970 sbf( jcox, j, &ax[jsnox], &bx[jsnox], &cx[jsnox]);
10971 jco[jsnox]= jcox;
10972
10973 if( jend != 1)
10974 jcox= icon1[jcoxx];
10975 else
10976 jcox= icon2[jcoxx];
10977
10978 if( jcox == 0 )
10979 {
10980 fprintf( output_fp,
10981 "\n TRIO - SEGMENT CONNENTION ERROR FOR SEGMENT %5d", j );
10982 stop(-1);
10983 }
10984 else
10985 continue;
10986
10987 } /* if( jcox != j) */
10988
10989 if( iend == 1)
10990 break;
10991
10992 jcox= icon2[jx];
10993
10994 if( jcox > PCHCON)
10995 break;
10996
10997 jend=1;
10998 iend=1;
10999
11000 } /* do */
11001 while( jcox != 0 );
11002
11003 jsnox = jsno;
11004 jsno++;
11005
11006 /* Allocate to connections buffers */
11007 if( jsno >= maxcon )
11008 {
11009 maxcon = jsno +1;
11010 mem_realloc( (void *)&jco, maxcon * sizeof(int) );
11011 mem_realloc( (void *) &ax, maxcon * sizeof(double) );
11012 mem_realloc( (void *) &bx, maxcon * sizeof(double) );
11013 mem_realloc( (void *) &cx, maxcon * sizeof(double) );
11014 }
11015
11016 sbf( j, j, &ax[jsnox], &bx[jsnox], &cx[jsnox]);
11017 jco[jsnox]= j;
11018
11019 return;
11020
11021 }
11022
11023 /*-----------------------------------------------------------------------*/
11024
11025 /* calculates the electric field due to unit current */
11026 /* in the t1 and t2 directions on a patch */
unere(double xob,double yob,double zob)11027 void unere( double xob, double yob, double zob )
11028 {
11029 double zr, t1zr, t2zr, rx, ry, rz, r, tt1;
11030 double tt2, rt, xymag, px, py, cth, r2;
11031 complex double er, q1, q2, rrv, rrh, edp;
11032
11033 zr= zj;
11034 t1zr= t1zj;
11035 t2zr= t2zj;
11036
11037 if( ipgnd == 2)
11038 {
11039 zr= - zr;
11040 t1zr= - t1zr;
11041 t2zr= - t2zr;
11042 }
11043
11044 rx= xob- xj;
11045 ry= yob- yj;
11046 rz= zob- zr;
11047 r2= rx* rx+ ry* ry+ rz* rz;
11048
11049 if( r2 <= 1.0e-20)
11050 {
11051 exk=CPLX_00;
11052 eyk=CPLX_00;
11053 ezk=CPLX_00;
11054 exs=CPLX_00;
11055 eys=CPLX_00;
11056 ezs=CPLX_00;
11057 return;
11058 }
11059
11060 r= sqrt( r2);
11061 tt1= - TP* r;
11062 tt2= tt1* tt1;
11063 rt= r2* r;
11064 er= cmplx( sin( tt1),- cos( tt1))*( CONST2* s);
11065 q1= cmplx( tt2-1., tt1)* er/ rt;
11066 q2= cmplx(3.- tt2,-3.* tt1)* er/( rt* r2);
11067 er = q2*( t1xj* rx+ t1yj* ry+ t1zr* rz);
11068 exk= q1* t1xj+ er* rx;
11069 eyk= q1* t1yj+ er* ry;
11070 ezk= q1* t1zr+ er* rz;
11071 er= q2*( t2xj* rx+ t2yj* ry+ t2zr* rz);
11072 exs= q1* t2xj+ er* rx;
11073 eys= q1* t2yj+ er* ry;
11074 ezs= q1* t2zr+ er* rz;
11075
11076 if( ipgnd == 1)
11077 return;
11078
11079 if( iperf == 1)
11080 {
11081 exk= - exk;
11082 eyk= - eyk;
11083 ezk= - ezk;
11084 exs= - exs;
11085 eys= - eys;
11086 ezs= - ezs;
11087 return;
11088 }
11089
11090 xymag= sqrt( rx* rx+ ry* ry);
11091 if( xymag <= 1.0e-6)
11092 {
11093 px=0.;
11094 py=0.;
11095 cth=1.;
11096 rrv=CPLX_10;
11097 }
11098 else
11099 {
11100 px= - ry/ xymag;
11101 py= rx/ xymag;
11102 cth= rz/ sqrt( xymag* xymag+ rz* rz);
11103 rrv= csqrt(1.- zrati* zrati*(1.- cth* cth));
11104 }
11105
11106 rrh= zrati* cth;
11107 rrh=( rrh- rrv)/( rrh+ rrv);
11108 rrv= zrati* rrv;
11109 rrv=-( cth- rrv)/( cth+ rrv);
11110 edp=( exk* px+ eyk* py)*( rrh- rrv);
11111 exk= exk* rrv+ edp* px;
11112 eyk= eyk* rrv+ edp* py;
11113 ezk= ezk* rrv;
11114 edp=( exs* px+ eys* py)*( rrh- rrv);
11115 exs= exs* rrv+ edp* px;
11116 eys= eys* rrv+ edp* py;
11117 ezs= ezs* rrv;
11118
11119 return;
11120 }
11121
11122 /*-----------------------------------------------------------------------*/
11123
11124 /* subroutine wire generates segment geometry */
11125 /* data for a straight wire of ns segments. */
wire(double xw1,double yw1,double zw1,double xw2,double yw2,double zw2,double rad,double rdel,double rrad,int ns,int itg)11126 void wire( double xw1, double yw1, double zw1,
11127 double xw2, double yw2, double zw2, double rad,
11128 double rdel, double rrad, int ns, int itg )
11129 {
11130 int ist, i, mreq;
11131 double xd, yd, zd, delz, rd, fns, radz;
11132 double xs1, ys1, zs1, xs2, ys2, zs2;
11133
11134 ist= n;
11135 n= n+ ns;
11136 np= n;
11137 mp= m;
11138 ipsym=0;
11139
11140 if( ns < 1)
11141 return;
11142
11143 /* Reallocate tags buffer */
11144 mem_realloc( (void *)&itag, (n+m) * sizeof(int) );/*????*/
11145
11146 /* Reallocate wire buffers */
11147 mreq = n * sizeof(double);
11148 mem_realloc( (void *)&x, mreq );
11149 mem_realloc( (void *)&y, mreq );
11150 mem_realloc( (void *)&z, mreq );
11151 mem_realloc( (void *)&x2, mreq );
11152 mem_realloc( (void *)&y2, mreq );
11153 mem_realloc( (void *)&z2, mreq );
11154 mem_realloc( (void *)&bi, mreq );
11155
11156 xd= xw2- xw1;
11157 yd= yw2- yw1;
11158 zd= zw2- zw1;
11159
11160 if( fabs( rdel-1.) >= 1.0e-6)
11161 {
11162 delz= sqrt( xd* xd+ yd* yd+ zd* zd);
11163 xd= xd/ delz;
11164 yd= yd/ delz;
11165 zd= zd/ delz;
11166 delz= delz*(1.- rdel)/(1.- pow(rdel, ns) );
11167 rd= rdel;
11168 }
11169 else
11170 {
11171 fns= ns;
11172 xd= xd/ fns;
11173 yd= yd/ fns;
11174 zd= zd/ fns;
11175 delz=1.;
11176 rd=1.;
11177 }
11178
11179 radz= rad;
11180 xs1= xw1;
11181 ys1= yw1;
11182 zs1= zw1;
11183
11184 for( i = ist; i < n; i++ )
11185 {
11186 itag[i]= itg;
11187 xs2= xs1+ xd* delz;
11188 ys2= ys1+ yd* delz;
11189 zs2= zs1+ zd* delz;
11190 x[i]= xs1;
11191 y[i]= ys1;
11192 z[i]= zs1;
11193 x2[i]= xs2;
11194 y2[i]= ys2;
11195 z2[i]= zs2;
11196 bi[i]= radz;
11197 delz= delz* rd;
11198 radz= radz* rrad;
11199 xs1= xs2;
11200 ys1= ys2;
11201 zs1= zs2;
11202 }
11203
11204 x2[n-1]= xw2;
11205 y2[n-1]= yw2;
11206 z2[n-1]= zw2;
11207
11208 return;
11209 }
11210
11211 /*-----------------------------------------------------------------------*/
11212
11213 /* zint computes the internal impedance of a circular wire */
zint(double sigl,double rolam)11214 complex double zint( double sigl, double rolam )
11215 {
11216 #define cc1 ( 6.0e-7 + 1.9e-6fj)
11217 #define cc2 (-3.4e-6 + 5.1e-6fj)
11218 #define cc3 (-2.52e-5 + 0.fj)
11219 #define cc4 (-9.06e-5 - 9.01e-5fj)
11220 #define cc5 ( 0. - 9.765e-4fj)
11221 #define cc6 (.0110486 - .0110485fj)
11222 #define cc7 ( 0. - .3926991fj)
11223 #define cc8 ( 1.6e-6 - 3.2e-6fj)
11224 #define cc9 ( 1.17e-5 - 2.4e-6fj)
11225 #define cc10 ( 3.46e-5 + 3.38e-5fj)
11226 #define cc11 ( 5.0e-7 + 2.452e-4fj)
11227 #define cc12 (-1.3813e-3 + 1.3811e-3fj)
11228 #define cc13 (-6.25001e-2 - 1.0e-7fj)
11229 #define cc14 (.7071068 + .7071068fj)
11230 #define cn cc14
11231
11232 #define th(d) ( (((((cc1*(d)+cc2)*(d)+cc3)*(d)+cc4)*(d)+cc5)*(d)+cc6)*(d) + cc7 )
11233 #define ph(d) ( (((((cc8*(d)+cc9)*(d)+cc10)*(d)+cc11)*(d)+cc12)*(d)+cc13)*(d)+cc14 )
11234 #define f(d) ( csqrt(POT/(d))*cexp(-cn*(d)+th(-8./x)) )
11235 #define g(d) ( cexp(cn*(d)+th(8./x))/csqrt(TP*(d)) )
11236
11237 double x, y, s, ber, bei;
11238 double tpcmu = 2.368705e+3;
11239 double cmotp = 60.00;
11240 complex double zint, br1, br2;
11241
11242 x= sqrt( tpcmu* sigl)* rolam;
11243 if( x <= 110.)
11244 {
11245 if( x <= 8.)
11246 {
11247 y= x/8.;
11248 y= y* y;
11249 s= y* y;
11250
11251 ber=((((((-9.01e-6* s+1.22552e-3)* s-.08349609)* s+ 2.6419140)*
11252 s-32.363456)* s+113.77778)* s-64.)* s+1.;
11253
11254 bei=((((((1.1346e-4* s-.01103667)* s+.52185615)* s-10.567658)*
11255 s+72.817777)* s-113.77778)* s+16.)* y;
11256
11257 br1= cmplx( ber, bei);
11258
11259 ber=(((((((-3.94e-6* s+4.5957e-4)* s-.02609253)* s+ .66047849)*
11260 s-6.0681481)* s+14.222222)* s-4.)* y)* x;
11261
11262 bei=((((((4.609e-5* s-3.79386e-3)* s+.14677204)* s- 2.3116751)*
11263 s+11.377778)* s-10.666667)* s+.5)* x;
11264
11265 br2= cmplx( ber, bei);
11266 br1= br1/ br2;
11267 zint= CPLX_01* sqrt( cmotp/sigl )* br1/ rolam;
11268
11269 return( zint );
11270
11271 } /* if( x <= 8.) */
11272
11273 br2= CPLX_01* f(x)/ PI;
11274 br1= g( x)+ br2;
11275 br2= g( x)* ph(8./ x)- br2* ph(-8./ x);
11276 br1= br1/ br2;
11277 zint= CPLX_01* sqrt( cmotp/ sigl)* br1/ rolam;
11278
11279 return( zint );
11280
11281 } /* if( x <= 110.) */
11282
11283 br1= cmplx(.70710678,-.70710678);
11284 zint= CPLX_01* sqrt( cmotp/ sigl)* br1/ rolam;
11285
11286 return( zint );
11287 }
11288
11289 /*-----------------------------------------------------------------------*/
11290
11291 /* returns smallest of two arguments */
min(int a,int b)11292 int min( int a, int b )
11293 {
11294 if( a < b )
11295 return(a);
11296 else
11297 return(b);
11298 }
11299
11300 /*-----------------------------------------------------------------------*/
11301
sig_handler(int signal)11302 static void sig_handler( int signal )
11303 {
11304 switch( signal )
11305 {
11306 case SIGINT :
11307 fprintf( stderr, "\n%s\n", "nec2c: exiting via user interrupt" );
11308 exit( signal );
11309
11310 case SIGSEGV :
11311 fprintf( stderr, "\n%s\n", "nec2c: segmentation fault" );
11312 exit( signal );
11313
11314 case SIGFPE :
11315 fprintf( stderr, "\n%s\n", "nec2c: floating point exception" );
11316 exit( signal );
11317
11318 case SIGABRT :
11319 fprintf( stderr, "\n%s\n", "nec2c: abort signal received" );
11320 exit( signal );
11321
11322 case SIGTERM :
11323 fprintf( stderr, "\n%s\n", "nec2c: termination request received" );
11324
11325 stop( signal );
11326 }
11327
11328 } /* end of sig_handler() */
11329
11330 /*------------------------------------------------------------------------*/
11331
11332