C     Fx compiler version 2.0
CC    TEMPLATE t(512)
CC    ALIGN a(I,J,K) WITH t(K)
CC    ALIGN b(I,J,K) WITH t(K)
CC    DISTRIBUTE t(BLOCK(4))
C     commtime = 0.
C     rtime = 0.
C     ctime = 0.
C     CALL fx_sync()
C     CALL dgen(b)
C     CALL gen_bit_reverse_table(brt)
C     CALL gen_w_table(w)
C     DO k = 0, 2, 1
C     CALL dgen(b)
C     WRITE (unit=6,fmt=*) 'iteration ',k
C     CALL timer_start()
C     CALL cffts(b,brt,w)
C     rtime = (rtime + timer_stop())
C     CALL timer_start()
C     IDXPERM(a,3,1,2) = IDXPERM(b,2,1,3)
C     commtime = (commtime + timer_stop())
C     CALL timer_start()
C     CALL cffts(a,brt,w)
C     ctime = (ctime + timer_stop())
C     IF (k.EQ.0) THEN
C     CALL chkmat(a)
C     commtime = 0.
C     rtime = 0.
C     ctime = 0.
C     ENDIF
C     ENDDO
C     rtime = (rtime / 2)
C     ctime = (ctime / 2)
C     commtime = (commtime / 2)
C     CALL prperf((rtime + ctime),commtime,512,9)
C     END
      PROGRAM main
      INTEGER fxprocessor
      EXTERNAL dgen
      INTEGER fxrlast2
      INTEGER fxcellid
      INTEGER fxop
      REAL commtime
      EXTERNAL fxcomord
      INTEGER fxbufdataidx
      INTEGER fxpl2
      INTEGER fxbufoff0
      INTEGER k
      EXTERNAL fx_procstart
      INTEGER fxlmlast2
      REAL ctime
      EXTERNAL cffts
      REAL rtime
      EXTERNAL fx_deinit
      EXTERNAL fxreceive
      INTEGER fxdistarg
      INTEGER fxrcc2
      EXTERNAL gen_bit_reverse_table
      EXTERNAL chkmat
      EXTERNAL getarg
      EXTERNAL fxsend
      EXTERNAL msg_reduce
      EXTERNAL prperf
      INTEGER fxfrom
      EXTERNAL fxinitdesc
      EXTERNAL fxlr_initd
      CHARACTER*256 fx_executable_name
      EXTERNAL timer_stop
      REAL timer_stop
      INTEGER fxindextmp
      EXTERNAL ifxshould_received
      INTEGER ifxshould_received
      EXTERNAL gen_w_table
      EXTERNAL fx_init
      INTEGER fxidiotic3_0
      REAL fxidiotic4_0
      EXTERNAL fx_sync
      EXTERNAL fxallocinit
      INTEGER fxallocinit
      EXTERNAL timer_start
      INTEGER fxslice0
      INTEGER fxslice1
      INTEGER fxslice2
      INTEGER fxbuffer(1)
      REAL a(2,512,128)
      REAL b(2,512,128)
      REAL w(2,256)
      COMPLEX fxcbuffer(1)
      DOUBLE PRECISION fxdbuffer(1)
      LOGICAL fxlbuffer(1)
      REAL fxrbuffer(1)
      DOUBLE COMPLEX fxdcbuffer(1)
      INTEGER fxreceived(4)
      INTEGER brt(512)
      INTEGER fxadesc(71,3)
      INTEGER fxbdesc(71,3)
      INTEGER fxdistarray(6,20)
      EQUIVALENCE (fxbuffer,fxrbuffer)
      EQUIVALENCE (fxbuffer,fxlbuffer)
      EQUIVALENCE (fxbuffer,fxdbuffer)
      EQUIVALENCE (fxbuffer,fxcbuffer)
      EQUIVALENCE (fxbuffer,fxdcbuffer)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL getarg(0,fx_executable_name)
      CALL fx_init(fxcellid,1,0,0,0,4,fx_executable_name)
      fxdistarg = 0
      fxbufoff0 = fxallocinit(fxbuffer,131076)
C     TEMPLATE t(512)
C     ALIGN a(I,J,K) WITH t(K)
C     ALIGN b(I,J,K) WITH t(K)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 3
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 128
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      CALL fxinitdesc(1,3,fxdistarray,fxbdesc)
      fxdistarray(1,1) = 3
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 128
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      CALL fxinitdesc(1,3,fxdistarray,fxadesc)
      commtime = 0.
      rtime = 0.
      ctime = 0.
      CALL fx_sync()
      fxdistarg = 1
      CALL dgen(b,fxbdesc)
      CALL gen_bit_reverse_table(brt)
      CALL gen_w_table(w)
      DO k = 0, 2, 1
        fxdistarg = 1
        CALL dgen(b,fxbdesc)
        IF (fxcellid.EQ.0) THEN
          WRITE (unit=6,fmt=*) 'iteration ',k
        ENDIF
        CALL timer_start()
        fxdistarg = 1
        CALL cffts(b,brt,w,fxbdesc,(-1),(-1))
        rtime = (rtime + timer_stop())
        CALL timer_start()
        CALL fx_sync()
        DO fxindextmp = 1, 4, 1
          fxreceived(fxindextmp) = 0
        ENDDO
        DO fxindextmp = 1, 8, 1
          CALL fxcomord(fxprocessor,fxop,fxindextmp)
          IF (fxop.EQ.0) THEN
            fxbuffer((fxbufoff0 + 1)) = fxcellid
            fxbufdataidx = 2
            DO fxslice0 = MAX(fxadesc((fxprocessor + 8),3),1), (MIN((
     $fxadesc((fxprocessor + 8),3) + 127),512)), 1
              DO fxslice1 = 1, 2, 1
                DO fxslice2 = 1, 128, 1
                  fxrbuffer((fxbufoff0 + fxbufdataidx)) = b(fxslice1,
     $fxslice0,fxslice2)
                  fxbufdataidx = (fxbufdataidx + 1)
                ENDDO
              ENDDO
            ENDDO
            IF (fxbufdataidx.GT.2) THEN
              CALL fxsend(fxprocessor,fxbuffer((fxbufoff0 + 1)),(
     $fxbufdataidx + (-1)))
            ENDIF
          ELSE
            IF (fxreceived((fxprocessor + 1)).EQ.0) THEN
              IF (ifxshould_received(fxprocessor,1,1,fxadesc((
     $fxcellid + 8),2),fxbdesc((fxprocessor + 8),3),512,1,1,512,128,1
     $).NE.0) THEN
99999           IF (fxprocessor.NE.fxcellid) THEN
                  CALL fxreceive(fxbuffer((fxbufoff0 + 1)),
     $fxprocessor)
                ENDIF
                fxfrom = fxbuffer((fxbufoff0 + 1))
                fxbufdataidx = 2
                CALL fxlr_initd(131136,fxrlast2,fxlmlast2,fxrcc2,1,1,
     $512,128,512,1,1,fxadesc((fxcellid + 8),2),fxbdesc((fxfrom + 8),
     $3),fxpl2)
                DO fxslice0 = 1, 128, 1
                  DO fxslice1 = 1, 2, 1
                    DO fxslice2 = fxpl2, fxlmlast2, 1
                      a(fxslice1,fxslice2,fxslice0) = fxrbuffer((
     $fxbufoff0 + fxbufdataidx))
                      fxbufdataidx = (fxbufdataidx + 1)
                    ENDDO
                  ENDDO
                ENDDO
                fxreceived((fxfrom + 1)) = 1
                IF (fxfrom.NE.fxprocessor) THEN
                  GOTO 99999 
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDDO
        commtime = (commtime + timer_stop())
        CALL timer_start()
        fxdistarg = 1
        CALL cffts(a,brt,w,fxadesc,(-1),(-1))
        ctime = (ctime + timer_stop())
        IF (k.EQ.0) THEN
          fxdistarg = 1
          CALL chkmat(a,fxadesc)
          commtime = 0.
          rtime = 0.
          ctime = 0.
        ENDIF
      ENDDO
      rtime = (rtime / 2)
      ctime = (ctime / 2)
      commtime = (commtime / 2)
      CALL prperf((rtime + ctime),commtime,512,9)
      CALL fx_deinit()
      END
CC    TEMPLATE t(512)
CC    ALIGN a(I,J,K) WITH t(K)
CC    DISTRIBUTE t(BLOCK(4))
C     a = 0.
C     a(1,257,257) = 512.
C     a(2,257,257) = 512.
C     END
      SUBROUTINE dgen(a,fxadesc)
      INTEGER fxindex1
      INTEGER fxindex2
      INTEGER fxindex3
      INTEGER fxfirst0
      INTEGER fxfirst1
      INTEGER fxfirst2
      INTEGER fxcellid
      INTEGER fxcc0
      INTEGER fxcc1
      INTEGER fxcc2
      EXTERNAL fxinitdescck
      EXTERNAL fx_procstart
      INTEGER fxstride0
      INTEGER fxstride1
      INTEGER fxlmlast0
      INTEGER fxlmlast1
      INTEGER fxstride2
      INTEGER fxlmlast2
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      INTEGER fxlmfirst0
      INTEGER fxlmfirst1
      INTEGER fxlmfirst2
      EXTERNAL msg_reduce
      EXTERNAL fxcl_inita
      INTEGER fxlast0
      INTEGER fxlast1
      INTEGER fxlast2
      INTEGER fxlmstride0
      INTEGER fxlmstride1
      INTEGER fxlmstride2
      EXTERNAL fxdistcheck
      EXTERNAL ifxowns
      INTEGER ifxowns
      REAL a(2,512,128)
      INTEGER fxadesc(71,3)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'dgen')
      fxdistarg = 0
      CALL fxdistcheck(fxadesc,1,1,'dgen')
C     TEMPLATE t(512)
C     ALIGN a(I,J,K) WITH t(K)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 3
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 128
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      CALL fxinitdescck(1,3,fxdistarray,fxadesc,'a','dgen')
      CALL fxcl_inita(0,1,1,fxlast0,fxlmlast0,fxcc0,1,fxadesc((
     $fxcellid + 8),1),2,1,2,fxfirst0,fxlmfirst0)
      CALL fxcl_inita(0,1,1,fxlast1,fxlmlast1,fxcc1,1,fxadesc((
     $fxcellid + 8),2),512,1,512,fxfirst1,fxlmfirst1)
      CALL fxcl_inita(0,1,1,fxlast2,fxlmlast2,fxcc2,1,fxadesc((
     $fxcellid + 8),3),512,1,128,fxfirst2,fxlmfirst2)
      DO fxindex1 = fxlmfirst0, fxlmlast0, 1
        DO fxindex2 = fxlmfirst1, fxlmlast1, 1
          DO fxindex3 = fxlmfirst2, fxlmlast2, 1
            a(fxindex1,fxindex2,fxindex3) = 0.
          ENDDO
        ENDDO
      ENDDO
      IF (ifxowns(fxadesc,2,257,fxcellid).NE.0) THEN
        a(1,257,ifxlm(fxadesc,2,257)) = 512.
      ENDIF
      IF (ifxowns(fxadesc,2,257,fxcellid).NE.0) THEN
        a(2,257,ifxlm(fxadesc,2,257)) = 512.
      ENDIF
      END
C     j = 1
C     brt(1) = j
C     DO i = 2, 512, 1
C     k = 256
C6    CONTINUE
C     IF (k.LT.j) THEN
C     j = (j - k)
C     k = (k / 2)
C     GOTO 6 
C     ENDIF
C     j = (j + k)
C     brt(i) = j
C     ENDDO
C     RETURN 
C     END
      SUBROUTINE gen_bit_reverse_table(brt)
      INTEGER fxcellid
      INTEGER i
      INTEGER j
      INTEGER k
      EXTERNAL fx_procstart
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL msg_reduce
      INTEGER brt(512)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'gen_bit_reverse_table')
      j = 1
      brt(1) = j
      DO i = 2, 512, 1
        k = 256
6       CONTINUE
        IF (k.LT.j) THEN
          j = (j - k)
          k = (k / 2)
          GOTO 6 
        ENDIF
        j = (j + k)
        brt(i) = j
      ENDDO
      RETURN 
      END
C     pi = 3.141592653589793
C     wr = cos(((pi / 512) / 2))
C     wi = sin(((pi / 512) / 2))
C     w(1,1) = 1.
C     w(2,1) = 0.
C     ptr = 1.
C     pti = 0.
C     DO i = 2, 256, 1
C     w(1,i) = ((ptr * wr) - (pti * wi))
C     w(2,i) = ((ptr * wi) + (pti * wr))
C     ptr = w(1,i)
C     pti = w(2,i)
C     ENDDO
C     RETURN 
C     END
      SUBROUTINE gen_w_table(w)
      INTEGER fxcellid
      INTEGER i
      EXTERNAL fx_procstart
      INTEGER fxdistarg
      REAL pi
      REAL wi
      REAL wr
      EXTERNAL fxdblcheck
      EXTERNAL msg_reduce
      INTRINSIC cos
      REAL cos
      INTRINSIC sin
      REAL sin
      REAL pti
      REAL ptr
      REAL w(2,256)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'gen_w_table')
      pi = 3.141592653589793
      wr = cos(((pi / 512) / 2))
      wi = sin(((pi / 512) / 2))
      w(1,1) = 1.
      w(2,1) = 0.
      ptr = 1.
      pti = 0.
      DO i = 2, 256, 1
        w(1,i) = ((ptr * wr) - (pti * wi))
        w(2,i) = ((ptr * wi) + (pti * wr))
        ptr = w(1,i)
        pti = w(2,i)
      ENDDO
      RETURN 
      END
CC    TEMPLATE t(512)
CC    ALIGN a(I,J,K) WITH t(K)
CC    DISTRIBUTE t(BLOCK(4))
C     PDO (col = 1:512)
C     PIN a(:,:,col)
C     POUT a(:,:,col)
C     LOCAL
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX(((fxcellid * 128) + 1),1))
C     fxlmidx0 = ifxlm(fxadesc,2,fxloopstart0)
C     DO col = fxloopstart0, MIN(((fxcellid * 128) + 128),512), 1
C     DO i = 1, 512, 1
C     j = brt(i)
C     IF (i.LT.j) THEN
C     tr = a(1,j,col)
C     ti = a(2,j,col)
C     a(1,j,col) = a(1,i,col)
C     a(2,j,col) = a(2,i,col)
C     a(1,i,col) = tr
C     a(2,i,col) = ti
C     ENDIF
C     ENDDO
C     CALL fft_f77(a(1,1,col),w,512,9,256)
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     RETURN 
C     END
      SUBROUTINE cffts(a,brt,w,fxadesc,fxbrtdesc,fxwdesc)
      INTEGER fxlmidx0
      INTEGER fxcellid
      INTEGER fxloopstart0
      EXTERNAL fxinitdescck
      INTEGER i
      INTEGER j
      EXTERNAL fx_procstart
      INTRINSIC float
      REAL float
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      REAL ti
      EXTERNAL fft_f77
      REAL tr
      EXTERNAL fxdblcheck
      EXTERNAL msg_reduce
      INTEGER col
      EXTERNAL ifxceil
      INTEGER ifxceil
      EXTERNAL fxdistcheck
      REAL a(2,512,128)
      REAL w(2,256)
      INTEGER fxbrtdesc(71,1)
      INTEGER brt(512)
      INTEGER fxadesc(71,3)
      INTEGER fxwdesc(71,2)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'cffts')
      fxdistarg = 0
      CALL fxdistcheck(fxwdesc,0,3,'cffts')
      CALL fxdistcheck(fxbrtdesc,0,2,'cffts')
      CALL fxdistcheck(fxadesc,1,1,'cffts')
C     TEMPLATE t(512)
C     ALIGN a(I,J,K) WITH t(K)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 3
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 128
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      CALL fxinitdescck(1,3,fxdistarray,fxadesc,'a','cffts')
C     PDO (col = 1:512)
C     PIN a(:,:,col)
C     POUT a(:,:,col)
C     LOCAL
      IF (fxcellid.LT.4) THEN
        fxloopstart0 = (MAX(((fxcellid * 128) + 1),1))
        fxlmidx0 = ifxlm(fxadesc,2,fxloopstart0)
        DO col = fxloopstart0, MIN(((fxcellid * 128) + 128),512), 1
          DO i = 1, 512, 1
            j = brt(i)
            IF (i.LT.j) THEN
              tr = a(1,j,fxlmidx0)
              ti = a(2,j,fxlmidx0)
              a(1,j,fxlmidx0) = a(1,i,fxlmidx0)
              a(2,j,fxlmidx0) = a(2,i,fxlmidx0)
              a(1,i,fxlmidx0) = tr
              a(2,i,fxlmidx0) = ti
            ENDIF
          ENDDO
          CALL fft_f77(a(1,1,fxlmidx0),w,512,9,256)
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     ENDPDO
      RETURN 
      END
CC    TEMPLATE t(512)
CC    ALIGN a(I,J,K) WITH t(K)
CC    DISTRIBUTE t(BLOCK(4))
C     WRITE (unit=6,fmt=*) 'Checking Results!'
C     epsilon = 1e-4
C     PDO (j = 1:512)
C     PIN a(:,:,j)
C     PMERGEVARS errors
C     LOCAL
C     PINIT
C     errors = 0
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX(((fxcellid * 128) + 1),1))
C     fxlmidx0 = ifxlm(fxadesc,2,fxloopstart0)
C     DO j = fxloopstart0, MIN(((fxcellid * 128) + 128),512), 1
C     PBODY
C     sign = 1
C     IF (((j / 2) * 2).EQ.j) sign = (-1)
C     DO i = 1, 512, 1
C     IF (a(1,i,j).GT.((sign * 512) + epsilon)) errors = (errors + 1)
C     IF (a(1,i,j).LT.((sign * 512) - epsilon)) errors = (errors + 1)
C     IF (a(2,i,j).GT.((sign * 512) + epsilon)) errors = (errors + 1)
C     IF (a(2,i,j).LT.((sign * 512) - epsilon)) errors = (errors + 1)
C     sign = ( -sign)
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     PMERGE
C     DO fxp1_mergedepth = 1, 0, (-1)
C     fxp1_idle = fxmerge_step(errors,fxp1_rt_errors,1,
C    $fxp1_mergedepth)
C     IF (fxp1_idle.NE.0) THEN
C     errors = (errors + fxp1_rt_errors)
C     ENDIF
C     ENDDO
C     CALL fxmerge_broadcast(errors,1)
C     ENDPDO
C     IF (errors.GT.0) WRITE (unit=6,fmt=*) 'errors = ',errors
C     END
      SUBROUTINE chkmat(a,fxadesc)
      INTEGER fxlmidx0
      EXTERNAL left
      INTEGER left
      INTEGER sign
      INTEGER fxcellid
      INTEGER fxloopstart0
      EXTERNAL fxinitdescck
      EXTERNAL fxmerge_step
      INTEGER fxmerge_step
      INTEGER fxp1_idle
      INTEGER i
      INTEGER j
      EXTERNAL fx_procstart
      INTRINSIC float
      REAL float
      EXTERNAL right
      REAL right
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      EXTERNAL fxmerge_broadcast
      EXTERNAL fxdblcheck
      EXTERNAL msg_reduce
      INTEGER errors
      INTEGER fxp1_rt_errors
      INTEGER fxp1_mergedepth
      EXTERNAL ifxceil
      INTEGER ifxceil
      REAL epsilon
      EXTERNAL fxdistcheck
      REAL a(2,512,128)
      INTEGER fxadesc(71,3)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'chkmat')
      fxdistarg = 0
      CALL fxdistcheck(fxadesc,1,1,'chkmat')
C     TEMPLATE t(512)
C     ALIGN a(I,J,K) WITH t(K)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 3
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 128
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      CALL fxinitdescck(1,3,fxdistarray,fxadesc,'a','chkmat')
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'Checking Results!'
      ENDIF
      epsilon = 1e-4
C     PDO (j = 1:512)
C     PIN a(:,:,j)
C     PMERGEVARS errors
C     LOCAL
C     PINIT
      errors = 0
      IF (fxcellid.LT.4) THEN
        fxloopstart0 = (MAX(((fxcellid * 128) + 1),1))
        fxlmidx0 = ifxlm(fxadesc,2,fxloopstart0)
        DO j = fxloopstart0, MIN(((fxcellid * 128) + 128),512), 1
C     PBODY
          sign = 1
          IF (((j / 2) * 2).EQ.j) THEN
            sign = (-1)
          ENDIF
          DO i = 1, 512, 1
            IF (a(1,i,fxlmidx0).GT.((sign * 512) + epsilon)) THEN
              errors = (errors + 1)
            ENDIF
            IF (a(1,i,fxlmidx0).LT.((sign * 512) - epsilon)) THEN
              errors = (errors + 1)
            ENDIF
            IF (a(2,i,fxlmidx0).GT.((sign * 512) + epsilon)) THEN
              errors = (errors + 1)
            ENDIF
            IF (a(2,i,fxlmidx0).LT.((sign * 512) - epsilon)) THEN
              errors = (errors + 1)
            ENDIF
            sign = ( -sign)
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     PMERGE
      DO fxp1_mergedepth = 1, 0, (-1)
        fxp1_idle = fxmerge_step(errors,fxp1_rt_errors,1,
     $fxp1_mergedepth)
        IF (fxp1_idle.NE.0) THEN
          errors = (errors + fxp1_rt_errors)
        ENDIF
      ENDDO
      CALL fxmerge_broadcast(errors,1)
C     ENDPDO
      IF (errors.GT.0) THEN
        IF (fxcellid.EQ.0) THEN
          WRITE (unit=6,fmt=*) 'errors = ',errors
        ENDIF
      ENDIF
      END
C     WRITE (unit=6,fmt=*) 'secs = ',comptime + commtime
C     WRITE (unit=6,fmt=*) 'compsecs = ',comptime
C     WRITE (unit=6,fmt=*) 'commsecs =',commtime
C     WRITE (unit=6,fmt=*) ' '
C     WRITE (unit=6,fmt=*) 'eff =',(comptime / (comptime + commtime))
C    $ * 100.
C     butterflies = (((n * n) * logn))
C     flops = (butterflies * 10)
C     WRITE (unit=6,fmt=*) 'flops =',flops
C     mflops = ((flops / 1e6) / (comptime + commtime))
C     WRITE (unit=6,fmt=*) 'mflops =',mflops
C     END
      SUBROUTINE prperf(comptime,commtime,n,logn)
      INTEGER logn
      INTEGER fxcellid
      REAL commtime
      REAL comptime
      EXTERNAL fx_procstart
      INTEGER n
      REAL flops
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL msg_reduce
      REAL mflops
      REAL butterflies
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'prperf')
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'secs = ',comptime + commtime
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'compsecs = ',comptime
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'commsecs =',commtime
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) ' '
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'eff =',(comptime / (comptime + commtime
     $)) * 100.
      ENDIF
      butterflies = (((n * n) * logn))
      flops = (butterflies * 10)
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'flops =',flops
      ENDIF
      mflops = ((flops / 1e6) / (comptime + commtime))
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'mflops =',mflops
      ENDIF
      END
CC    NOCHECK w,a
C     ijdiff = 1
C     stride = 2
C     spowerofw = ndv2
C     DO stage = 1, m, 1
C     first = 1
C     DO powerofw = 1, ndv2, spowerofw
C     pwr = w(1,powerofw)
C     pwi = w(2,powerofw)
C     DO i = first, n, stride
C     j = (i + ijdiff)
C     jr = a(1,j)
C     ji = a(2,j)
C     ir = a(1,i)
C     ii = a(2,i)
C     tr = ((jr * pwr) - (ji * pwi))
C     ti = ((jr * pwi) + (ji * pwr))
C     a(1,j) = (ir - tr)
C     a(2,j) = (ii - ti)
C     a(1,i) = (ir + tr)
C     a(2,i) = (ii + ti)
C     ENDDO
C     first = (first + 1)
C     ENDDO
C     ijdiff = stride
C     stride = (stride * 2)
C     spowerofw = (spowerofw / 2)
C     ENDDO
C     RETURN 
C     END
      SUBROUTINE fft_f77(a,w,n,m,ndv2)
      INTEGER fxcellid
      INTEGER powerofw
      INTEGER i
      INTEGER j
      EXTERNAL fx_procstart
      INTEGER m
      INTEGER n
      INTEGER stage
      INTEGER first
      INTEGER fxdistarg
      INTEGER spowerofw
      REAL ii
      REAL ji
      INTEGER ijdiff
      REAL ir
      REAL ti
      REAL jr
      REAL tr
      EXTERNAL fxdblcheck
      INTEGER stride
      EXTERNAL msg_reduce
      REAL pwi
      REAL pwr
      INTEGER ndv2
      REAL a(2,n)
      REAL w(2,ndv2)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'fft_f77')
C     NOCHECK w,a
      ijdiff = 1
      stride = 2
      spowerofw = ndv2
      DO stage = 1, m, 1
        first = 1
        DO powerofw = 1, ndv2, spowerofw
          pwr = w(1,powerofw)
          pwi = w(2,powerofw)
          DO i = first, n, stride
            j = (i + ijdiff)
            jr = a(1,j)
            ji = a(2,j)
            ir = a(1,i)
            ii = a(2,i)
            tr = ((jr * pwr) - (ji * pwi))
            ti = ((jr * pwi) + (ji * pwr))
            a(1,j) = (ir - tr)
            a(2,j) = (ii - ti)
            a(1,i) = (ir + tr)
            a(2,i) = (ii + ti)
          ENDDO
          first = (first + 1)
        ENDDO
        ijdiff = stride
        stride = (stride * 2)
        spowerofw = (spowerofw / 2)
      ENDDO
      RETURN 
      END
C     END
      SUBROUTINE fx_getarrayinfo()
      INTEGER fxcellid
      EXTERNAL fx_procstart
      INTEGER fxdistarg
      COMMON /fxcommon/ fxcellid,fxdistarg
      END
