PROGRAM RXM TST C This program tests the coefficients of RXM against the asymptotic C results. DOUBLE PRECISION RXMCOF(0:45450) DOUBLE PRECISION DLAMDA(5),RXMCOF INTEGER IBETA DOUBLE PRECISION XL,XLP1,XL13,G1,G2,G3,G1SUM,G2SUM,G3SUM DOUBLE PRECISION ZL,COEF,TEST1,TEST2,TEST3 CHARACTER*4 ID INTEGER I,J,ISTEP,IQ,MMIN,MMAX,M,NM,K DATA DLAMDA/1.0D0,0.5D0,0.125D0,.0625D0,2.0D0/ C WRITE(6,10) 10 FORMAT(1X,'TESTING ASYMPTOTIC EXPRESSIONS FOR COEFFICIENTS OF XM') OPEN(1,FILE='rxm300.dat',STATUS='OLD') READ(1,15) ID,MAXS 15 FORMAT(A4,I5) IF(ID.NE.' RXM') THEN WRITE(6,25) 25 FORMAT(1X,'WRONG COEFFICIENTS FOR RXM') STOP ENDIF READ(1,30)RXMCOF 30 FORMAT(D22.16) CLOSE(1) DO 1200 J=1,5 C The following loop calculates the odd and even powers in the series. DO 1200 IBETA=1,2 IF (IBETA.EQ.1) THEN WRITE(6,1000)DLAMDA(J) 1000 FORMAT(/1X,'LAMBDA =',F8.3) WRITE(6,90) 90 FORMAT(/1X,'VALUES OF EVEN TERMS IN SERIES') WRITE(6,100) 100 FORMAT(/30X,'M*(COEF-G1)',12X,'(M+2)*(T1-2*G2)' & /2X,'M',6X,'COEF',9X,'G1',9X,'= T1', & 9X,'2*G2',7X,'= T2',9X,'T2+4*G3') ELSE WRITE(6,110) 110 FORMAT(/1X,'VALUES OF ODD TERMS IN SERIES') WRITE(6,100) ENDIF C IF(DLAMDA(J).GT.1D0) THEN I=2 K=3-IBETA XL=1D0/DLAMDA(J) ELSE I=1 K=IBETA XL=DLAMDA(J) ENDIF XLP1=XL+1D0 XL13=XLP1**3 IF(I.EQ.K) THEN IF(I.EQ.1) THEN G1=6D0*XL**2/(5D0*XL13) G2=3D0*(XL+17D0*XL**2-9D0*XL**3)/(25D0*XL13) G3=(5D0+272D0*XL-831D0*XL**2+1322D0*XL**3-415D0*XL**4) & /(350D0*XL13) ISTEP=1 ELSE G1=6D0*XL/(5D0*XL13) G2=3D0*(XL**2+17D0*XL-9D0)/(25D0*XL13) G3=(5D0*XL**4+272D0*XL**3-831D0*XL**2+1322D0*XL-415D0) & /(350D0*XL*XL13) ISTEP=-1 ENDIF MMIN=150 MMAX=MAXS ELSE IF(I.EQ.1) THEN G1=6D0*XL**3/(5D0*XL13) G2=3D0*(-4D0*XL**2+17D0*XL**3-4D0*XL**4)/(25D0*XL13) G3=(-65D0*XL+832D0*XL**2-1041D0*XL**3+832D0*XL**4 & -65D0*XL**5)/(350D0*XL13) ELSE C It might seem that a factor of XL**3 is missing here, but it is C supplied in the RXM program separately. Another way to see it C is to examine (47b) in Jeffrey (1992) G1=6D0/(5D0*XL13) G2=3D0*(-4D0*XL**2+17D0*XL-4D0)/(25D0*XL*XL13) G3=(-65D0+832D0*XL-1041D0*XL**2+832D0*XL**3-65D0*XL**4) & /(350D0*XL*XL*XL13) ENDIF MMIN=149 MMAX=MAXS-1 ENDIF G1SUM=G1 G2SUM=2D0*G2 G3SUM=4D0*G3 DO 1200 M=MMIN,MMAX,2 IF (ISTEP.GT.0) THEN NM = (M*(M+1))/2 ELSE NM = (M*(M+1))/2 +M ENDIF ZL=XLP1**(-M) COEF=0D0 DO 150 IQ=0,M COEF=COEF+RXMCOF(NM)*ZL NM=NM+ISTEP ZL=ZL*XL 150 CONTINUE TEST1=DBLE(M)*(COEF-G1SUM) TEST2=DBLE(M+2)*(TEST1-G2SUM) TEST3=TEST2+G3SUM WRITE(6,60) M,COEF,G1SUM,TEST1,G2SUM,TEST2,TEST3 60 FORMAT(1X,I3,4D12.3,2D13.4) 1200 CONTINUE STOP END C BLOCK DATA TSTINI DOUBLE PRECISION RXMCOF COMMON /XMD300/RXMCOF(0:45450) DATA RXMCOF(1)/0D0/ END