      program main

c*********************************************************************72
c
cc toms683_test() tests toms683().
c
C      ALGORITHM 683, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 16, NO. 2, PP. 178-182.
C
      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'toms663_test():'
      write ( *, '(a)' ) '  Fortran77 version.'
      write ( *, '(a)' ) '  Test toms663()'

      call cqccex ( )
      call zqccex ( )

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'toms663_test():'
      write ( *, '(a)' ) '  Normal end of execution.'
      stop
      end
      subroutine cqccex ( )

c*********************************************************************72
c
C     BEFORE THIS PROGRAM CAN BE EXECUTED, YOUR MACHINE MUST BE DEFINED
C     IN SUBROUTINES I1MACH AND R1MACH.
C
C     CQCCEX IS A QUICK CHECK PROGRAM TO COMPARE EXPONENTIAL INTEGRALS
C     E(N,Z) FROM SUBROUTINE CEXINT,
C
C               CALL CEXINT(Z,N,KODE,TOL,M,CY,IERR)
C
C     AGAINST EXPONENTIAL INTEGRALS FROM QUADRATURE SUBROUTINE CEXQAD,
C
C               CALL CEXQAD(Z,N,KODE,TOL,CQ,KERR).
C
C     Z VALUES ARE TAKEN FROM THE REGION -6.5.LE.X.LE.5.5,-6.LE.Y.LE.6.
C     ORDERS N RUN FROM 3 TO 11 AND THE NUMBER OF MEMBERS M IN THE
C     SEQUENCE E(N+K-1,Z), K=1,M RUNS FROM 1 TO 3. BOTH SCALING OPTIONS
C
C                CY(K) = E(N+K-1,Z)                K=1,M     KODE=1
C                        E(N+K-1,Z)*CEXP(Z)        K=1,M     KODE=2
C
C     ARE CHECKED AND THE REQUESTED ACCURACY TOL IS THE LARGER OF
C     UNIT ROUNDOFF AND 1.0E-7. RELATIVE ERRORS ERR1 AND ERR2 FOR THE
C     FIRST AND LAST MEMBERS OF THE SEQUENCE ARE COMPUTED AND COMPARED
C     AGAINST 100.0*TOL. IF A CHECK DOES NOT OCCUR, Z,ERR1,ERR2,N,M,KODE
C     AND ERROR FLAGS IERR FROM CEXINT, KERR1 FROM CEXQAD, AND KERR2
C     FROM CEXQAD ARE PRINTED. VALUES CY(1),CQ1 AND CY(N+M-1),CQ2 WHICH
C     WERE COMPARED IN ERR1 AND ERR2 ARE PRINTED NEXT. KERR1.NE.0 OR
C     KERR2.NE.0 INDICATE A PREMATURE TRUNCATION OF THE INTEGRAL EVAL-
C     UATION IN CEXQAD. THE SUFFIXES 1 AND 2 CORRESPOND TO EVALUATIONS
C     AT ORDERS N AND N+M-1 RESPECTIVELY.
C
C     CQCCEX CALLS CEXINT,CEXQAD AND LOWER LEVEL ROUTINES CEXENZ,CACEXI,
C     PSIXN,CEXQAD,GAUS8,FQCEX,I1MACH,R1MACH,XERROR,FDUMP
C
      COMPLEX Z,CY(10),CQ1,CQ2

      IPRNT = 0
      TOL=AMAX1(1.0E-7,R1MACH(4))
      XTOL=TOL*100.0E0
      PRINT 700
  700 FORMAT(' CEXINT VS QUADRATURE FOR PARAMETERS:'/)
      PRINT 701
  701 FORMAT('  KODE   M     N       Y        -6.5.LE.X.LE.5.5')
      DO 10 KODE=1,2
        DO 20 M=1,3
          DO 30 N=3,11,2
            DO 40 IY=1,13,3
              Y=-6.0E0+FLOAT(IY-1)
              PRINT 702,KODE,M,N,Y
  702         FORMAT(I5,I5,I5,E13.5)
              DO 50 IX=2,14,4
                X=-7.5E0+FLOAT(IX-1)
                IF(Y.EQ.0.0E0 .AND. X.LE.0.0E0) GO TO 50
                Z=CMPLX(X,Y)
                CALL CEXINT(Z,N,KODE,TOL,M,CY,IERR)
                NB=N
                CALL CEXQAD(Z,NB,KODE,TOL,CQ1,KERR1)
                ERR1=CABS(CY(1)-CQ1)/CABS(CQ1)
                NB=N+M-1
                CALL CEXQAD(Z,NB,KODE,TOL,CQ2,KERR2)
                ERR2=CABS(CY(M)-CQ2)/CABS(CQ2)
                IF(ERR1.LT.XTOL.AND.ERR2.LT.XTOL) GO TO 45
                IF(IPRNT.EQ.1) GO TO 42
                IPRNT=1
                OPEN (7,FILE='CEXDAT7',STATUS='UNKNOWN')
                WRITE(7,800)
  800           FORMAT(' Z,ERR1,ERR2,N,M,KODE,IERR,KERR1,KERR2')
   42           CONTINUE
                WRITE(7,900) Z,ERR1,ERR2,N,M,KODE,IERR,KERR1,KERR2
                WRITE(7,900) CY(1),CQ1
                WRITE(7,900) CY(M),CQ2
  900           FORMAT(4E11.3,6I5)
   45           CONTINUE
   50         CONTINUE
   40       CONTINUE
   30     CONTINUE
   20   CONTINUE
   10 CONTINUE
      IF(IPRNT.NE.0) GO TO 60
      PRINT 950
  950 FORMAT(/' QUICK CHECKS FOR CEXINT ARE OK.')
      GO TO 70
   60 CONTINUE
      PRINT 951
  951 FORMAT(/' SEE DATA FILE CEXDAT7 FOR ERRORS')
   70 CONTINUE
      return
      END
      subroutine ZQCCEX ( )

c*********************************************************************72
c
C     BEFORE THIS PROGRAM CAN BE EXECUTED, YOUR MACHINE MUST BE DEFINED
C     IN SUBROUTINES I1MACH AND D1MACH.
C
C     ZQCCEX IS A QUICK CHECK PROGRAM TO COMPARE EXPONENTIAL INTEGRALS
C     E(N,Z) FROM SUBROUTINE ZEXINT,
C
C               CALL ZEXINT(ZR,ZI,N,KODE,TOL,M,CYR,CYI,IERR)
C
C     AGAINST EXPONENTIAL INTEGRALS FROM QUADRATURE SUBROUTINE ZEXQAD,
C
C               CALL ZEXQAD(ZR,ZI,N,KODE,TOL,CQR,CQI,KERR)
C
C     WHERE A COMPLEX NUMBER Z=(ZR,ZI) IS CARRIED AS A DOUBLE PRECISION
C     ORDERED PAIR, ZR,ZI.
C
C     Z VALUES ARE TAKEN FROM THE REGION -6.5.LE.X.LT.5.5,-6.LE.Y.LE.6.
C     ORDERS N RUN FROM 3 TO 11 AND THE NUMBER OF MEMBERS M IN THE
C     SEQUENCE E(N+K-1,Z), K=1,M RUNS FROM 1 TO 3. BOTH SCALING OPTIONS
C
C                CY(K) = E(N+K-1,Z)                K=1,M     KODE=1
C                        E(N+K-1,Z)*CEXP(Z)        K=1,M     KODE=2
C
C     ARE CHECKED AND THE REQUESTED ACCURACY TOL IS THE LARGER OF
C     UNIT ROUNDOFF AND 1.0D-9. RELATIVE ERRORS ERR1 AND ERR2 FOR THE
C     FIRST AND LAST MEMBERS OF THE SEQUENCE ARE COMPUTED AND COMPARED
C     AGAINST 100.0*TOL. IF A CHECK DOES NOT OCCUR, Z,ERR1,ERR2,N,M,KODE
C     AND ERROR FLAGS IERR FROM ZEXINT, KERR1 FROM ZEXQAD, AND KERR2
C     FROM ZEXQAD ARE PRINTED. VALUES CY(1),CQ1 AND CY(N+M-1),CQ2 WHICH
C     WERE COMPARED IN ERR1 AND ERR2 ARE PRINTED NEXT. KERR1.NE.0 OR
C     KERR2.NE.0 INDICATE A PREMATURE TRUNCATION OF THE INTEGRAL EVAL-
C     UATION IN ZEXQAD. THE SUFFIXES 1 AND 2 CORRESPOND TO EVALUATIONS
C     AT ORDERS N AND N+M-1 RESPECTIVELY.
C
C     CQCCEX CALLS ZEXINT,ZEXQAD AND LOWER LEVEL ROUTINES ZEXENZ,ZACEXI,
C     DPSIXN,ZEXQAD,DGAUS8,DFQCEX,ZMLT,ZDIV,ZSQRT,ZLOG,ZEXP,zabs2,I1MACH,
C     D1MACH,XERROR,FDUMP
C
C     THE CORRESPONDING SINGLE PRECISION COMPLEX VARIABLES IN CQCCEX
C     ARE:
C     COMPLEX Z,CY(10),CQ1,CQ2
      EXTERNAL zabs2
      DOUBLE PRECISION ZR,ZI,CYR(10),CYI(10),CQ1R,CQ1I,CQ2R,CQ2I,
     * TOL,XTOL,ERR1R,ERR1I,ERR2R,ERR2I,ERR1,ERR2,D1MACH,zabs2
      IPRNT = 0
      TOL=DMAX1(1.0D-9,D1MACH(4))
      XTOL=TOL*100.0D0
      PRINT 700
  700 FORMAT(' ZEXINT VS QUADRATURE FOR PARAMETERS:'/)
      PRINT 701
  701 FORMAT('  KODE   M    N       Y        -6.5.LE.X.LE.5.5')
      DO 10 KODE=1,2
        DO 20 M=1,3
          DO 30 N=3,11,2
            DO 40 IY=1,13,3
              ZI=-6.0D0+DBLE(FLOAT(IY-1))
              PRINT 702,KODE,M,N,ZI
  702         FORMAT(I5,I5,I5,E13.5)
              DO 50 IX=2,14,4
                ZR=-7.5D0+DBLE(FLOAT(IX-1))
                IF(ZI.EQ.0.0D0 .AND. ZR.LE.0.0D0) GO TO 50
                CALL ZEXINT(ZR,ZI,N,KODE,TOL,M,CYR,CYI,IERR)
                NB=N
                CALL ZEXQAD(ZR,ZI,NB,KODE,TOL,CQ1R,CQ1I,KERR1)
                ERR1R=CYR(1)-CQ1R
                ERR1I=CYI(1)-CQ1I
                ERR1=zabs2(ERR1R,ERR1I)/zabs2(CQ1R,CQ1I)
                NB=N+M-1
                CALL ZEXQAD(ZR,ZI,NB,KODE,TOL,CQ2R,CQ2I,KERR2)
                ERR2R=CYR(M)-CQ2R
                ERR2I=CYI(M)-CQ2I
                ERR2=zabs2(ERR2R,ERR2I)/zabs2(CQ2R,CQ2I)
                IF(ERR1.LT.XTOL.AND.ERR2.LT.XTOL) GO TO 45
                IF(IPRNT.EQ.1) GO TO 42
                IPRNT=1
                OPEN (7,FILE='ZEXDAT7',STATUS='UNKNOWN')
                WRITE(7,800)
  800           FORMAT(' ZR,ZI,ERR1,ERR2,N,M,KODE,IERR,KERR1,KERR2')
   42           CONTINUE
                WRITE(7,900) ZR,ZI,ERR1,ERR2,N,M,KODE,IERR,KERR1,KERR2
                WRITE(7,900) CYR(1),CYI(1),CQ1R,CQ1I
                WRITE(7,900) CYR(M),CYI(M),CQ2R,CQ2I
  900           FORMAT(4D11.3,6I5)
   45           CONTINUE
   50         CONTINUE
   40       CONTINUE
   30     CONTINUE
   20   CONTINUE
   10 CONTINUE
      IF(IPRNT.NE.0) GO TO 60
      PRINT 950
  950 FORMAT(/' QUICK CHECKS FOR ZEXINT ARE OK.')
      GO TO 70
   60 CONTINUE
      PRINT 951
  951 FORMAT(/' SEE DATA FILE ZEXDAT7 FOR ERRORS')
   70 CONTINUE
      return
      END
