program monopole * * Program to calculate the normalized field of a monopole * on a circular ground plane using an idealized * current distribution on the monopole element and * Kouyoumijian's Uniform Theory of Diffraction (UTD). * Programmed from: * Antenna Engineering Handbook (Second Edition) * Richard C. Johnson and Henry Jasik * McGraw-Hill Book Company, 1984 * pages 4-27 to 4-30 * * Written by: Louis Wilson * Date: 12/26/93 * parameter(pi = 3.14159265, eta = 376.7, dtor = pi/180.0) parameter(n = 361, eps = 1e-12) complex j, ed1, ed2, e0, e00, fofx complex etotal(361) real kh, ka real angle(361), dbfld(361) real bessj1 * j = (0.,1.) * print*,'This program calculates the total field of a' print*,' monopole on a circular ground plane.' print*,'--------------------------------------------' print*,'' print*,'' print*,'Enter the ground plane radius (wavelengths) ' read(*,*)a print*,'Enter the monopole height(wavelengths) ' read(*,*)h * kh = 2.0*pi*h ka = 2.0*pi*a * do i = 1, 181 sign = 1.0 if(i - 1.lt.90) sign = -1.0 * theta = dtor*(i - 1) argb = ka*sin(theta) arg1 = argb - pi/4.0 arg2 = 2.0*sqrt(2.0*pi*ka*abs(sin(theta))) sec1 = 1.0/cos(pi/4.0 + theta/2.0) sec2 = 1.0/cos(pi/4.0 - theta/2.0) argofx = 2.0*ka*(cos(pi/4.0 + theta/2.0)**2) * if(argb.le.5.0)then ed1 = 0.353553*e00(a, h)*j*sign*bessj1(argb) $ *(1 + cexp(-j*(2.*ka - pi/4.0))/(2*sqrt(pi*ka))) ed1 = ed1 ed2 = ed1 else ed1 = -(e00(a, h)/arg2)*(fofx(argofx)*sec1*cexp(j*arg1) $ + sign*sec2*cexp(-j*arg1)) ed1 = ed1 ed2 = ed1*(cexp(-j*(2.*ka - pi/4.0)))/(2*sqrt(pi*ka)) endif etotal(i) = e0(h, theta) + ed1 + ed2 etotal(362 - i) = etotal(i) enddo do i = 1, n angle(i) = float(i - 1) dbfld(i) = 20*alog10(abs(etotal(i)) + eps) enddo call write_file(angle,dbfld,n) end *-------------------------------------------------------------------* subroutine write_file(a,b,n) real a(*),b(*) open(8,file='monopole.dat',status='unknown') call normal(b,n) do i = 1, n write(8,100)a(i), b(i) enddo close(8) 100 format(1x,f8.3,4x,f8.3) return end *-------------------------------------------------------------------* subroutine normal(x,n) real x(n) xmax = -999 do i = 1, n if(x(i).ge.xmax)xmax=x(i) end do do i=1,n x(i) = x(i) - xmax if(x(i).lt.-999) x(i) = -999 end do return end *-------------------------------------------------------------------* complex function fofx(xf) * * This function computes the wedge transition function * by linear interpolation. Can be found in a number of * references (Antenna Theory by Stutzman and Thiele, * Antenna Theory by C. Balanis, etc...). * Origin: Probably OSU. * complex fxx(8),fx(8),j dimension xx(8) data xx/0.3, 0.5, 0.7, 1.0, 1.5, 2.3, 4.0, 5.5/ data j/(0.0, 1.0)/ data fx/(0.5729, 0.2677), (0.6768, 0.2682), (0.7439, 0.2549), $ (0.8095, 0.2322), (0.873, 0.1982), (0.9240, 0.1577), $ (0.9658, 0.1073), (0.9797, 0.0828)/ data fxx/(0.0, 0.0), (0.5195, 0.0025), (0.3355, -0.0665), $ (0.2187, -0.0757), (0.127, -0.068), (0.0638, -0.0506), $ (0.0246,-0.0296), (0.0093,-0.0163)/ x = abs(xf) if(x.gt.5.5) then fofx = 1.0 + cmplx(-0.75/x, 0.5)/x elseif(x.gt.0.3) then do n = 2, 7 if(x.lt.xx(n)) goto 1 enddo 1 fofx=fxx(n)*(x - xx(n)) + fx(n) else fofx = ( (1.253, 1.253)*sqrt(x) - (0.0, 2.0)*x $ - 0.6667*x*x)*cexp(j*x) endif if(xf.ge.0.) return fofx = conjg(fofx) return end *---------------------------------------------------------------------* complex function e0(h, theta) parameter(pi = 3.14159265, eta = 376.7) complex j real kh j = (0.0, 1.0) kh = 2.0*pi*h if (theta.lt.pi/2.0) then if (theta.eq.0)then C = 0. else C = (cos(kh*cos(theta)) - cos(kh))/sin(theta) endif e0 = j*eta*C/(2.0*pi*sin(kh)) else e0 = (0.0, 0.0) endif return end *---------------------------------------------------------------------* complex function e00(a, h) parameter(pi = 3.14159265, eta = 376.7) complex j real ka, kh kh = 2.0*pi*h ka = 2.0*pi*a j = (0.0, 1.0) e00 = (j*eta*cexp(-j*ka)*(1 - cos(kh)))/(2.0*pi*sin(kh)) return end *----------------------------------------------------------------------* function bessj1(X) * * Function to compute the Bessel Function * J1 as a function of X. Uses polynomial * approximation from HMF - Abramowitz and Stegun * Written by : Louis Wilson * data c1,c2,c3,c4,c5,c6 $ /0.56249985, 0.21093573, 0.03954289, $ 0.00443319, 0.00031716, 0.00001109/ data f1,f2,f3,f4,f5,f6,f7 $ /0.79788456, 0.00000156, 0.01659667, $ 0.00017105, 0.00249511, 0.00113653, 0.00020033/ data t1,t2,t3,t4,t5,t6,t7 $ /2.35619449, 0.12499612, 0.00005650, $ 0.00637879, 0.00074348, 0.00079824, 0.00029166/ * if(abs(x).lt.3)then x3 = x/3 bessj1 = x*(0.5 - c1*x3**2 + c2*x3**4 - c3*x3**6 $ + c4*x3**8 - c5*x3**10 + c6*x3**12) else x3 = 3/x func = f1 + f2*x3 + f3*x3**2 + f4*x3**3 $ - f5*x3**4 + f6*x3**5 - f7*x3**6 theta = x - t1 + t2*x3 + t3*x3**2 - t4*x3**3 $ + t5*x3**4 + t6*x3**5 - t7*x3**6 bessj1 = (1./sqrt(abs(x)))*func*cos(theta) endif return end