SUBROUTINE HIGH(F,FHF,LVAR)
#include "param.inc"
#include "mdims.inc"
#include "help.inc"
C
      DIMENSION F(llow:lIhigh,lJ),FHF(lIP1,lJ)
      COMMON /SCRCH1/
     $     FDUM(lIqq,lJ)
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in highs.F::HIGH(...)"
#endif
C
        DO 200 J=1,MJ
        DO 200 I=-ord2+1,MI+ord2
  200   FDUM(I+ORD2,J) = F(I,J)
C
*        CALL BRDHI(FDUM,LVAR)
C
        DO 299 J=1,MJ
        DO 299 I=1,MIP1
  299   FHF(I,J) = 0.
        DO 300 K=1,ORD2
        DO 300 J=1,MJ
        DO 300 I=1,MIP1
  300   FHF(I,J) = FHF(I,J) + FCOEF(K)*
     $          ( FDUM(I+K-1,J) + FDUM(I+ORDER-K,J) )
C 
C
*
*        if ( isweep .eq. 2 .and. jhigh_bound ) then
*        do j=1,mj
*        fhf(mip1,j) = 0.5*(fdum(mi+ord2,j)+fdum(mip1+ord2,j))
*        enddo
c
*
*        endif
C
        RETURN
        END
c
        SUBROUTINE HIGH2(F,FqCORN,LVAR)
#include "param.inc"
#include "global_dims.inc"
#include "mdims.inc"
#include "help.inc"
C
        DIMENSION F(llow:LIhigh,llow:LJhigh),FqCORN(LIP1,LJP1)
        DIMENSION FHF(LIP1,llow:LJhigh)
        DIMENSION FXDUM(llow:liqq,llow:ljqq),
     $       FYDUM(Llow:liqq,llow:ljqq)
        EQUIVALENCE (FXDUM,FYDUM)
C
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in highs.F::HIGH2(...)"
#endif
        DO 200 J=-no2+1,MJ+no2
        DO 200 I=-no2+1,MI+no2
  200   FXDUM(I+ord2,J) = F(I,J)
C
*        CALL IHI2(FXDUM,LVAR)
C
        DO 299 J=-no2+1,MJ+no2
        DO 299 I=1,MIP1
  299   FHF(I,J) = 0.
        DO 300 K=1,ORD2
        DO 300 J=-no2+1,MJ+no2
        DO 300 I=1,MIP1
  300   FHF(I,J) = FHF(I,J) + FCOEF(K)*
     $          ( FXDUM(I+K-1,J) + FXDUM(I+ORDER-K,J) )
C
C
        DO 400 J=-no2+1,MJ+no2
        DO 400 I=1,MIP1
  400   FYDUM(I,J+ord2) = FHF(I,J)
C
*        CALL JHI2(FYDUM,LVAR)
C
        DO 499 J=1,MJP1
        DO 499 I=1,MIP1
  499   FqCORN(I,J) = 0.
        do 500 k=1,ord2
        DO 500 J=1,MJP1
        DO 500 I=1,MIP1
  500   FqCORN(I,J) = FqCORN(I,J) + FCOEF(K)*
     $          ( FYDUM(I,J+K-1) + FYDUM(I,J+ORDER-K) )
C
        RETURN
        END
c
c
      SUBROUTINE XBHI(F,FHF,LVAR)
#include "param.inc"
#include "mdims.inc"
#include "help.inc"
C
      DIMENSION F(llow:lihigh,Llow:ljhigh),FHF(LIP1,LJP1)
      DIMENSION FDUM(LIqq,LJP1)
C
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in highs.F::XBHI(...)"
#endif
      DO 200 J=1,MJP1
      DO 200 I=-no2+1,MI+no2
      FDUM(I+ord2,J) = F(I,J)
  200 continue
C
C
*      call xhi2(fdum,lvar)
C
C
      DO 299 J=1,MJP1
      DO 299 I=1,MIP1
      FHF(I,J) = 0.
 299  continue
c
      DO 300 K=1,ORD2
      DO 300 J=1,MJP1
      DO 300 I=1,MIP1
      FHF(I,J) = FHF(I,J) + FCOEF(K)*
     $    ( FDUM(I+K-1,J) + FDUM(I+ORDER-K,J) )
 300    continue
      RETURN
      END
        SUBROUTINE YBHI(F,FHF,LVAR)
#include "param.inc"
#include "global_dims.inc"
#include "mdims.inc"
#include "help.inc"
C
        DIMENSION F(Llow:lihigh,llow:LJhigh),FHF(LIP1,LJP1)
        DIMENSION FDUM(LIP1,LJqq)
C
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in highs.F::YBHI(...)"
#endif
        DO 200 J=-no2+1,mj+no2
        DO 200 I=1,MIP1
  200   FDUM(I,J+ORD2) = F(I,J)
C
C
*        call yhi2(fdum,lvar)
C
        DO 299 J=1,MJP1
        DO 299 I=1,MIP1
  299   FHF(I,J) = 0.
        do 300 k=1,ORD2
        DO 300 J=1,MJP1
        DO 300 I=1,MIP1
  300   FHF(I,J) = FHF(I,J) + FCOEF(K)*
     $          ( FDUM(I,J+K-1) + FDUM(I,J+ORDER-K) )
C
        RETURN
        END