program DRDELI c>>1994-10-19 DRDELI Krogh Changes to use M77CON c>>1992-03-09 DRDELI WV Snyder Create separate single and double demos. c>>1991-10-04 DRDELI WV Snyder JPL Original code. c--D replaces "?": DR?ELI,?RCVAL,?ELEFI,?ELPII,?RDVAL,?RFVAL,?RJVAL c c Demonstration driver for incomplete elliptic integral procedures. c double precision ALPHA2, E, F, K, K2, PHI, PI, R, RC, RD, RF, RJ double precision SINPHI, T, U, X, Y, Z integer IERR c c Compute arc sine x using ASIN and RC, for x = 0.5 c print *, 'Identities from write-up:' x = 0.5d0 call drcval (1.0d0-x*x,1.0d0,rc,ierr) if (ierr.eq.0) then t = asin(x) - x * rc print '('' ASIN(0.5) - 0.5*RC(1-0.5**2,1) ='',g15.8)', t else print '('' DRCVAL returns error signal '',i1)', ierr end if c c Evaluate identities given by equations (8-10) in the write-up c with k**2 = 1/2, sin(phi)**2 = 1/4, alpha**2 = 1/2, c = 1. c From this, we have a = 3/4, b = r = 7/8. c alpha2 = 0.5d0 k = sqrt(0.5d0) k2 = 0.5d0 sinphi = 0.5d0 phi = asin(sinphi) r = 0.875d0 x = 0.75d0 y = 0.875d0 z = 1.0d0 call delefi (phi,k,f,e,ierr) if (ierr.ne.0) then print '('' DELEFI returns error signal '',i1)', ierr go to 99 end if call delpii (phi,k2,alpha2,pi,ierr) if (ierr.ne.0) then print '('' DELPII returns error signal '',i1)', ierr go to 99 end if call drdval (x,y,z,rd,ierr) if (ierr.ne.0) then print '('' DRDVAL returns error signal '',i1)', ierr go to 99 end if call drfval (x,y,z,rf,ierr) if (ierr.ne.0) then print '('' DRFVAL returns error signal '',i1)', ierr go to 99 end if call drjval (x,y,z,r,rj,ierr) if (ierr.ne.0) then print '('' DRJVAL returns error signal '',i1)', ierr go to 99 end if u = sqrt(z**3) * rd t = 3.0d0 / (k2 * sinphi**3) * (f-e) r = (u-t) / u print '('' Equation (8), (LHS - RHS)/LHS ='',g15.8)', r u = sqrt(z) * rf t = f / sinphi r = (u-t) / u print '('' Equation (9), (LHS - RHS)/LHS ='',g15.8)', r u = sqrt(z**3) * rj t = 3 / (alpha2 * sinphi**3) * (pi - f) r = (u-t) / u print '('' Equation (10), (LHS - RHS)/LHS ='',g15.8)', r c 99 stop end