SUBROUTINE W3FM07(FIN,FOUT,CWORK,GAMMA,NCOL,NROW)
C$$$  SUBROUTINE DOCUMENTATION BLOCK ***
C
C SUBR: W3FM07   - NINE-POINT SMOOTHER FOR RECTANGULAR GRIDS
C   AUTHOR: CHASE, P.          ORG: W345          DATE:    APR 75
C
C ABSTRACT: SMOOTHS DATA ON A RECTANGULAR GRID USING A NINE-POINT
C   SMOOTHING OPERATOR.
C
C PROGRAM HISTORY LOG:
C   75-04-01  P.CHASE
C   84-07-01  R.E.JONES   CHANGE TO IBM VS FORTRAN
C   91-04-24  R.E.JONES   CHANGE TO CRAY CFT77 FORTRAN
C
C USAGE: CALL W3FM07 (FIN, FOUT, CWORK, GAMMA, NCOL, NROW)
C
C   INPUT:
C     '   FIN' - REAL   SIZE(NCOL*NROW) ARRAY OF DATA TO BE SMOOTHED
C     ' CWORK' - REAL   SIZE(2*NCOL*(NROW+2)) WORK ARRAY
C     ' GAMMA' - COMPLEX SMOOTHING PARAMETER. THE IMAGINARY PART MUST
C                BE POSITIVE.
C     '  NCOL' - INTEGER   NUMBER OF COLUMNS IN THE GRID
C     '  NROW' - INTEGER   NUMBER OF ROWS IN THE GRID
C   OUTPUT:
C     '  FOUT' - REAL   SIZE(NCOL*NROW) ARRAY OF SMOOTHED DATA. MAY
C                BE THE SAME ARRAY AS 'FIN' OR OVERLAP IT IN ANY
C                FASHION.
C
C   EXIT STATES: NONE
C
C   EXTERNAL REFERENCES: NONE
C
C ATTRIBUTES:
C   LANGUAGE: CRAY CFT77 FORTRAN
C   MACHINE:  CRAY Y-MP8/832
C
C$$$
C
      REAL    FIN(NCOL,NROW)
      REAL    FOUT(NCOL,NROW)
C
      COMPLEX CWORK(NCOL,*),GAMMA,GAMMX,GAMA,GAMB,GAMC
C
      GAMMX  = GAMMA
      XSWTCH = AIMAG(GAMMX)
      NCOLM  = NCOL-1
      NROWM  = NROW-1
C
C INITIALIZE WORK ARRAY.  WORK ARRAY STARTS UP TWO ROWS SO IT CAN SMOOTH
C DOWNWARD WITHOUT OVERLAP OF SMOOTHED AND UNSMOOTHED DATA
C
      DO 10 J = 1,NROW
      DO 10 I = 1,NCOL
        CWORK(I,J+2) = CMPLX(FIN(I,J),0.)
 10   CONTINUE
      IF (XSWTCH .EQ. 0.) GO TO 30
      DO 20 J = 1,NROW,NROWM
        JJ = J+ISIGN(1,NROWM-J)
      DO 20 I = 1,NCOL,NCOLM
        II = I+ISIGN(1,NCOLM-I)
        CWORK(I,J+2) = CMPLX(FIN(I,JJ)+FIN(II,J)-FIN(II,JJ),0.)
 20   CONTINUE
C
C SET SMOOTHING OPERATORS
C
 30   GAMA = 0.50 * GAMMX * (1.0 - GAMMX)
      GAMB = 0.25 * GAMMX * GAMMX
      GAMC = 0.50 * GAMMX
C
C SMOOTH WORK ARRAY, PUTTING SMOOTHED POINTS DOWN TWO ROWS
C
      CWORK(1,1) = CWORK(1,3)
      CWORK(NCOL,1) = CWORK(NCOL,3)
      DO 40 I = 2,NCOLM
      CWORK(I,1) = CWORK(I,3)+GAMC*(CWORK(I-1,3)-2.*CWORK(I,3)+
     & CWORK(I+1,3))
 40   CONTINUE
      DO 60 J = 2,NROWM
      DO 50 I = 1,NCOL,NCOLM
      CWORK(I,J) = CWORK(I,J+2)+GAMC*(CWORK(I,J+1)-2.*CWORK(I,J+2)+
     & CWORK(I,J+3))
 50   CONTINUE
      DO 60 I = 2,NCOLM
      CWORK(I,J) = CWORK(I,J+2)+GAMA*(CWORK(I+1,J+2)+CWORK(I-1,J+2)+
     & CWORK(I,J+1)+CWORK(I,J+3)-4.*CWORK(I,J+2))+GAMB*(CWORK(I-1,J+1)+
     & CWORK(I+1,J+1)+CWORK(I-1,J+3)+CWORK(I+1,J+3)-4.*CWORK(I,J+2))
 60   CONTINUE
      CWORK(1,NROW) = CWORK(1,NROW+2)
      CWORK(NCOL,NROW) = CWORK(NCOL,NROW+2)
      DO 70 I = 2,NCOLM
      CWORK(I,NROW) = CWORK(I,NROW+2)+GAMC*(CWORK(I-1,NROW+2)-2.*
     & CWORK(I,NROW+2)+CWORK(I+1,NROW+2))
 70   CONTINUE
C
C IF IMAGINARY PART OF SMOOTHING PARAMETER IS NOT POSITIVE, DONE
C
      IF (XSWTCH .LE. 0.) GO TO 90
C
C OTHERWISE MOVE WORK ARRAY BACK UP TWO ROWS
C
      DO 80 JJ=1,NROW
      J = NROW+1-JJ
      DO 80 I=1,NCOL
      CWORK(I,J+2) = CWORK(I,J)
 80   CONTINUE
C
C SET SMOOTHING PARAMETER FOR CONJUGATE PASS AND GO DO IT
C
      GAMMX  = CONJG(GAMMX)
      XSWTCH = AIMAG(GAMMX)
      GO TO 30
C
C DONE.  OUTPUT SMOOTH ARRAY
C
 90   DO 100 J = 1,NROW
      DO 100 I = 1,NCOL
        FOUT(I,J) = REAL(CWORK(I,J))
 100  CONTINUE
      RETURN
      END