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