PROGRAM RXQ TST C This program tests the coefficients of RXQ against the asymptotic C results. DOUBLE PRECISION DLAMDA(5),RXQCOF(0:45450) INTEGER IBETA DOUBLE PRECISION XL,XLP1,XL13,G1,G2,G3,G1SUM,G2SUM,G3SUM DOUBLE PRECISION ZL,COEF,TEST1,TEST2,TEST3 INTEGER I,J,ISTEP,IQ,MMIN,MMAX,M,NM,K CHARACTER*4 ID DATA DLAMDA/1.0D0,0.5D0,0.125D0,3D0,2.0D0/ WRITE(6,10) 10 FORMAT(1X,'TESTING ASYMPTOTIC EXPRESSIONS FOR COEFFICIENTS OF XQ') OPEN(1,FILE='rxq300.dat',STATUS='OLD') READ(1,15) ID,MAXS 15 FORMAT(A4,I5) IF(ID.NE.' RXQ') THEN WRITE(6,25) 25 FORMAT(1X,'WRONG COEFFICIENTS FOR RXQ') STOP ENDIF READ(1,30)RXQCOF 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 C this means lambda <1 and i=k=1. ie xq11, ie even G1=3D0*XL**2/(2D0*XL13) G2=3D0*(XL+2D0*XL**2-9D0*XL**3)/(20D0*XL13) G3=(5D0-XL-201D0*XL**2+251D0*XL**3-184D0*XL**4) & /(280D0*XL13) ISTEP=1 ELSE C this means lambda >1 and i=k=1. ie xq22, ie even G1=3D0*XL/(2D0*XL13) G2=3D0*(XL**2+2D0*XL-9D0)/(20D0*XL13) G3=(5D0*XL**4-XL**3-201D0*XL**2+251D0*XL-184D0) & /(280D0*XL*XL13) ISTEP=-1 ENDIF MMIN=150 MMAX=MAXS ELSE IF(I.EQ.1) THEN C this means lambda <1 and i<>k. ie xq12, ie odd G1=3D0*XL**3/(2D0*XL13) G2=3D0*(-2D0*XL**2+1D0*XL**3-2D0*XL**4)/(10D0*XL13) G3=(-65D0*XL+34D0*XL**2-411D0*XL**3+76D0*XL**4 & -44D0*XL**5)/(280D0*XL13) ISTEP=1 ELSE C this means lambda >1 and i<>k. ie xq21, ie odd G1=3D0/(2D0*XL13) G2=3D0*(-2D0*XL**2+1D0*XL-2D0)/(10D0*xl*XL13) G3=(-65D0*XL**4+34D0*XL**3-411D0*XL**2+76D0*XL & -44D0)/(280D0*XL13*xl**2) ISTEP=-1 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+RXQCOF(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 RXQCOF COMMON /XQD300/RXQCOF(0:45450) DATA RXQCOF(1)/0D0/ END