C     Fx compiler version 2.0
CC    TEMPLATE t(120)
CC    ALIGN outimg(I,J) WITH t(I)
CC    ALIGN inimg(I,J) WITH t(I)
CC    DISTRIBUTE t(BLOCK(4))
C     inrows = 30
C     incols = 30
C     outrows = 120
C     outcols = 120
C     CALL genimg(inimg)
C     CALL resample(inimg,inrows,incols,6.2831799999999998,outimg,
C    $outrows,outcols,4.,0.,0.)
C     CALL printimg(outimg,outcols,outrows,256)
C     END
      PROGRAM main
      INTEGER outrows
      INTEGER fxcellid
      EXTERNAL resample
      EXTERNAL printimg
      EXTERNAL fx_procstart
      EXTERNAL fx_deinit
      INTEGER fxdistarg
      EXTERNAL genimg
      EXTERNAL getarg
      INTEGER incols
      EXTERNAL msg_reduce
      EXTERNAL fxinitdesc
      INTEGER inrows
      CHARACTER*256 fx_executable_name
      EXTERNAL fx_init
      INTEGER outcols
      INTEGER fxoutimgdesc(71,2)
      REAL inimg(30,120)
      REAL outimg(30,120)
      INTEGER fxinimgdesc(71,2)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL getarg(0,fx_executable_name)
      CALL fx_init(fxcellid,1,0,0,0,4,fx_executable_name)
      fxdistarg = 0
C     TEMPLATE t(120)
C     ALIGN outimg(I,J) WITH t(I)
C     ALIGN inimg(I,J) WITH t(I)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdesc(1,2,fxdistarray,fxinimgdesc)
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdesc(1,2,fxdistarray,fxoutimgdesc)
      inrows = 30
      incols = 30
      outrows = 120
      outcols = 120
      fxdistarg = 1
      CALL genimg(inimg,fxinimgdesc)
      fxdistarg = 1
      CALL resample(inimg,inrows,incols,6.2831799999999998,outimg,
     $outrows,outcols,4.,0.,0.,fxinimgdesc,(-1),(-1),(-1),
     $fxoutimgdesc,(-1),(-1),(-1),(-1),(-1))
      fxdistarg = 1
      CALL printimg(outimg,outcols,outrows,256,fxoutimgdesc,(-1),(-1)
     $,(-1))
      CALL fx_deinit()
      END
CC    TEMPLATE t(120)
CC    ALIGN intermediate(I,J) WITH t(I)
CC    ALIGN outimg(I,J) WITH t(I)
CC    ALIGN inimg(I,J) WITH t(I)
CC    DISTRIBUTE t(BLOCK(4))
C     IF (scalefreq.LT.1.) THEN
C     samplefreqtopass = (insampfreq * scalefreq)
C     ELSE
C     samplefreqtopass = insampfreq
C     ENDIF
C     WRITE (unit=6,fmt=*) 'About to call convolve rows'
C     CALL convolverows(inimg,inrows,incols,offsetx,scalefreq,outcols
C    $,intermediate,samplefreqtopass)
C     WRITE (unit=6,fmt=*) 
C    $'Returned from convolve rows and doing transpose'
C     IDXPERM(intermediate,1,2) = IDXPERM(intermediate,2,1)
C     WRITE (unit=6,fmt=*) 
C    $'Finished with transpose, now doing convolution'
C     CALL convolverows(intermediate,outcols,inrows,offsety,scalefreq
C    $,outrows,outimg,samplefreqtopass)
C     WRITE (unit=6,fmt=*) 
C    $'Finished with convolution, now doing final transpose'
C     IDXPERM(outimg,1,2) = IDXPERM(outimg,2,1)
C     WRITE (unit=6,fmt=*) 'Resampling is completed'
C     END
      SUBROUTINE resample(inimg,inrows,incols,insampfreq,outimg,
     $outrows,outcols,scalefreq,offsetx,offsety,fxinimgdesc,
     $fxinrowsdesc,fxincolsdesc,fxinsampfreqdesc,fxoutimgdesc,
     $fxoutrowsdesc,fxoutcolsdesc,fxscalefreqdesc,fxoffsetxdesc,
     $fxoffsetydesc)
      INTEGER outrows
      INTEGER fxindex1
      INTEGER fxindex2
      INTEGER fxprocessor
      INTEGER fxrlast1
      INTEGER fxfirst0
      INTEGER fxfirst1
      INTEGER fxcellid
      INTEGER fxop
      INTEGER fxintermediateslotoff0_0
      EXTERNAL fxcomord
      INTEGER fxcc0
      INTEGER fxcc1
      INTEGER fxbufdataidx
      EXTERNAL fxinitdescck
      INTEGER fxpl1
      INTEGER fxbufoff0
      INTEGER fxbufoff1
      EXTERNAL fx_procstart
      INTEGER fxstride0
      INTEGER fxstride1
      INTEGER fxlmlast0
      INTEGER fxlmlast1
      EXTERNAL convolverows
      REAL samplefreqtopass
      REAL scalefreq
      EXTERNAL fxreceive
      INTEGER fxdistarg
      INTEGER fxrcc1
      INTEGER fxoutimgslotoff0_1
      INTEGER fxlmfirst0
      INTEGER fxlmfirst1
      EXTERNAL fxdblcheck
      INTEGER incols
      EXTERNAL fxsend
      EXTERNAL msg_reduce
      EXTERNAL fxcl_inita
      INTEGER fxfrom
      EXTERNAL fxinitdesc
      INTEGER inrows
      EXTERNAL fxlr_initd
      REAL insampfreq
      INTEGER fxindextmp
      INTEGER fxlast0
      INTEGER fxlast1
      EXTERNAL ifxshould_received
      INTEGER ifxshould_received
      INTEGER fxlmstride0
      INTEGER fxlmstride1
      EXTERNAL fxalloc
      INTEGER fxalloc
      INTEGER fxidiotic3_0
      EXTERNAL fx_sync
      REAL offsetx
      REAL offsety
      EXTERNAL fxdistcheck
      INTEGER outcols
      EXTERNAL fxallocinit
      INTEGER fxallocinit
      INTEGER fxslice0
      INTEGER fxslice1
      INTEGER fxbuffer(1)
      REAL intermediate(30,120)
      INTEGER fxincolsdesc(71,1)
      INTEGER fxoutimgdesc(71,2)
      INTEGER fxinrowsdesc(71,1)
      INTEGER fxinsampfreqdesc(71,1)
      REAL inimg(30,120)
      COMPLEX fxcbuffer(1)
      DOUBLE PRECISION fxdbuffer(1)
      LOGICAL fxlbuffer(1)
      REAL fxrbuffer(1)
      INTEGER fxoffsetxdesc(71,1)
      INTEGER fxoffsetydesc(71,1)
      INTEGER fxoutcolsdesc(71,1)
      INTEGER fxoutrowsdesc(71,1)
      DOUBLE COMPLEX fxdcbuffer(1)
      INTEGER fxreceived(4)
      REAL outimg(30,120)
      INTEGER fxintermediatedesc(71,2)
      INTEGER fxinimgdesc(71,2)
      INTEGER fxscalefreqdesc(71,1)
      INTEGER fxdistarray(6,20)
      EQUIVALENCE (fxbuffer,fxrbuffer)
      EQUIVALENCE (fxbuffer,fxlbuffer)
      EQUIVALENCE (fxbuffer,fxdbuffer)
      EQUIVALENCE (fxbuffer,fxcbuffer)
      EQUIVALENCE (fxbuffer,fxdcbuffer)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'resample')
      fxdistarg = 0
      CALL fxdistcheck(fxoffsetydesc,0,10,'resample')
      CALL fxdistcheck(fxoffsetxdesc,0,9,'resample')
      CALL fxdistcheck(fxscalefreqdesc,0,8,'resample')
      CALL fxdistcheck(fxoutcolsdesc,0,7,'resample')
      CALL fxdistcheck(fxoutrowsdesc,0,6,'resample')
      CALL fxdistcheck(fxoutimgdesc,1,5,'resample')
      CALL fxdistcheck(fxinsampfreqdesc,0,4,'resample')
      CALL fxdistcheck(fxincolsdesc,0,3,'resample')
      CALL fxdistcheck(fxinrowsdesc,0,2,'resample')
      CALL fxdistcheck(fxinimgdesc,1,1,'resample')
      fxbufoff1 = fxallocinit(fxbuffer,3604)
      fxoutimgslotoff0_1 = fxalloc(outimg,14400,2)
      fxbufoff0 = fxallocinit(fxbuffer,3604)
      fxintermediateslotoff0_0 = fxalloc(intermediate,14400,2)
C     TEMPLATE t(120)
C     ALIGN intermediate(I,J) WITH t(I)
C     ALIGN outimg(I,J) WITH t(I)
C     ALIGN inimg(I,J) WITH t(I)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdescck(1,2,fxdistarray,fxinimgdesc,'inimg',
     $'resample')
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdescck(1,2,fxdistarray,fxoutimgdesc,'outimg',
     $'resample')
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdesc(1,2,fxdistarray,fxintermediatedesc)
      IF (scalefreq.LT.1.) THEN
        samplefreqtopass = (insampfreq * scalefreq)
      ELSE
        samplefreqtopass = insampfreq
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'About to call convolve rows'
      ENDIF
      fxdistarg = 1
      CALL convolverows(inimg,inrows,incols,offsetx,scalefreq,outcols
     $,intermediate,samplefreqtopass,fxinimgdesc,(-1),(-1),(-1),(-1),
     $(-1),fxintermediatedesc,(-1))
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 
     $'Returned from convolve rows and doing transpose'
      ENDIF
      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(fxintermediatedesc((fxprocessor + 8),1),1
     $), (MIN((fxintermediatedesc((fxprocessor + 8),1) + 29),120)), 1
            DO fxslice1 = 1, 30, 1
              fxrbuffer((fxbufoff0 + fxbufdataidx)) = intermediate(
     $fxslice1,fxslice0)
              fxbufdataidx = (fxbufdataidx + 1)
            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,fxintermediatedesc
     $((fxcellid + 8),2),fxintermediatedesc((fxprocessor + 8),1),120,
     $1,1,120,30,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,fxrlast1,fxlmlast1,fxrcc1,1,1,
     $120,30,120,1,1,fxintermediatedesc((fxcellid + 8),2),
     $fxintermediatedesc((fxfrom + 8),1),fxpl1)
              DO fxslice0 = 1, 30, 1
                DO fxslice1 = fxpl1, fxlmlast1, 1
                  intermediate((fxintermediateslotoff0_0 + fxslice0),
     $fxslice1) = fxrbuffer((fxbufoff0 + fxbufdataidx))
                  fxbufdataidx = (fxbufdataidx + 1)
                ENDDO
              ENDDO
              fxreceived((fxfrom + 1)) = 1
              IF (fxfrom.NE.fxprocessor) THEN
                GOTO 99999 
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDDO
      CALL fxcl_inita(0,1,1,fxlast0,fxlmlast0,fxcc0,1,
     $fxintermediatedesc((fxcellid + 8),1),120,1,30,fxfirst0,
     $fxlmfirst0)
      CALL fxcl_inita(0,1,1,fxlast1,fxlmlast1,fxcc1,1,
     $fxintermediatedesc((fxcellid + 8),2),120,1,120,fxfirst1,
     $fxlmfirst1)
      DO fxindex1 = fxlmfirst0, fxlmlast0, 1
        DO fxindex2 = fxlmfirst1, fxlmlast1, 1
          intermediate(fxindex1,fxindex2) = intermediate((
     $fxintermediateslotoff0_0 + fxindex1),fxindex2)
        ENDDO
      ENDDO
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 
     $'Finished with transpose, now doing convolution'
      ENDIF
      fxdistarg = 1
      CALL convolverows(intermediate,outcols,inrows,offsety,scalefreq
     $,outrows,outimg,samplefreqtopass,fxintermediatedesc,(-1),(-1),
     $(-1),(-1),(-1),fxoutimgdesc,(-1))
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 
     $'Finished with convolution, now doing final transpose'
      ENDIF
      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((fxbufoff1 + 1)) = fxcellid
          fxbufdataidx = 2
          DO fxslice0 = MAX(fxoutimgdesc((fxprocessor + 8),1),1), (
     $MIN((fxoutimgdesc((fxprocessor + 8),1) + 29),120)), 1
            DO fxslice1 = 1, 30, 1
              fxrbuffer((fxbufoff1 + fxbufdataidx)) = outimg(fxslice1
     $,fxslice0)
              fxbufdataidx = (fxbufdataidx + 1)
            ENDDO
          ENDDO
          IF (fxbufdataidx.GT.2) THEN
            CALL fxsend(fxprocessor,fxbuffer((fxbufoff1 + 1)),(
     $fxbufdataidx + (-1)))
          ENDIF
        ELSE
          IF (fxreceived((fxprocessor + 1)).EQ.0) THEN
            IF (ifxshould_received(fxprocessor,1,1,fxoutimgdesc((
     $fxcellid + 8),2),fxoutimgdesc((fxprocessor + 8),1),120,1,1,120,
     $30,1).NE.0) THEN
99998         IF (fxprocessor.NE.fxcellid) THEN
                CALL fxreceive(fxbuffer((fxbufoff1 + 1)),fxprocessor)
              ENDIF
              fxfrom = fxbuffer((fxbufoff1 + 1))
              fxbufdataidx = 2
              CALL fxlr_initd(131136,fxrlast1,fxlmlast1,fxrcc1,1,1,
     $120,30,120,1,1,fxoutimgdesc((fxcellid + 8),2),fxoutimgdesc((
     $fxfrom + 8),1),fxpl1)
              DO fxslice0 = 1, 30, 1
                DO fxslice1 = fxpl1, fxlmlast1, 1
                  outimg((fxoutimgslotoff0_1 + fxslice0),fxslice1) = 
     $fxrbuffer((fxbufoff1 + fxbufdataidx))
                  fxbufdataidx = (fxbufdataidx + 1)
                ENDDO
              ENDDO
              fxreceived((fxfrom + 1)) = 1
              IF (fxfrom.NE.fxprocessor) THEN
                GOTO 99998 
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDDO
      CALL fxcl_inita(0,1,1,fxlast0,fxlmlast0,fxcc0,1,fxoutimgdesc((
     $fxcellid + 8),1),120,1,30,fxfirst0,fxlmfirst0)
      CALL fxcl_inita(0,1,1,fxlast1,fxlmlast1,fxcc1,1,fxoutimgdesc((
     $fxcellid + 8),2),120,1,120,fxfirst1,fxlmfirst1)
      DO fxindex1 = fxlmfirst0, fxlmlast0, 1
        DO fxindex2 = fxlmfirst1, fxlmlast1, 1
          outimg(fxindex1,fxindex2) = outimg((fxoutimgslotoff0_1 + 
     $fxindex1),fxindex2)
        ENDDO
      ENDDO
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'Resampling is completed'
      ENDIF
      END
C     IF (x.EQ.0.) THEN
C     sinc = 1.
C     ELSE
C     sinc = (sin(((s / 2) * x)) / (x * 3.14159))
C     ENDIF
C     RETURN 
C     END
      REAL FUNCTION sinc(x,s)
      INTEGER fxcellid
      EXTERNAL fx_procstart
      REAL s
      REAL x
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      EXTERNAL msg_reduce
      INTRINSIC sin
      REAL sin
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,0,'sinc')
      IF (x.EQ.0.) THEN
        sinc = 1.
      ELSE
        sinc = (sin(((s / 2) * x)) / (x * 3.14159))
      ENDIF
      RETURN 
      END
CC    TEMPLATE t(120)
CC    ALIGN outimg(I,J) WITH t(I)
CC    ALIGN inimg(I,J) WITH t(I)
CC    DISTRIBUTE t(BLOCK(4))
C     PDO (i = 1:inrows)
C     PIN inimg(i,:)
C     POUT outimg(i,:)
C     LOCAL
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX(((fxcellid * 30) + 1),1))
C     fxlmidx0 = ifxlm(fxoutimgdesc,0,fxloopstart0)
C     DO i = fxloopstart0, MIN(inrows,((fxcellid * 30) + 30)), 1
C     PBODY
C     DO j = 1, outcols, 1
C     outimg(i,j) = 0.
C     DO k = 1, incols, 1
C     outimg(i,j) = (outimg(i,j) + (inimg(i,k) * sinc((((real(j) / 
C    $scale) - real(k)) + offset),sampfreq)))
C     ENDDO
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     END
      SUBROUTINE convolverows(inimg,inrows,incols,offset,scale,
     $outcols,outimg,sampfreq,fxinimgdesc,fxinrowsdesc,fxincolsdesc,
     $fxoffsetdesc,fxscaledesc,fxoutcolsdesc,fxoutimgdesc,
     $fxsampfreqdesc)
      INTEGER fxlmidx0
      INTRINSIC real
      REAL real
      EXTERNAL sinc
      REAL sinc
      INTEGER fxcellid
      REAL sampfreq
      INTEGER fxloopstart0
      EXTERNAL fxinitdescck
      INTEGER i
      INTEGER j
      INTEGER k
      EXTERNAL fx_procstart
      REAL scale
      INTRINSIC float
      REAL float
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      REAL offset
      INTEGER incols
      EXTERNAL msg_reduce
      INTEGER inrows
      EXTERNAL ifxceil
      INTEGER ifxceil
      EXTERNAL fxdistcheck
      INTEGER outcols
      INTEGER fxoffsetdesc(71,1)
      INTEGER fxincolsdesc(71,1)
      INTEGER fxoutimgdesc(71,2)
      INTEGER fxinrowsdesc(71,1)
      REAL inimg(30,120)
      INTEGER fxoutcolsdesc(71,1)
      REAL outimg(30,120)
      INTEGER fxsampfreqdesc(71,1)
      INTEGER fxscaledesc(71,1)
      INTEGER fxinimgdesc(71,2)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'convolverows')
      fxdistarg = 0
      CALL fxdistcheck(fxsampfreqdesc,0,8,'convolverows')
      CALL fxdistcheck(fxoutimgdesc,1,7,'convolverows')
      CALL fxdistcheck(fxoutcolsdesc,0,6,'convolverows')
      CALL fxdistcheck(fxscaledesc,0,5,'convolverows')
      CALL fxdistcheck(fxoffsetdesc,0,4,'convolverows')
      CALL fxdistcheck(fxincolsdesc,0,3,'convolverows')
      CALL fxdistcheck(fxinrowsdesc,0,2,'convolverows')
      CALL fxdistcheck(fxinimgdesc,1,1,'convolverows')
C     TEMPLATE t(120)
C     ALIGN outimg(I,J) WITH t(I)
C     ALIGN inimg(I,J) WITH t(I)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdescck(1,2,fxdistarray,fxinimgdesc,'inimg',
     $'convolverows')
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdescck(1,2,fxdistarray,fxoutimgdesc,'outimg',
     $'convolverows')
C     PDO (i = 1:inrows)
C     PIN inimg(i,:)
C     POUT outimg(i,:)
C     LOCAL
      IF (fxcellid.LT.4) THEN
        fxloopstart0 = (MAX(((fxcellid * 30) + 1),1))
        fxlmidx0 = ifxlm(fxoutimgdesc,0,fxloopstart0)
        DO i = fxloopstart0, MIN(inrows,((fxcellid * 30) + 30)), 1
C     PBODY
          DO j = 1, outcols, 1
            outimg(fxlmidx0,j) = 0.
            DO k = 1, incols, 1
              outimg(fxlmidx0,j) = (outimg(fxlmidx0,j) + (inimg(
     $fxlmidx0,k) * sinc((((real(j) / scale) - real(k)) + offset),
     $sampfreq)))
            ENDDO
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     ENDPDO
      END
CC    TEMPLATE t(120)
CC    ALIGN img(I,J) WITH t(I)
CC    DISTRIBUTE t(BLOCK(4))
C     img = 0.
C     PDO (i = 10:20)
C     PINOUT img(i,:)
C     LOCAL
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX(((fxcellid * 30) + 1),10))
C     fxlmidx0 = ifxlm(fximgdesc,0,fxloopstart0)
C     DO i = fxloopstart0, MIN(((fxcellid * 30) + 30),20), 1
C     PBODY
C     DO j = 10, 20, 1
C     img(i,j) = 1.
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     ENDPDO
C     END
      SUBROUTINE genimg(img,fximgdesc)
      INTEGER fxindex1
      INTEGER fxindex2
      INTEGER fxlmidx0
      INTEGER fxfirst0
      INTEGER fxfirst1
      INTEGER fxcellid
      INTEGER fxloopstart0
      INTEGER fxcc0
      INTEGER fxcc1
      EXTERNAL fxinitdescck
      INTEGER i
      INTEGER j
      EXTERNAL fx_procstart
      INTEGER fxstride0
      INTEGER fxstride1
      INTEGER fxlmlast0
      INTEGER fxlmlast1
      INTRINSIC float
      REAL float
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      EXTERNAL fxdblcheck
      INTEGER fxlmfirst0
      INTEGER fxlmfirst1
      EXTERNAL msg_reduce
      EXTERNAL fxcl_inita
      INTEGER fxlast0
      INTEGER fxlast1
      INTEGER fxlmstride0
      INTEGER fxlmstride1
      EXTERNAL ifxceil
      INTEGER ifxceil
      EXTERNAL fxdistcheck
      INTEGER fximgdesc(71,2)
      REAL img(30,120)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'genimg')
      fxdistarg = 0
      CALL fxdistcheck(fximgdesc,1,1,'genimg')
C     TEMPLATE t(120)
C     ALIGN img(I,J) WITH t(I)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdescck(1,2,fxdistarray,fximgdesc,'img','genimg')
      CALL fxcl_inita(0,1,1,fxlast0,fxlmlast0,fxcc0,1,fximgdesc((
     $fxcellid + 8),1),120,1,30,fxfirst0,fxlmfirst0)
      CALL fxcl_inita(0,1,1,fxlast1,fxlmlast1,fxcc1,1,fximgdesc((
     $fxcellid + 8),2),120,1,120,fxfirst1,fxlmfirst1)
      DO fxindex1 = fxlmfirst0, fxlmlast0, 1
        DO fxindex2 = fxlmfirst1, fxlmlast1, 1
          img(fxindex1,fxindex2) = 0.
        ENDDO
      ENDDO
C     PDO (i = 10:20)
C     PINOUT img(i,:)
C     LOCAL
      IF (fxcellid.LT.4) THEN
        fxloopstart0 = (MAX(((fxcellid * 30) + 1),10))
        fxlmidx0 = ifxlm(fximgdesc,0,fxloopstart0)
        DO i = fxloopstart0, MIN(((fxcellid * 30) + 30),20), 1
C     PBODY
          DO j = 10, 20, 1
            img(fxlmidx0,j) = 1.
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     ENDPDO
      END
CC    TEMPLATE t(120)
CC    ALIGN img(I,J) WITH t(I)
CC    DISTRIBUTE t(BLOCK(4))
C     PDO (i = 1:rows)
C     PIN img(i,:)
C     PMERGEVARS minimum,maximum
C     PCOMMUTATIVE
C     LOCAL
C     PINIT
C     minimum = 9999999.
C     maximum = (-9999999.)
C     IF (fxcellid.LT.4) THEN
C     fxloopstart0 = (MAX(((fxcellid * 30) + 1),1))
C     fxlmidx0 = ifxlm(fximgdesc,0,fxloopstart0)
C     DO i = fxloopstart0, MIN(rows,((fxcellid * 30) + 30)), 1
C     PBODY
C     DO j = 1, cols, 1
C     IF (img(i,j).LT.minimum) THEN
C     minimum = img(i,j)
C     ENDIF
C     IF (img(i,j).GT.maximum) THEN
C     maximum = img(i,j)
C     ENDIF
C     ENDDO
C     fxlmidx0 = (fxlmidx0 + 1)
C     ENDDO
C     ENDIF
C     ENDLOCAL
C     PMERGE
C     DO fxp2_mergedepth = 1, 0, (-1)
C     fxp2_idle = fxmerge_step(maximum,fxp2_rt_maximum,1,
C    $fxp2_mergedepth)
C     fxp2_idle = fxmerge_step(minimum,fxp2_rt_minimum,1,
C    $fxp2_mergedepth)
C     IF (fxp2_idle.NE.0) THEN
C     fxp2_lt_maximum = maximum
C     fxp2_lt_minimum = minimum
C     minimum = min(fxp2_lt_minimum,fxp2_rt_minimum)
C     maximum = max(fxp2_lt_maximum,fxp2_rt_maximum)
C     ENDIF
C     ENDDO
C     CALL fxmerge_broadcast(maximum,1)
C     CALL fxmerge_broadcast(minimum,1)
C     ENDPDO
C     IF (minimum.LT.0.) THEN
C     offset = ( -minimum)
C     ELSE
C     offset = 0.
C     ENDIF
C     scale = (real(numoutlevs) / (maximum + offset))
C     WRITE (unit=6,fmt=*) 'P2'
C     WRITE (unit=6,fmt=*) '#Generated by resamp2d'
C     WRITE (unit=6,fmt=*) cols,rows
C     WRITE (unit=6,fmt=*) numoutlevs + (-1)
C     DO i = 1, rows, 1
C     DO j = 1, cols, 1
C     WRITE (unit=6,fmt=*) min(int(((img(i,j) + offset) * scale)),(
C    $numoutlevs + (-1)))
C     ENDDO
C     ENDDO
C     END
      SUBROUTINE printimg(img,cols,rows,numoutlevs,fximgdesc,
     $fxcolsdesc,fxrowsdesc,fxnumoutlevsdesc)
      INTEGER fxlmidx0
      INTRINSIC real
      REAL real
      REAL rfxtemp0
      EXTERNAL left
      REAL left
      INTEGER cols
      INTEGER fxcellid
      INTEGER rows
      INTEGER fxloopstart0
      EXTERNAL fxinitdescck
      EXTERNAL fxmerge_step
      INTEGER fxmerge_step
      INTEGER fxp2_idle
      INTEGER i
      INTEGER j
      EXTERNAL fx_procstart
      REAL scale
      INTRINSIC float
      REAL float
      EXTERNAL right
      REAL right
      EXTERNAL ifxlm
      INTEGER ifxlm
      INTEGER fxdistarg
      EXTERNAL fxmerge_broadcast
      EXTERNAL ifxownsol
      INTEGER ifxownsol
      EXTERNAL fxdblcheck
      REAL offset
      EXTERNAL msg_reduce
      INTEGER numoutlevs
      INTRINSIC min
      REAL min
      INTRINSIC max
      REAL max
      INTRINSIC int
      INTEGER int
      INTEGER fxp2_mergedepth
      EXTERNAL ifxceil
      INTEGER ifxceil
      REAL fxp2_lt_minimum
      REAL fxp2_lt_maximum
      REAL minimum
      REAL maximum
      REAL fxp2_rt_minimum
      REAL fxp2_rt_maximum
      EXTERNAL fxbroadcast
      EXTERNAL fxdistcheck
      EXTERNAL fxreceive_bcast
      EXTERNAL ifxowns
      INTEGER ifxowns
      INTEGER fximgdesc(71,2)
      INTEGER fxnumoutlevsdesc(71,1)
      INTEGER fxcolsdesc(71,1)
      INTEGER fxrowsdesc(71,1)
      REAL img(30,120)
      INTEGER fxdistarray(6,20)
      COMMON /fxcommon/ fxcellid,fxdistarg
      CALL fxdblcheck(fxdistarg,1,'printimg')
      fxdistarg = 0
      CALL fxdistcheck(fxnumoutlevsdesc,0,4,'printimg')
      CALL fxdistcheck(fxrowsdesc,0,3,'printimg')
      CALL fxdistcheck(fxcolsdesc,0,2,'printimg')
      CALL fxdistcheck(fximgdesc,1,1,'printimg')
C     TEMPLATE t(120)
C     ALIGN img(I,J) WITH t(I)
C     DISTRIBUTE t(BLOCK(4))
      fxdistarray(1,1) = 1
      fxdistarray(2,1) = 0
      fxdistarray(3,1) = 30
      fxdistarray(4,1) = 4
      fxdistarray(5,1) = 0
      fxdistarray(6,1) = 0
      fxdistarray(3,2) = 120
      CALL fxinitdescck(1,2,fxdistarray,fximgdesc,'img','printimg')
C     PDO (i = 1:rows)
C     PIN img(i,:)
C     PMERGEVARS minimum,maximum
C     PCOMMUTATIVE
C     LOCAL
C     PINIT
      minimum = 9999999.
      maximum = (-9999999.)
      IF (fxcellid.LT.4) THEN
        fxloopstart0 = (MAX(((fxcellid * 30) + 1),1))
        fxlmidx0 = ifxlm(fximgdesc,0,fxloopstart0)
        DO i = fxloopstart0, MIN(rows,((fxcellid * 30) + 30)), 1
C     PBODY
          DO j = 1, cols, 1
            IF (img(fxlmidx0,j).LT.minimum) THEN
              minimum = img(fxlmidx0,j)
            ENDIF
            IF (img(fxlmidx0,j).GT.maximum) THEN
              maximum = img(fxlmidx0,j)
            ENDIF
          ENDDO
          fxlmidx0 = (fxlmidx0 + 1)
        ENDDO
      ENDIF
C     ENDLOCAL
C     PMERGE
      DO fxp2_mergedepth = 1, 0, (-1)
        fxp2_idle = fxmerge_step(maximum,fxp2_rt_maximum,1,
     $fxp2_mergedepth)
        fxp2_idle = fxmerge_step(minimum,fxp2_rt_minimum,1,
     $fxp2_mergedepth)
        IF (fxp2_idle.NE.0) THEN
          fxp2_lt_maximum = maximum
          fxp2_lt_minimum = minimum
          minimum = min(fxp2_lt_minimum,fxp2_rt_minimum)
          maximum = max(fxp2_lt_maximum,fxp2_rt_maximum)
        ENDIF
      ENDDO
      CALL fxmerge_broadcast(maximum,1)
      CALL fxmerge_broadcast(minimum,1)
C     ENDPDO
      IF (minimum.LT.0.) THEN
        offset = ( -minimum)
      ELSE
        offset = 0.
      ENDIF
      scale = (real(numoutlevs) / (maximum + offset))
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) 'P2'
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) '#Generated by resamp2d'
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) cols,rows
      ENDIF
      IF (fxcellid.EQ.0) THEN
        WRITE (unit=6,fmt=*) numoutlevs + (-1)
      ENDIF
      DO i = 1, rows, 1
        DO j = 1, cols, 1
          IF (ifxowns(fximgdesc,0,i,fxcellid).NE.0) THEN
            rfxtemp0 = img(ifxlm(fximgdesc,0,i),j)
            CALL fxbroadcast(rfxtemp0,1)
          ELSE
            CALL fxreceive_bcast(rfxtemp0,1)
          ENDIF
          IF (fxcellid.EQ.0) THEN
            WRITE (unit=6,fmt=*) min(int(((rfxtemp0 + offset) * scale
     $)),(numoutlevs + (-1)))
          ENDIF
        ENDDO
      ENDDO
      END
C     END
      SUBROUTINE fx_getarrayinfo()
      INTEGER fxcellid
      EXTERNAL fx_procstart
      INTEGER fxdistarg
      COMMON /fxcommon/ fxcellid,fxdistarg
      END
