C     Fx compiler version 2.1
CC    TEMPLATE tr(4)
CC    TEMPLATE td(10,4)
CC    ALIGN inpr(I,J,K,L) WITH tr(L)
CC    ALIGN det(I,J,K) WITH td(J,K)
CC    DISTRIBUTE tr(CYCLIC(4))
CC    DISTRIBUTE td(CYCLIC(10),CYCLIC(4))
C     pi = 3.141592653589793
C     sigma0 = 1.13
C     thresh = 2.421
C     const2 = (thresh / (thresh + 399))
C     const1 = ((pi * 2) / 512)
C     doppler0(1) = 6
C     doppler0(2) = 16
C     doppler0(3) = 26
C     doppler0(4) = 36
C     range0(1) = 3
C     range0(2) = 5
C     range0(3) = 7
C     range0(4) = 9
C     CALL gen_bit_reverse_table(brt,512)
C     CALL gen_w_table(twiddles,512,9,256)
C     a0 = 255.5
C     DO k = 1, 512, 1
C     w(k) = ((cos((const1 * ((k + (-1)) - a0))) * .46) + .54)
C     ENDDO
C     CALL dgen(inpr,range0,doppler0,sigma0)
C     tclocks = 0
C     fclocks = 0
C     rclocks = 0
C     dclocks = 0
C     DO iter = 1, 50, 1
C     CALL sample(inpr)
C     CALL compute(inpr,det,brt,twiddles,w,const2)
C     ENDDO
C     det2 = det(1:40,:,1)
C     tusecs = ((tclocks / 20) / 50)
C     fusecs = ((fclocks / 20) / 50)
C     rusecs = ((rclocks / 20) / 50)
C     dusecs = ((dclocks / 20) / 50)
C     usecs = (((tusecs + fusecs) + rusecs) + dusecs)
C     tpercent = ((real(tusecs) / real(usecs)) * 100.)
C     fpercent = ((real(fusecs) / real(usecs)) * 100.)
C     rpercent = ((real(rusecs) / real(usecs)) * 100.)
C     dpercent = ((real(dusecs) / real(usecs)) * 100.)
C     WRITE (unit=6,fmt=*) '2D Distribution'
C     WRITE (unit=6,fmt=*) 4,' channels',10,' range cells'
C     WRITE (unit=6,fmt=*) 'tpose     :',tusecs,tpercent
C     WRITE (unit=6,fmt=*) 'fft/mag   :',fusecs,fpercent
C     WRITE (unit=6,fmt=*) 'reduce    :',rusecs,rpercent
C     WRITE (unit=6,fmt=*) 'detect    :',dusecs,dpercent
C     WRITE (unit=6,fmt=*) 'total(us) :',usecs
C     WRITE (unit=6,fmt=*) ''
C     WRITE (unit=6,fmt=*) det2(5,2),det2(6,2),det2(7,2),det2(8,2),
C    $det2(9,2)
C     WRITE (unit=6,fmt=*) det2(5,3),det2(6,3),det2(7,3),det2(8,3),
C    $det2(9,3)
C     WRITE (unit=6,fmt=*) det2(15,5),det2(16,5),det2(17,5),det2(18,5
C    $),det2(19,5)
C     WRITE (unit=6,fmt=*) det2(25,7),det2(26,7),det2(27,7),det2(28,7
C    $),det2(29,7)
C     WRITE (unit=6,fmt=*) det2(35,9),det2(36,9),det2(37,9),det2(38,9
C    $),det2(39,9)
C     WRITE (unit=6,fmt=*) det2(35,10),det2(36,10),det2(37,10),det2(
C    $38,10),det2(39,10)
C     END
      PROGRAM main
      EXTERNAL dgen
      INTRINSIC real
      REAL real
      INTEGER fxfxrhs2
      INTEGER iter
      INTEGER fxcellid
      EXTERNAL fxinnerloop1
      INTEGER dpercent
      INTEGER fpercent
      INTEGER rpercent
      INTEGER tpercent
      INTEGER fxbufdataidx
      EXTERNAL fxbcastpairs
      INTEGER fxbufoff0
      INTEGER k
      EXTERNAL fx_procstart
      INTEGER fxrslice0
      EXTERNAL ifxlm
      INTEGER ifxlm
      REAL a0
      INTEGER usecs
      EXTERNAL fx_deinit
      INTEGER fxdistarg
      REAL sigma0
      EXTERNAL gen_bit_reverse_table
      REAL const1
      REAL const2
      INTEGER fxplr0
      REAL pi
      INTEGER fxaddr
      EXTERNAL sample
      INTEGER dusecs
      INTEGER fusecs
      EXTERNAL net_reduce
      REAL thresh
      INTEGER rusecs
      INTEGER tusecs
      EXTERNAL fxinitdesc
      INTRINSIC cos
      REAL cos
      INTEGER dclocks
      INTEGER fclocks
      EXTERNAL gen_w_table
      EXTERNAL fxdsend
      INTEGER rclocks
      EXTERNAL fx_init
      INTEGER tclocks
      INTEGER fxidiotic3_0
      EXTERNAL fx_set_module_geometry
      EXTERNAL compute
      EXTERNAL fxallocinit
      INTEGER fxallocinit
      EXTERNAL ifxowns
      INTEGER ifxowns
      INTEGER fxslice0
      INTEGER doppler0(4)
      REAL inpr(2,512,10,1)
      INTEGER fxbuffer(1)
      REAL twiddles(2,256)
      REAL w(512)
      INTEGER fxdetdesc(71,3)
      COMPLEX fxcbuffer(1)
      DOUBLE PRECISION fxdbuffer(1)
      LOGICAL fxlbuffer(1)
      REAL fxrbuffer(1)
      INTEGER range0(4)
      DOUBLE COMPLEX fxdcbuffer(1)
      INTEGER fxinprdesc(71,4)
      INTEGER det(512,1,1)
      INTEGER brt(512)
      INTEGER det2(40,10)
      INTEGER fxdistarray(6,20)
      EQUIVALENCE (fxbuffer,fxrbuffer)
      EQUIVALENCE (fxbuffer,fxlbuffer)
      EQUIVALENCE (fxbuffer,fxdbuffer)
      EQUIVALENCE (fxbuffer,fxcbuffer)
      EQUIVALENCE (fxbuffer,fxdcbuffer)
      COMMON /timing/ fclocks,tclocks,rclocks,dclocks
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fx_init(fxcellid,1,1,0,0)
      CALL fx_set_module_geometry(0,0,0,8,8)
      fxdistarg = 0
      fxbufoff0 = fxallocinit(fxbuffer,320)
      fxdistarray(1,1) = 2
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 10
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(1,2) = 3
      fxdistarray(2,2) = 0
      fxdistarray(3,2) = 1
      fxdistarray(4,2) = 4
      fxdistarray(5,2) = 0
      fxdistarray(6,2) = 0
      fxdistarray(3,3) = 512
      CALL fxinitdesc(2,3,fxdistarray,fxdetdesc)
      fxdistarray(1,1) = 4
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      fxdistarray(3,4) = 10
      CALL fxinitdesc(1,4,fxdistarray,fxinprdesc)
C     TEMPLATE tr(4)
C     TEMPLATE td(10,4)
C     ALIGN inpr(I,J,K,L) WITH tr(L)
C     ALIGN det(I,J,K) WITH td(J,K)
C     DISTRIBUTE tr(CYCLIC(4))
C     DISTRIBUTE td(CYCLIC(10),CYCLIC(4))
      pi = 3.141592653589793
      sigma0 = 1.13
      thresh = 2.421
      const2 = (thresh / (thresh + 399))
      const1 = ((pi * 2) / 512)
      doppler0(1) = 6
      doppler0(2) = 16
      doppler0(3) = 26
      doppler0(4) = 36
      range0(1) = 3
      range0(2) = 5
      range0(3) = 7
      range0(4) = 9
      CALL gen_bit_reverse_table(brt,512)
      CALL gen_w_table(twiddles,512,9,256)
      a0 = 255.5
      DO k = 1, 512, 1
        w(k) = ((cos((const1 * ((k + (-1)) - a0))) * .46) + .54)
      ENDDO
      fxdistarg = 1
      CALL dgen(inpr,range0,doppler0,sigma0,fxinprdesc,(-1),(-1),(-1)
     $)
      tclocks = 0
      fclocks = 0
      rclocks = 0
      dclocks = 0
      DO iter = 1, 50, 1
        fxdistarg = 1
        CALL sample(inpr,fxinprdesc)
        fxdistarg = 1
        CALL compute(inpr,det,brt,twiddles,w,const2,fxinprdesc,
     $fxdetdesc,(-1),(-1),(-1),(-1))
      ENDDO
      fxbufdataidx = 1
      IF ((ifxowns(fxdetdesc,2,1,fxcellid).NE.0).AND.(fxdetdesc((
     $fxcellid + 8),1).NE.(-1000000))) THEN
        fxfxrhs2 = ifxlm(fxdetdesc,2,1)
        fxplr0 = 0
        fxrslice0 = fxplr0
        DO fxslice0 = 1, 40, 1
          CALL fxinnerloop1(fxbufdataidx,fxbuffer((fxbufoff0 + 
     $fxbufdataidx)),det2((fxrslice0 + 1),((MAX((fxdetdesc((fxcellid
     $ + 8),2) + (-1)),0)) + 1)),det(fxslice0,1,fxfxrhs2),1,160,2048,
     $1)
          fxrslice0 = (fxrslice0 + 1)
        ENDDO
      ENDIF
      CALL fxbcastpairs(fxbuffer((fxbufoff0 + 1)),(fxbufdataidx + 
     $(-1)),1,320)
      tusecs = ((tclocks / 20) / 50)
      fusecs = ((fclocks / 20) / 50)
      rusecs = ((rclocks / 20) / 50)
      dusecs = ((dclocks / 20) / 50)
      usecs = (((tusecs + fusecs) + rusecs) + dusecs)
      tpercent = ((real(tusecs) / real(usecs)) * 100.)
      fpercent = ((real(fusecs) / real(usecs)) * 100.)
      rpercent = ((real(rusecs) / real(usecs)) * 100.)
      dpercent = ((real(dusecs) / real(usecs)) * 100.)
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) '2D Distribution'
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 4,' channels',10,' range cells'
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'tpose     :',tusecs,tpercent
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'fft/mag   :',fusecs,fpercent
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'reduce    :',rusecs,rpercent
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'detect    :',dusecs,dpercent
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'total(us) :',usecs
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) ''
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) det2(5,2),det2(6,2),det2(7,2),det2(8,2),
     $det2(9,2)
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) det2(5,3),det2(6,3),det2(7,3),det2(8,3),
     $det2(9,3)
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) det2(15,5),det2(16,5),det2(17,5),det2(18
     $,5),det2(19,5)
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) det2(25,7),det2(26,7),det2(27,7),det2(28
     $,7),det2(29,7)
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) det2(35,9),det2(36,9),det2(37,9),det2(38
     $,9),det2(39,9)
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) det2(35,10),det2(36,10),det2(37,10),det2
     $(38,10),det2(39,10)
      ENDIF
      CALL fx_deinit()
      END
CC    TEMPLATE tr(4)
CC    ALIGN inpr(I,J,K,L) WITH tr(L)
CC    DISTRIBUTE tr(CYCLIC(4))
CC    NOCHECK inpr
C     RETURN 
C     END
      SUBROUTINE sample(inpr,fxinprdesc)
      INTEGER fxcellid
      EXTERNAL fx_procstart
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL fxinitdesc
      REAL inpr(2,512,10,1)
      INTEGER fxinprdesc(71,4)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'sample')
      fxdistarg = 0
      fxdistarray(1,1) = 4
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      fxdistarray(3,4) = 10
      CALL fxinitdesc(1,4,fxdistarray,fxinprdesc)
C     TEMPLATE tr(4)
C     ALIGN inpr(I,J,K,L) WITH tr(L)
C     DISTRIBUTE tr(CYCLIC(4))
C     NOCHECK inpr
      RETURN 
      END
CC    TEMPLATE tr(4)
CC    TEMPLATE td(10,4)
CC    ALIGN inpr(I,J,K,L) WITH tr(L)
CC    ALIGN inpd(I,J,K,L) WITH td(K,L)
CC    ALIGN mag(I,J,K) WITH td(J,K)
CC    ALIGN det(I,J,K) WITH td(J,K)
CC    DISTRIBUTE tr(CYCLIC(4))
CC    DISTRIBUTE td(CYCLIC(10),CYCLIC(4))
C     CALL timer_start()
C     IDXPERM(inpd,1,4,3,2) = IDXPERM(inpr,1,4,3,2)
C     tclocks = (tclocks + timer_stop())
C     CALL timer_start()
C     PDO (j = 1:10,i = 1:4)
C     PIN inpd(:,:,j,i)
C     POUT mag(:,j,i)
C     LOCAL
C     IF (fxcellid.LT.40) THEN
C     fxloopstart0 = (MAX(((MOD(fxcellid,10)) + 1),1))
C     fxlmidx0 = ifxlm(fxmagdesc,1,fxloopstart0)
C     DO j = fxloopstart0, MIN(((MOD(fxcellid,10)) + 1),10), 1
C     fxloopstart1 = (MAX(((fxcellid / 10) + 1),1))
C     fxlmidx1 = ifxlm(fxmagdesc,2,fxloopstart1)
C     DO i = fxloopstart1, MIN(((fxcellid / 10) + 1),4), 1
C     x(1,:) = inpd(1,:,j,i) * w
C     x(2,:) = inpd(2,:,j,i) * w
C     CALL fft(x,brt,twiddles,512,9,256)
C     y = (x / 512)
C     tmpmag = ((y(1,1:40) * y(1,1:40)) + y(2,1:40) * y(2,1:40))
C     mag(1:40,j,i) = sqrt(tmpmag)
C     fxlmidx1 = (fxlmidx1 + 1)
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     fclocks = (fclocks + timer_stop())
C     CALL timer_start()
C     PDO (j = 1:10,i = 1:4)
C     PIN mag(:,j,i)
C     PMERGEVARS magsum
C     PCOMMUTATIVE
C     LOCAL
C     PINIT
C     magsum = 0.
C     IF (fxcellid.LT.40) THEN
C     fxloopstart0 = (MAX(((MOD(fxcellid,10)) + 1),1))
C     fxlmidx0 = ifxlm(fxmagdesc,1,fxloopstart0)
C     DO j = fxloopstart0, MIN(((MOD(fxcellid,10)) + 1),10), 1
C     fxloopstart1 = (MAX(((fxcellid / 10) + 1),1))
C     fxlmidx1 = ifxlm(fxmagdesc,2,fxloopstart1)
C     DO i = fxloopstart1, MIN(((fxcellid / 10) + 1),4), 1
C     PBODY
C     DO k = 1, 40, 1
C     magsum(i) = (magsum(i) + mag(k,j,i))
C     ENDDO
C     fxlmidx1 = (fxlmidx1 + 1)
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     PMERGE
C     DO fxp1_mergedepth = 5, 0, (-1)
C     fxp1_idle = fxmerge_step(magsum,fxp1_rt_magsum,4,
C    $fxp1_mergedepth)
C     IF (fxp1_idle.NE.0) THEN
C     magsum = (magsum + fxp1_rt_magsum)
C     ENDIF
C     ENDDO
C     CALL fxmerge_broadcast(magsum,4)
C     ENDPDO
C     rclocks = (rclocks + timer_stop())
C     CALL timer_start()
C     PDO (j = 1:10,i = 1:4)
C     PIN mag(:,j,i)
C     POUT det(:,j,i)
C     LOCAL
C     IF (fxcellid.LT.40) THEN
C     fxloopstart0 = (MAX(((MOD(fxcellid,10)) + 1),1))
C     fxlmidx0 = ifxlm(fxdetdesc,1,fxloopstart0)
C     DO j = fxloopstart0, MIN(((MOD(fxcellid,10)) + 1),10), 1
C     fxloopstart1 = (MAX(((fxcellid / 10) + 1),1))
C     fxlmidx1 = ifxlm(fxdetdesc,2,fxloopstart1)
C     DO i = fxloopstart1, MIN(((fxcellid / 10) + 1),4), 1
C     localthresh(i) = (const2 * magsum(i))
C     DO k = 1, 40, 1
C     IF (mag(k,j,i).GT.localthresh(i)) THEN
C     det(k,j,i) = 1
C     ELSE
C     det(k,j,i) = 0
C     ENDIF
C     ENDDO
C     fxlmidx1 = (fxlmidx1 + 1)
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     dclocks = (dclocks + timer_stop())
C     RETURN 
C     END
      SUBROUTINE compute(inpr,det,brt,twiddles,w,const2,fxinprdesc,
     $fxdetdesc,fxbrtdesc,fxtwiddlesdesc,fxwdesc,fxconst2desc)
      INTEGER fxindex1
      INTEGER fxindex2
      EXTERNAL fxawaitmessages
      INTEGER fxlmidx0
      INTEGER fxlmidx1
      INTEGER fxprocessor
      EXTERNAL left
      REAL left
      INTEGER fxcellid
      INTEGER fxop
      INTRINSIC sqrt
      REAL sqrt
      INTEGER fxloopstart0
      INTEGER fxloopstart1
      INTEGER fxbufdataidx
      EXTERNAL fxinitdescck
      EXTERNAL fxmerge_step
      INTEGER fxmerge_step
      INTEGER fxp1_idle
      INTEGER fxbufoff1
      INTEGER i
      INTEGER j
      INTEGER k
      EXTERNAL fx_procstart
      INTEGER fxrslice0
      INTEGER fxrslice1
      INTEGER fxrslice2
      INTRINSIC float
      REAL float
      EXTERNAL right
      REAL right
      EXTERNAL ifxlm
      INTEGER ifxlm
      EXTERNAL fxdcomord
      INTEGER fxdistarg
      EXTERNAL fxmerge_broadcast
      REAL const2
      INTEGER fxplr0
      INTEGER fxplr3
      INTEGER fxaddr
      EXTERNAL fxdblcheck
      EXTERNAL net_reduce
      EXTERNAL fxinitdesc
      EXTERNAL timer_stop
      INTEGER timer_stop
      INTEGER fxindextmp
      EXTERNAL fft
      INTEGER fxp1_mergedepth
      INTEGER dclocks
      EXTERNAL ifxceil
      INTEGER ifxceil
      INTEGER fclocks
      EXTERNAL fxdsend
      INTEGER rclocks
      INTEGER tclocks
      INTEGER fxawait
      INTEGER fxidiotic3_0
      EXTERNAL fx_sync
      EXTERNAL fxdistcheck
      EXTERNAL fxallocinit
      INTEGER fxallocinit
      EXTERNAL fxadblk1
      EXTERNAL timer_start
      INTEGER fxslice0
      INTEGER fxslice1
      INTEGER fxslice2
      REAL inpd(2,512,1,1)
      INTEGER fxconst2desc(71,1)
      REAL inpr(2,512,10,1)
      INTEGER fxbuffer(1)
      REAL twiddles(2,256)
      REAL w(512)
      REAL x(2,512)
      REAL y(2,512)
      INTEGER fxmagdesc(71,3)
      INTEGER fxdetdesc(71,3)
      COMPLEX fxcbuffer(1)
      DOUBLE PRECISION fxdbuffer(1)
      LOGICAL fxlbuffer(1)
      INTEGER fxbrtdesc(71,1)
      REAL fxrbuffer(1)
      REAL tmpmag(40)
      REAL magsum(4)
      REAL fxp1_rt_magsum(4)
      DOUBLE COMPLEX fxdcbuffer(1)
      INTEGER fxinpddesc(71,4)
      INTEGER fxinprdesc(71,4)
      INTEGER fxtwiddlesdesc(71,2)
      REAL mag(512,1,1)
      INTEGER det(512,1,1)
      INTEGER brt(512)
      INTEGER fxwdesc(71,1)
      REAL localthresh(4)
      INTEGER fxdistarray(6,20)
      EQUIVALENCE (fxbuffer,fxrbuffer)
      EQUIVALENCE (fxbuffer,fxlbuffer)
      EQUIVALENCE (fxbuffer,fxdbuffer)
      EQUIVALENCE (fxbuffer,fxcbuffer)
      EQUIVALENCE (fxbuffer,fxdcbuffer)
      COMMON /timing/ fclocks,tclocks,rclocks,dclocks
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'compute')
      fxdistarg = 0
      CALL fxdistcheck(fxconst2desc,0,6,'compute')
      CALL fxdistcheck(fxwdesc,0,5,'compute')
      CALL fxdistcheck(fxtwiddlesdesc,0,4,'compute')
      CALL fxdistcheck(fxbrtdesc,0,3,'compute')
      CALL fxdistcheck(fxdetdesc,1,2,'compute')
      CALL fxdistcheck(fxinprdesc,1,1,'compute')
      fxbufoff1 = fxallocinit(fxbuffer,4116)
      fxdistarray(1,1) = 2
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 10
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(1,2) = 3
      fxdistarray(2,2) = 0
      fxdistarray(3,2) = 1
      fxdistarray(4,2) = 4
      fxdistarray(5,2) = 0
      fxdistarray(6,2) = 0
      fxdistarray(3,3) = 512
      CALL fxinitdescck(2,3,fxdistarray,fxdetdesc,'det','compute')
      fxdistarray(1,1) = 2
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 10
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(1,2) = 3
      fxdistarray(2,2) = 0
      fxdistarray(3,2) = 1
      fxdistarray(4,2) = 4
      fxdistarray(5,2) = 0
      fxdistarray(6,2) = 0
      fxdistarray(3,3) = 512
      CALL fxinitdesc(2,3,fxdistarray,fxmagdesc)
      fxdistarray(1,1) = 3
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 10
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(1,2) = 4
      fxdistarray(2,2) = 0
      fxdistarray(3,2) = 1
      fxdistarray(4,2) = 4
      fxdistarray(5,2) = 0
      fxdistarray(6,2) = 0
      fxdistarray(3,3) = 2
      fxdistarray(3,4) = 512
      CALL fxinitdesc(2,4,fxdistarray,fxinpddesc)
      fxdistarray(1,1) = 4
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      fxdistarray(3,4) = 10
      CALL fxinitdescck(1,4,fxdistarray,fxinprdesc,'inpr','compute')
C     TEMPLATE tr(4)
C     TEMPLATE td(10,4)
C     ALIGN inpr(I,J,K,L) WITH tr(L)
C     ALIGN inpd(I,J,K,L) WITH td(K,L)
C     ALIGN mag(I,J,K) WITH td(J,K)
C     ALIGN det(I,J,K) WITH td(J,K)
C     DISTRIBUTE tr(CYCLIC(4))
C     DISTRIBUTE td(CYCLIC(10),CYCLIC(4))
      CALL timer_start()
      CALL fx_sync()
      fxawait = 0
      DO fxindextmp = 1, 64, 1
        CALL fxdcomord(fxprocessor,fxop,fxindextmp)
        IF (fxinprdesc((fxcellid + 8),1).NE.(-1000000)) THEN
          IF (fxinpddesc((fxprocessor + 8),1).NE.(-1000000)) THEN
            fxbufdataidx = 4
            fxbuffer((fxbufoff1 + 1)) = 0
            fxplr0 = 0
            fxplr3 = 0
            fxrslice0 = fxplr0
            DO fxslice0 = 1, 2, 1
              fxrslice1 = (MAX(((1 - fxinpddesc((fxprocessor + 8),4))
     $ + (MAX((fxinprdesc((fxcellid + 8),4) + (-1)),0))),0))
              DO fxslice1 = MAX((((MAX(fxinpddesc((fxprocessor + 8),4
     $),1)) + 1) - fxinprdesc((fxcellid + 8),4)),1), (MIN((((MIN(
     $fxinpddesc((fxprocessor + 8),4),4)) + 1) - fxinprdesc((fxcellid
     $ + 8),4)),1)), 1
                fxrslice2 = 0
                DO fxslice2 = MAX(fxinpddesc((fxprocessor + 8),3),1)
     $, (MIN(fxinpddesc((fxprocessor + 8),3),10)), 1
                  CALL fxadblk1(fxbufdataidx,fxbuffer((fxbufoff1 + 
     $fxbufdataidx)),inpd((fxrslice0 + 1),(fxplr3 + 1),(fxrslice2 + 1
     $),(fxrslice1 + 1)),inpr(fxslice0,1,fxslice2,fxslice1),512,8,8,(
     $fxcellid - fxprocessor),fxbuffer((fxbufoff1 + 1)))
                  fxrslice2 = (fxrslice2 + 1)
                ENDDO
                fxrslice1 = (fxrslice1 + 1)
              ENDDO
              fxrslice0 = (fxrslice0 + 1)
            ENDDO
            IF (fxbufdataidx.GT.4) THEN
              fxbuffer((fxbufoff1 + 2)) = 8
              fxbuffer((fxbufoff1 + 3)) = 512
              CALL fxdsend(fxprocessor,fxbuffer((fxbufoff1 + 1)),(
     $fxbufdataidx + (-1)),9)
              fxawait = (fxawait + 1)
            ENDIF
          ENDIF
        ENDIF
      ENDDO
      CALL fxawaitmessages(fxawait)
      tclocks = (tclocks + timer_stop())
      CALL timer_start()
C     PDO (j = 1:10,i = 1:4)
C     PIN inpd(:,:,j,i)
C     POUT mag(:,j,i)
C     LOCAL
      IF (fxcellid.LT.40) THEN
        fxloopstart0 = (MAX(((MOD(fxcellid,10)) + 1),1))
        fxlmidx0 = ifxlm(fxmagdesc,1,fxloopstart0)
        DO j = fxloopstart0, MIN(((MOD(fxcellid,10)) + 1),10), 1
          fxloopstart1 = (MAX(((fxcellid / 10) + 1),1))
          fxlmidx1 = ifxlm(fxmagdesc,2,fxloopstart1)
          DO i = fxloopstart1, MIN(((fxcellid / 10) + 1),4), 1
            DO fxindex1 = 1, 512, 1
              x(1,fxindex1) = (inpd(1,fxindex1,fxlmidx0,fxlmidx1) * w
     $(fxindex1))
            ENDDO
            DO fxindex1 = 1, 512, 1
              x(2,fxindex1) = (inpd(2,fxindex1,fxlmidx0,fxlmidx1) * w
     $(fxindex1))
            ENDDO
            CALL fft(x,brt,twiddles,512,9,256)
            DO fxindex1 = 1, 2, 1
              DO fxindex2 = 1, 512, 1
                y(fxindex1,fxindex2) = (x(fxindex1,fxindex2) / 512)
              ENDDO
            ENDDO
            DO fxindex1 = 1, 40, 1
              tmpmag(fxindex1) = ((y(1,fxindex1) * y(1,fxindex1)) + (
     $y(2,fxindex1) * y(2,fxindex1)))
            ENDDO
            DO fxindex1 = 1, 40, 1
              mag(fxindex1,fxlmidx0,fxlmidx1) = sqrt(tmpmag(fxindex1)
     $)
            ENDDO
            fxlmidx1 = (fxlmidx1 + 1)
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     ENDPDO
      fclocks = (fclocks + timer_stop())
      CALL timer_start()
C     PDO (j = 1:10,i = 1:4)
C     PIN mag(:,j,i)
C     PMERGEVARS magsum
C     PCOMMUTATIVE
C     LOCAL
C     PINIT
      DO fxindex1 = 1, 4, 1
        magsum(fxindex1) = 0.
      ENDDO
      IF (fxcellid.LT.40) THEN
        fxloopstart0 = (MAX(((MOD(fxcellid,10)) + 1),1))
        fxlmidx0 = ifxlm(fxmagdesc,1,fxloopstart0)
        DO j = fxloopstart0, MIN(((MOD(fxcellid,10)) + 1),10), 1
          fxloopstart1 = (MAX(((fxcellid / 10) + 1),1))
          fxlmidx1 = ifxlm(fxmagdesc,2,fxloopstart1)
          DO i = fxloopstart1, MIN(((fxcellid / 10) + 1),4), 1
C     PBODY
            DO k = 1, 40, 1
              magsum(i) = (magsum(i) + mag(k,fxlmidx0,fxlmidx1))
            ENDDO
            fxlmidx1 = (fxlmidx1 + 1)
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     PMERGE
      DO fxp1_mergedepth = 5, 0, (-1)
        fxp1_idle = fxmerge_step(magsum,fxp1_rt_magsum,4,
     $fxp1_mergedepth)
        IF (fxp1_idle.NE.0) THEN
          DO fxindex1 = 1, 4, 1
            magsum(fxindex1) = (magsum(fxindex1) + fxp1_rt_magsum(
     $fxindex1))
          ENDDO
        ENDIF
      ENDDO
      CALL fxmerge_broadcast(magsum,4)
C     ENDPDO
      rclocks = (rclocks + timer_stop())
      CALL timer_start()
C     PDO (j = 1:10,i = 1:4)
C     PIN mag(:,j,i)
C     POUT det(:,j,i)
C     LOCAL
      IF (fxcellid.LT.40) THEN
        fxloopstart0 = (MAX(((MOD(fxcellid,10)) + 1),1))
        fxlmidx0 = ifxlm(fxdetdesc,1,fxloopstart0)
        DO j = fxloopstart0, MIN(((MOD(fxcellid,10)) + 1),10), 1
          fxloopstart1 = (MAX(((fxcellid / 10) + 1),1))
          fxlmidx1 = ifxlm(fxdetdesc,2,fxloopstart1)
          DO i = fxloopstart1, MIN(((fxcellid / 10) + 1),4), 1
            localthresh(i) = (const2 * magsum(i))
            DO k = 1, 40, 1
              IF (mag(k,fxlmidx0,fxlmidx1).GT.localthresh(i)) THEN
                det(k,fxlmidx0,fxlmidx1) = 1
              ELSE
                det(k,fxlmidx0,fxlmidx1) = 0
              ENDIF
            ENDDO
            fxlmidx1 = (fxlmidx1 + 1)
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     ENDPDO
      dclocks = (dclocks + timer_stop())
      RETURN 
      END
CC    TEMPLATE tr(4)
CC    ALIGN inpr(I,J,K,L) WITH tr(L)
CC    DISTRIBUTE tr(CYCLIC(4))
C     pi = 3.141592653589793
C     arg1 = ((pi * 2.) / 512)
C     PDO (i = 1:4)
C     POUT inpr(:,:,:,i)
C     LOCAL
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX((fxcellid + 1),1))
C     fxlmidx0 = ifxlm(fxinprdesc,3,fxloopstart0)
C     DO i = fxloopstart0, MIN((fxcellid + 1),4), 1
C     DO j = 1, 10, 1
C     DO k = 1, 512, 1
C     inpr(1,k,j,i) = gauss1(0.,sigma0)
C     inpr(2,k,j,i) = gauss1(0.,sigma0)
C     ENDDO
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     DO m = 1, 4, 1
C     range = range0(m)
C     doppler = doppler0(m)
C     PDO (i = 1:4)
C     PIN inpr(:,:,:,i)
C     POUT inpr(:,:,:,i)
C     LOCAL
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX((fxcellid + 1),1))
C     fxlmidx0 = ifxlm(fxinprdesc,3,fxloopstart0)
C     DO i = fxloopstart0, MIN((fxcellid + 1),4), 1
C     DO k = 1, 512, 1
C     arg2 = ((arg1 * (k + (-1))) * doppler)
C     inpr(1,k,range,i) = (inpr(1,k,range,i) + cos(arg2))
C     inpr(2,k,range,i) = (inpr(2,k,range,i) + sin(arg2))
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     ENDDO
C     END
      SUBROUTINE dgen(inpr,range0,doppler0,sigma0,fxinprdesc,
     $fxrange0desc,fxdoppler0desc,fxsigma0desc)
      INTEGER fxlmidx0
      INTEGER fxcellid
      INTEGER fxloopstart0
      EXTERNAL fxinitdescck
      INTEGER i
      INTEGER j
      INTEGER k
      EXTERNAL fx_procstart
      INTEGER m
      INTEGER range
      INTRINSIC float
      REAL float
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      REAL sigma0
      EXTERNAL gauss1
      REAL gauss1
      REAL pi
      EXTERNAL fxdblcheck
      EXTERNAL net_reduce
      INTRINSIC cos
      REAL cos
      INTRINSIC sin
      REAL sin
      EXTERNAL ifxceil
      INTEGER ifxceil
      INTEGER doppler
      REAL arg1
      REAL arg2
      EXTERNAL fxdistcheck
      INTEGER doppler0(4)
      INTEGER fxrange0desc(71,1)
      INTEGER fxsigma0desc(71,1)
      REAL inpr(2,512,10,1)
      INTEGER range0(4)
      INTEGER fxdoppler0desc(71,1)
      INTEGER fxinprdesc(71,4)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'dgen')
      fxdistarg = 0
      CALL fxdistcheck(fxsigma0desc,0,4,'dgen')
      CALL fxdistcheck(fxdoppler0desc,0,3,'dgen')
      CALL fxdistcheck(fxrange0desc,0,2,'dgen')
      CALL fxdistcheck(fxinprdesc,1,1,'dgen')
      fxdistarray(1,1) = 4
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 1
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 2
      fxdistarray(3,3) = 512
      fxdistarray(3,4) = 10
      CALL fxinitdescck(1,4,fxdistarray,fxinprdesc,'inpr','dgen')
C     TEMPLATE tr(4)
C     ALIGN inpr(I,J,K,L) WITH tr(L)
C     DISTRIBUTE tr(CYCLIC(4))
      pi = 3.141592653589793
      arg1 = ((pi * 2.) / 512)
C     PDO (i = 1:4)
C     POUT inpr(:,:,:,i)
C     LOCAL
      IF (fxcellid.LT.4) THEN
        fxloopstart0 = (MAX((fxcellid + 1),1))
        fxlmidx0 = ifxlm(fxinprdesc,3,fxloopstart0)
        DO i = fxloopstart0, MIN((fxcellid + 1),4), 1
          DO j = 1, 10, 1
            DO k = 1, 512, 1
              inpr(1,k,j,fxlmidx0) = gauss1(0.,sigma0)
              inpr(2,k,j,fxlmidx0) = gauss1(0.,sigma0)
            ENDDO
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     ENDPDO
      DO m = 1, 4, 1
        range = range0(m)
        doppler = doppler0(m)
C     PDO (i = 1:4)
C     PIN inpr(:,:,:,i)
C     POUT inpr(:,:,:,i)
C     LOCAL
        IF (fxcellid.LT.4) THEN
          fxloopstart0 = (MAX((fxcellid + 1),1))
          fxlmidx0 = ifxlm(fxinprdesc,3,fxloopstart0)
          DO i = fxloopstart0, MIN((fxcellid + 1),4), 1
            DO k = 1, 512, 1
              arg2 = ((arg1 * (k + (-1))) * doppler)
              inpr(1,k,range,fxlmidx0) = (inpr(1,k,range,fxlmidx0) + 
     $cos(arg2))
              inpr(2,k,range,fxlmidx0) = (inpr(2,k,range,fxlmidx0) + 
     $sin(arg2))
            ENDDO
            fxlmidx0 = (fxlmidx0 + 1)
          ENDDO
        ENDIF
C     ENDLOCAL
C     ENDPDO
      ENDDO
      END
C     x = 0.
C     DO i = 1, 12, 1
C     x = (x + real(random1()))
C     ENDDO
C     gauss1 = (mean + (sigma * (x + (-6.))))
C     END
      REAL FUNCTION gauss1(mean,sigma)
      REAL mean
      INTRINSIC real
      REAL real
      INTEGER fxcellid
      INTEGER i
      EXTERNAL fx_procstart
      REAL x
      REAL sigma
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL net_reduce
      EXTERNAL random1
      REAL random1
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'gauss1')
      x = 0.
      DO i = 1, 12, 1
        x = (x + real(random1()))
      ENDDO
      gauss1 = (mean + (sigma * (x + (-6.))))
      END
C     m = 100000000
C     m1 = 10000
C     b = 31415821
C     a1 = (a / m1)
C     a0 = mod(a,m1)
C     b1 = (b / m1)
C     b0 = mod(b,m1)
C     a0 = ((mod(((a0 * b1) + (a1 * b0)),m1) * m1) + (a0 * b0))
C     a = mod((a0 + 1),m)
C     random1 = (real(a) / m)
C     END
      REAL FUNCTION random1()
      INTRINSIC real
      REAL real
      INTEGER fxcellid
      INTEGER a
      SAVE a
      INTEGER b
      EXTERNAL fx_procstart
      INTEGER m
      INTEGER a0
      INTEGER a1
      INTEGER b0
      INTEGER b1
      INTEGER m1
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL net_reduce
      INTRINSIC mod
      INTEGER mod
      COMMON /fxcommon/ fxcellid,fxdistarg
      DATA a / 11111111 /
      CALL fxdblcheck(fxdistarg,0,'random1')
      m = 100000000
      m1 = 10000
      b = 31415821
      a1 = (a / m1)
      a0 = mod(a,m1)
      b1 = (b / m1)
      b0 = mod(b,m1)
      a0 = ((mod(((a0 * b1) + (a1 * b0)),m1) * m1) + (a0 * b0))
      a = mod((a0 + 1),m)
      random1 = (real(a) / m)
      END
C     nv2 = (n / 2)
C     j = 1
C     brt(1) = j
C     DO i = 2, n, 1
C     k = nv2
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,n)
      INTEGER fxcellid
      INTEGER i
      INTEGER j
      INTEGER k
      EXTERNAL fx_procstart
      INTEGER n
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL net_reduce
      INTEGER nv2
      INTEGER brt(n)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'gen_bit_reverse_table')
      nv2 = (n / 2)
      j = 1
      brt(1) = j
      DO i = 2, n, 1
        k = nv2
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 / ndv2))
C     wi = ( -sin((pi / ndv2)))
C     w(1,1) = 1.
C     w(2,1) = 0.
C     ptr = 1.
C     pti = 0.
C     DO i = 2, ndv2, 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,n,m,ndv2)
      INTEGER fxcellid
      INTEGER i
      EXTERNAL fx_procstart
      INTEGER fxdistarg
      REAL pi
      REAL wi
      REAL wr
      EXTERNAL fxdblcheck
      EXTERNAL net_reduce
      INTRINSIC cos
      REAL cos
      INTRINSIC sin
      REAL sin
      REAL pti
      REAL ptr
      INTEGER ndv2
      REAL w(2,ndv2)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'gen_w_table')
      pi = 3.141592653589793
      wr = cos((pi / ndv2))
      wi = ( -sin((pi / ndv2)))
      w(1,1) = 1.
      w(2,1) = 0.
      ptr = 1.
      pti = 0.
      DO i = 2, ndv2, 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    NOCHECK 
C     DO i = 1, n, 1
C     j = brt(i)
C     IF (i.LT.j) THEN
C     tr = a(1,j)
C     ti = a(2,j)
C     a(1,j) = a(1,i)
C     a(2,j) = a(2,i)
C     a(1,i) = tr
C     a(2,i) = ti
C     ENDIF
C     ENDDO
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(a,brt,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
      INTEGER stride
      EXTERNAL net_reduce
      REAL pwi
      REAL pwr
      INTEGER ndv2
      REAL a(2,n)
      REAL w(2,ndv2)
      INTEGER brt(n)
      COMMON /fxcommon/ fxcellid,fxdistarg
C     NOCHECK 
      DO i = 1, n, 1
        j = brt(i)
        IF (i.LT.j) THEN
          tr = a(1,j)
          ti = a(2,j)
          a(1,j) = a(1,i)
          a(2,j) = a(2,i)
          a(1,i) = tr
          a(2,i) = ti
        ENDIF
      ENDDO
      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
