#INCLUDE 'MR_H_ALIGN_PADDING.H'
!***********************************************************************************************************************************
! UNIT:
!
!  (MODULE) MOD_INTERP_XY
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  MODULE MR_MOD_INTERP_XY

    USE MR_KINDS

    USE MR_DEF_ACTIVITY

    IMPLICIT NONE

    PRIVATE

    PUBLIC :: MR_INTERP_XY_UV_U_BY_RCPRAC
    PUBLIC :: MR_INTERP_XY_UV_U_BY_LINEAR
    PUBLIC :: MR_INTERP_XY_UV_U_TO_GET_V_AT_U
    PUBLIC :: MR_INTERP_XY_SS_U
    PUBLIC :: MR_INTERP_XY_UV_O_U
    PUBLIC :: MR_INTERP_XY_SS_O_U
    PUBLIC :: MR_INV_INTERP_XY_UV_FROM_UU
    PUBLIC :: MR_INV_INTERP_XY_SS_FROM_SU

    PUBLIC :: MR_INTERP_XY_UV_V_BY_RCPRAC
    PUBLIC :: MR_INTERP_XY_UV_V_BY_LINEAR
    PUBLIC :: MR_INTERP_XY_UV_V_TO_GET_U_AT_V
    PUBLIC :: MR_INTERP_XY_SS_V
    PUBLIC :: MR_INTERP_XY_UV_O_V
    PUBLIC :: MR_INTERP_XY_SS_O_V
    PUBLIC :: MR_INV_INTERP_XY_UV_FROM_VV
    PUBLIC :: MR_INV_INTERP_XY_SS_FROM_SV

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC( NI , NJ , ZS , ALFA , BETA , U )

    USE MR_DEF_CURVED_GEOS , ONLY : MU
    USE MR_DEF_FIELD_VARS , ONLY : HU

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ    ) :: ZS
    REAL   (CARD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,CARD_KIND),1:NJ,1:2) :: ALFA , BETA

    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ    ) :: U

    INTEGER(IJID_KIND) :: I , J

    DO J = 1 , NJ

      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_BY_RCPRAC_I0_JJ
      !END I = 0

     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_BY_RCPRAC_II_JJ
      END DO

      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_BY_RCPRAC_IN_JJ
      !END I = NI

    END DO

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(I+1, J ) == BEACTIVE .AND. ACTIVITY( P , Q ) == BEACTIVE ) THEN
      U( I , J ) = 0.5 * ( ( ALFA(I+1, J ,1) + ALFA( P , Q ,1) ) * ( ZS(I+1, J ) - ZS( P , Q ) )   &
      + ( BETA(I+1, J ,1) + BETA( P , Q ,1) )   &
      ) / MU( I , J ) / HU( I , J )
    ELSE
      U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY(I+1, J ) == BEACTIVE .AND. ACTIVITY( I , J ) == BEACTIVE ) THEN
      U( I , J ) = 0.5 * ( ( ALFA(I+1, J ,1) + ALFA( I , J ,1) ) * ( ZS(I+1, J ) - ZS( I , J ) )   &
      + ( BETA(I+1, J ,1) + BETA( I , J ,1) )   &
      ) / MU( I , J ) / HU( I , J )
    ELSE
      U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(P+1, Q ) == BEACTIVE .AND. ACTIVITY( I , J ) == BEACTIVE ) THEN
      U( I , J ) = 0.5 * ( ( ALFA(P+1, Q ,1) + ALFA( I , J ,1) ) * ( ZS(P+1, Q ) - ZS( I , J ) )   &
      + ( BETA(P+1, Q ,1) + BETA( I , J ,1) )   &
      ) / MU( I , J ) / HU( I , J )
    ELSE
      U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC_IN_JJ

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_RCPRAC

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR( NI , NJ , UV , U )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ,1:2) :: UV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ    ) :: U

    INTEGER(IJID_KIND) :: I , J

    DO J = 1 , NJ

      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_BY_LINEAR_I0_JJ
      !END I = 0

     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_BY_LINEAR_II_JJ
      END DO

      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_BY_LINEAR_IN_JJ
      !END I = NI

    END DO

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(I+1, J ) == BEACTIVE .AND. ACTIVITY( P , Q ) == BEACTIVE ) THEN
      U( I , J ) = 0.5 * ( UV(I+1, J ,1) + UV( P , Q ,1) )
    ELSE
      U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY(I+1, J ) == BEACTIVE .AND. ACTIVITY( I , J ) == BEACTIVE ) THEN
      U( I , J ) = 0.5 * ( UV(I+1, J ,1) + UV( I , J ,1) )
    ELSE
      U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(P+1, Q ) == BEACTIVE .AND. ACTIVITY( I , J ) == BEACTIVE ) THEN
      U( I , J ) = 0.5 * ( UV(P+1, Q ,1) + UV( I , J ,1) )
    ELSE
      U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR_IN_JJ

  END SUBROUTINE MR_INTERP_XY_UV_U_BY_LINEAR

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U( NI , NJ , UV , V_AT_U )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ,1:2) :: UV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ    ) :: V_AT_U

    REAL   (FDRD_KIND) , PARAMETER   , DIMENSION(                         1:2) :: FACTOR = (/+1.0,-1.0/)

    INTEGER(IJID_KIND) :: I , J

    DO J = 1 , NJ

      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_TO_GET_V_AT_U_I0_JJ
      !END I = 0

     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_TO_GET_V_AT_U_II_JJ
      END DO

      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_U_TO_GET_V_AT_U_IN_JJ
      !END I = NI

    END DO

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(I+1, J ) == BEACTIVE .OR. ACTIVITY( P , Q ) == BEACTIVE ) THEN
      V_AT_U( I , J ) =   &
      ( UV(I+1, J ,2) * ACTIVITY(I+1, J )   &
      + UV( P , Q ,2) * ACTIVITY( P , Q ) * FACTOR(2) )   &
      / ( ACTIVITY(I+1, J ) + ACTIVITY( P , Q ) )
    ELSE
      V_AT_U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY(I+1, J ) == BEACTIVE .OR. ACTIVITY( I , J ) == BEACTIVE ) THEN
      V_AT_U( I , J ) =   &
      ( UV(I+1, J ,2) * ACTIVITY(I+1, J )   &
      + UV( I , J ,2) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY(I+1, J ) + ACTIVITY( I , J ) )
    ELSE
      V_AT_U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(P+1, Q ) == BEACTIVE .OR. ACTIVITY( I , J ) == BEACTIVE ) THEN
      V_AT_U( I , J ) =   &
      ( UV(P+1, Q ,2) * ACTIVITY(P+1, Q ) * FACTOR(2)   &
      + UV( I , J ,2) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY(P+1, Q ) + ACTIVITY( I , J ) )
    ELSE
      V_AT_U( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U_IN_JJ

  END SUBROUTINE MR_INTERP_XY_UV_U_TO_GET_V_AT_U

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_U( NI , NJ , SS , SU )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ) :: SS
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ) :: SU

    INTEGER(IJID_KIND) :: I , J

    DO J = 1 , NJ

      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_U_I0_JJ
      !END I = 0

     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_U_II_JJ
      END DO

      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_U_IN_JJ
      !END I = NI

    END DO

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_U_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(I+1, J ) == BEACTIVE .OR. ACTIVITY( P , Q ) == BEACTIVE ) THEN
      SU( I , J ) =   &
      ( SS(I+1, J ) * ACTIVITY(I+1, J )   &
      + SS( P , Q ) * ACTIVITY( P , Q ) )   &
      / ( ACTIVITY(I+1, J ) + ACTIVITY( P , Q ) )
    ELSE
      SU( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_U_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_U_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY(I+1, J ) == BEACTIVE .OR. ACTIVITY( I , J ) == BEACTIVE ) THEN
      SU( I , J ) =   &
      ( SS(I+1, J ) * ACTIVITY(I+1, J )   &
      + SS( I , J ) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY(I+1, J ) + ACTIVITY( I , J ) )
    ELSE
      SU( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_U_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_U_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(P+1, Q ) == BEACTIVE .OR. ACTIVITY( I , J ) == BEACTIVE ) THEN
      SU( I , J ) =   &
      ( SS(P+1, Q ) * ACTIVITY(P+1, Q )   &
      + SS( I , J ) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY(P+1, Q ) + ACTIVITY( I , J ) )
    ELSE
      SU( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_U_IN_JJ

  END SUBROUTINE MR_INTERP_XY_SS_U

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U( NI , NJ , U , UO )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ    ) :: U
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),0:NJ    ) :: UO

    INTEGER(IJID_KIND) :: I , J

    J = 0
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_I0_J0
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_II_J0
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_IN_J0
      !END I = NI
    !END J = 0

    DO J = 1 , NJ-1
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_I0_JJ
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_II_JJ
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_IN_JJ
      !END I = NI
    END DO

    J = NJ
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_I0_JN
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_II_JN
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_U_IN_JN
      !END I = NI
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_I0_J0

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( P ,Q-1) ) == BEACTIVE ) THEN
      UO( I , J ) = U( I ,J+1)
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_I0_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_II_J0

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( I ,J+1) ) == BEACTIVE ) THEN
      UO( I , J ) = U( I ,J+1)
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_IN_J0

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY( I ,J+1) ) == BEACTIVE ) THEN
      UO( I , J ) = U( I ,J+1)
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_IN_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( P ,Q-1) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY(I+1, J ) .AND. ACTIVITY( P , Q ) ) == BEACTIVE ) THEN
      UO( I , J ) =   &
      ( U( I ,J+1) * ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( P ,Q-1) )   &
      + U( I , J ) * ( ACTIVITY(I+1, J ) .AND. ACTIVITY( P , Q ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( P ,Q-1) )   &
      & + ( ACTIVITY(I+1, J ) .AND. ACTIVITY( P , Q ) ) )
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_II_JJ

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( I ,J+1) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY(I+1, J ) .AND. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      UO( I , J ) =   &
      ( U( I ,J+1) * ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( I ,J+1) )   &
      + U( I , J ) * ( ACTIVITY(I+1, J ) .AND. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY( I ,J+1) )   &
      & + ( ACTIVITY(I+1, J ) .AND. ACTIVITY( I , J ) ) )
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY( I ,J+1) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY(P+1, Q ) .AND. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      UO( I , J ) =   &
      ( U( I ,J+1) * ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY( I ,J+1) )   &
      + U( I , J ) * ( ACTIVITY(P+1, Q ) .AND. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY( I ,J+1) )   &
      & + ( ACTIVITY(P+1, Q ) .AND. ACTIVITY( I , J ) ) )
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_IN_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_I0_JN

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1, J ) .AND. ACTIVITY( P , Q ) ) == BEACTIVE ) THEN
      UO( I , J ) = U( I , J )
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_I0_JN

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_II_JN

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1, J ) .AND. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      UO( I , J ) = U( I , J )
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_II_JN

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_U_IN_JN

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1, Q ) .AND. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      UO( I , J ) = U( I , J )
    ELSE
      UO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_U_IN_JN

  END SUBROUTINE MR_INTERP_XY_UV_O_U

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U( NI , NJ , SU , SUO )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ) :: SU
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),0:NJ) :: SUO

    INTEGER(IJID_KIND) :: I , J

    J = 0
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_I0_J0
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_II_J0
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_IN_J0
      !END I = NI
    !END J = 0

    DO J = 1 , NJ-1
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_I0_JJ
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_II_JJ
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_IN_JJ
      !END I = NI
    END DO

    J = NJ
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_I0_JN
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_II_JN
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_U_IN_JN
      !END I = NI
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_I0_J0

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( P ,Q-1) ) == BEACTIVE ) THEN
      SUO( I , J ) = SU( I ,J+1)
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_I0_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_II_J0

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( I ,J+1) ) == BEACTIVE ) THEN
      SUO( I , J ) = SU( I ,J+1)
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_IN_J0

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY( I ,J+1) ) == BEACTIVE ) THEN
      SUO( I , J ) = SU( I ,J+1)
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_IN_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( P ,Q-1) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY(I+1, J ) .OR. ACTIVITY( P , Q ) ) == BEACTIVE ) THEN
      SUO( I , J ) =   &
      ( SU( I ,J+1) * ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( P ,Q-1) )   &
      + SU( I , J ) * ( ACTIVITY(I+1, J ) .OR. ACTIVITY( P , Q ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( P ,Q-1) )   &
      & + ( ACTIVITY(I+1, J ) .OR. ACTIVITY( P , Q ) ) )
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_II_JJ

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( I ,J+1) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY(I+1, J ) .OR. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      SUO( I , J ) =   &
      ( SU( I ,J+1) * ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( I ,J+1) )   &
      + SU( I , J ) * ( ACTIVITY(I+1, J ) .OR. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY( I ,J+1) )   &
      & + ( ACTIVITY(I+1, J ) .OR. ACTIVITY( I , J ) ) )
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY( I ,J+1) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY(P+1, Q ) .OR. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      SUO( I , J ) =   &
      ( SU( I ,J+1) * ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY( I ,J+1) )   &
      + SU( I , J ) * ( ACTIVITY(P+1, Q ) .OR. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY( I ,J+1) )   &
      & + ( ACTIVITY(P+1, Q ) .OR. ACTIVITY( I , J ) ) )
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_IN_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_I0_JN

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1, J ) .OR. ACTIVITY( P , Q ) ) == BEACTIVE ) THEN
      SUO( I , J ) = SU( I , J )
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_I0_JN

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_II_JN

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1, J ) .OR. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      SUO( I , J ) = SU( I , J )
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_II_JN

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_U_IN_JN

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1, Q ) .OR. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      SUO( I , J ) = SU( I , J )
    ELSE
      SUO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_U_IN_JN

  END SUBROUTINE MR_INTERP_XY_SS_O_U

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INV_INTERP_XY_UV_FROM_UU( NI , NJ , UU , UV )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ,1:2) :: UU
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ,1:2) :: UV

    INTEGER(IJID_KIND) :: I , J
    INTEGER            :: DIM

    DO DIM = 1 , 2

      DO J = 1 , NJ
       !DIR$ VECTOR ALIGNED
        DO I = 1 , NI
          IF( ACTIVITY( I , J ) == BEACTIVE ) THEN
            UV( I , J ,DIM) = 0.5 * ( UU( I , J ,DIM) + UU(I-1, J ,DIM) )
          ELSE
            UV( I , J ,DIM) = 0.0
          END IF
        END DO
      END DO

    END DO

  END SUBROUTINE MR_INV_INTERP_XY_UV_FROM_UU

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INV_INTERP_XY_SS_FROM_SU( NI , NJ , SU , SS )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(0:NI0(NI,FDRD_KIND),1:NJ) :: SU
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ) :: SS

    INTEGER(IJID_KIND) :: I , J

    DO J = 1 , NJ
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
        IF( ACTIVITY( I , J ) == BEACTIVE ) THEN
          SS( I , J ) = 0.5 * ( SU( I , J ) + SU(I-1, J ) )
        ELSE
          SS( I , J ) = 0.0
        END IF
      END DO
    END DO

  END SUBROUTINE MR_INV_INTERP_XY_SS_FROM_SU

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC( NI , NJ , ZS , ALFA , BETA , V )

    USE MR_DEF_CURVED_GEOS , ONLY : MV
    USE MR_DEF_FIELD_VARS , ONLY : HV

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ    ) :: ZS
    REAL   (CARD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,CARD_KIND),1:NJ,1:2) :: ALFA , BETA

    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ    ) :: V

    INTEGER(IJID_KIND) :: I , J

    J = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_BY_RCPRAC_II_J0
      END DO
    !END J = 0

    DO J = 1 , NJ-1
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_BY_RCPRAC_II_JJ
      END DO
    END DO

    J = NJ
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_BY_RCPRAC_II_JN
      END DO
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC_II_J0

    IMPLICIT NONE

    V( I , J ) = 0.0

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY( I ,J+1) == BEACTIVE .AND. ACTIVITY( I , J ) == BEACTIVE ) THEN
      V( I , J ) = 0.5 * ( ( ALFA( I ,J+1,2) + ALFA( I , J ,2) ) * ( ZS( I ,J+1) - ZS( I , J ) )   &
      + ( BETA( I ,J+1,2) + BETA( I , J ,2) )   &
      ) / MV( I , J ) / HV( I , J )
    ELSE
      V( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC_II_JN

    IMPLICIT NONE

    V( I , J ) = 0.0

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC_II_JN

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_RCPRAC

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE) INTERP_XY_UV_V
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR( NI , NJ , UV , V )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ,1:2) :: UV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ    ) :: V

    INTEGER(IJID_KIND) :: I , J

    J = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_BY_LINEAR_II_J0
      END DO
    !END J = 0

    DO J = 1 , NJ-1
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_BY_LINEAR_II_JJ
      END DO
    END DO

    J = NJ
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_BY_LINEAR_II_JN
      END DO
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR_II_J0

    IMPLICIT NONE

    V( I , J ) = 0.0

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY( I ,J+1) == BEACTIVE .AND. ACTIVITY( I , J ) == BEACTIVE ) THEN
      V( I , J ) = 0.5 * ( UV( I ,J+1,2) + UV( I , J ,2) )
    ELSE
      V( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR_II_JN

    IMPLICIT NONE

    V( I , J ) = 0.0

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR_II_JN

  END SUBROUTINE MR_INTERP_XY_UV_V_BY_LINEAR

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V( NI , NJ , UV , U_AT_V )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ,1:2) :: UV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ    ) :: U_AT_V

    INTEGER(IJID_KIND) :: I , J

    J = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_J0
      END DO
    !END J = 0

    DO J = 1 , NJ-1
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_JJ
      END DO
    END DO

    J = NJ
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_JN
      END DO
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_J0

    IMPLICIT NONE

    IF( ACTIVITY( I ,J+1) == BEACTIVE ) THEN
      U_AT_V( I , J ) = UV( I ,J+1,1)
    ELSE
      U_AT_V( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY( I ,J+1) == BEACTIVE .OR. ACTIVITY( I , J ) == BEACTIVE ) THEN
      U_AT_V( I , J ) =   &
      ( UV( I ,J+1,1) * ACTIVITY( I ,J+1)   &
      + UV( I , J ,1) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY( I ,J+1) + ACTIVITY( I , J ) )
    ELSE
      U_AT_V( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_JN

    IMPLICIT NONE

    IF( ACTIVITY( I , J ) == BEACTIVE ) THEN
      U_AT_V( I , J ) = UV( I , J ,1)
    ELSE
      U_AT_V( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V_II_JN

  END SUBROUTINE MR_INTERP_XY_UV_V_TO_GET_U_AT_V

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_V( NI , NJ , SS , SV )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ) :: SS
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ) :: SV

    INTEGER(IJID_KIND) :: I , J

    J = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_V_II_J0
      END DO
    !END J = 0

    DO J = 1 , NJ-1
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_V_II_JJ
      END DO
    END DO

    J = NJ
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_V_II_JN
      END DO
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_V_II_J0

    IMPLICIT NONE

    IF( ACTIVITY( I ,J+1) == BEACTIVE ) THEN
      SV( I , J ) = SS( I ,J+1)
    ELSE
      SV( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_V_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_V_II_JJ

    IMPLICIT NONE

    IF( ACTIVITY( I ,J+1) == BEACTIVE .OR. ACTIVITY( I , J ) == BEACTIVE ) THEN
      SV( I , J ) =   &
      ( SS( I ,J+1) * ACTIVITY( I ,J+1)   &
      + SS( I , J ) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY( I ,J+1) + ACTIVITY( I , J ) )
    ELSE
      SV( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_V_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_V_II_JN

    IMPLICIT NONE

    IF( ACTIVITY( I , J ) == BEACTIVE ) THEN
      SV( I , J ) = SS( I , J )
    ELSE
      SV( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_V_II_JN

  END SUBROUTINE MR_INTERP_XY_SS_V

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_V( NI , NJ , V , VO )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ    ) :: V
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),0:NJ    ) :: VO

    REAL   (FDRD_KIND) , PARAMETER   , DIMENSION(                         1:2) :: FACTOR = (/+1.0,-1.0/)

    INTEGER(IJID_KIND) :: I , J

    J = 0
     !DIR$ VECTOR ALIGNED
      DO I = 0 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_V_II_J0
      END DO
    !END J = 0

    DO J = 1 , NJ-1
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_V_I0_JJ
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_V_II_JJ
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_V_IN_JJ
      !END I = NI
    END DO

    J = NJ
     !DIR$ VECTOR ALIGNED
      DO I = 0 , NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_UV_O_V_II_JN
      END DO
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_V_II_J0

    IMPLICIT NONE

    VO( I , J ) = 0.0

  END SUBROUTINE MR_INTERP_XY_UV_O_V_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_V_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY(I+1, J ) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY( P ,Q-1) .AND. ACTIVITY( P , Q ) ) == BEACTIVE ) THEN
      VO( I , J ) =   &
      ( V(I+1, J ) * ( ACTIVITY(I+1,J+1) .AND. ACTIVITY(I+1, J ) )   &
      + V( P ,Q-1) * ( ACTIVITY( P ,Q-1) .AND. ACTIVITY( P , Q ) ) * FACTOR(2) )   &
      / ( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY(I+1, J ) )   &
      & + ( ACTIVITY( P ,Q-1) .AND. ACTIVITY( P , Q ) ) )
    ELSE
      VO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_V_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_V_II_JJ

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY(I+1, J ) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY( I ,J+1) .AND. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      VO( I , J ) =   &
      ( V(I+1, J ) * ( ACTIVITY(I+1,J+1) .AND. ACTIVITY(I+1, J ) )   &
      + V( I , J ) * ( ACTIVITY( I ,J+1) .AND. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .AND. ACTIVITY(I+1, J ) )   &
      & + ( ACTIVITY( I ,J+1) .AND. ACTIVITY( I , J ) ) )
    ELSE
      VO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_V_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_V_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY(P+1, Q ) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY( I ,J+1) .AND. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      VO( I , J ) =   &
      ( V(P+1,Q-1) * ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY(P+1, Q ) ) * FACTOR(2)  &
      + V( I , J ) * ( ACTIVITY( I ,J+1) .AND. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(P+1,Q-1) .AND. ACTIVITY(P+1, Q ) )   &
      & + ( ACTIVITY( I ,J+1) .AND. ACTIVITY( I , J ) ) )
    ELSE
      VO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_UV_O_V_IN_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_UV_O_V_II_JN

    IMPLICIT NONE

    VO( I , J ) = 0.0

  END SUBROUTINE MR_INTERP_XY_UV_O_V_II_JN

  END SUBROUTINE MR_INTERP_XY_UV_O_V

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V( NI , NJ , SV , SVO )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ) :: SV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(0:NI0(NI,FDRD_KIND),0:NJ) :: SVO

    INTEGER(IJID_KIND) :: I , J

    J = 0
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_I0_J0
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_II_J0
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_IN_J0
      !END I = NI
    !END J = NJ

    DO J = 1 , NJ-1
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_I0_JJ
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_II_JJ
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_IN_JJ
      !END I = NI
    END DO

    J = NJ
      I = 0
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_I0_JN
      !END I = 0
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI-1
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_II_JN
      END DO
      I = NI
       !DIR$ FORCEINLINE
        CALL MR_INTERP_XY_SS_O_V_IN_JN
      !END I = NI
    !END J = NJ

!***********************************************************************************************************************************

  CONTAINS

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_I0_J0

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(I+1,J+1) == BEACTIVE .OR.   &
    &   ACTIVITY( P ,Q-1) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(I+1, J ) * ACTIVITY(I+1,J+1)   &
      + SV( P ,Q-1) * ACTIVITY( P ,Q-1) )   &
      / ( ACTIVITY(I+1,J+1) + ACTIVITY( P ,Q-1) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_I0_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_II_J0

    IMPLICIT NONE

    IF( ACTIVITY(I+1,J+1) == BEACTIVE .OR.   &
    &   ACTIVITY( I ,J+1) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(I+1, J ) * ACTIVITY(I+1,J+1)   &
      + SV( I , J ) * ACTIVITY( I ,J+1) )   &
      / ( ACTIVITY(I+1,J+1) + ACTIVITY( I ,J+1) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_II_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_IN_J0

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(P+1,Q-1) == BEACTIVE .OR.   &
    &   ACTIVITY( I ,J+1) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(P+1,Q-1) * ACTIVITY(P+1,Q-1)   &
      + SV( I , J ) * ACTIVITY( I ,J+1) )   &
      / ( ACTIVITY(P+1,Q-1) + ACTIVITY( I ,J+1) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_IN_J0

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_I0_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY(I+1, J ) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY( P ,Q-1) .OR. ACTIVITY( P , Q ) ) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(I+1, J ) * ( ACTIVITY(I+1,J+1) .OR. ACTIVITY(I+1, J ) )   &
      + SV( P ,Q-1) * ( ACTIVITY( P ,Q-1) .OR. ACTIVITY( P , Q ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY(I+1, J ) )   &
      & + ( ACTIVITY( P ,Q-1) .OR. ACTIVITY( P , Q ) ) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_I0_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_II_JJ

    IMPLICIT NONE

    IF( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY(I+1, J ) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY( I ,J+1) .OR. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(I+1, J ) * ( ACTIVITY(I+1,J+1) .OR. ACTIVITY(I+1, J ) )   &
      + SV( I , J ) * ( ACTIVITY( I ,J+1) .OR. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(I+1,J+1) .OR. ACTIVITY(I+1, J ) )   &
      & + ( ACTIVITY( I ,J+1) .OR. ACTIVITY( I , J ) ) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_II_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_IN_JJ

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY(P+1, Q ) ) == BEACTIVE .OR.   &
    &   ( ACTIVITY( I ,J+1) .OR. ACTIVITY( I , J ) ) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(P+1,Q-1) * ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY(P+1, Q ) )   &
      + SV( I , J ) * ( ACTIVITY( I ,J+1) .OR. ACTIVITY( I , J ) ) )   &
      / ( ( ACTIVITY(P+1,Q-1) .OR. ACTIVITY(P+1, Q ) )   &
      & + ( ACTIVITY( I ,J+1) .OR. ACTIVITY( I , J ) ) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_IN_JJ

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_I0_JN

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(I+1, J ) == BEACTIVE .OR.   &
    &   ACTIVITY( P , Q ) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(I+1, J ) * ACTIVITY(I+1, J )   &
      + SV( P ,Q-1) * ACTIVITY( P , Q ) )   &
      / ( ACTIVITY(I+1, J ) + ACTIVITY( P , Q ) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_I0_JN

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_II_JN

    IMPLICIT NONE

    IF( ACTIVITY(I+1, J ) == BEACTIVE .OR.   &
    &   ACTIVITY( I , J ) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(I+1, J ) * ACTIVITY(I+1, J )   &
      + SV( I , J ) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY(I+1, J ) + ACTIVITY( I , J ) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_II_JN

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INTERP_XY_SS_O_V_IN_JN

    IMPLICIT NONE

    INTEGER(IJID_KIND) :: P , Q

    P = MOD(NI+I+NI/2,2*NI)-NI/2 ; Q = NJ-J+1

    IF( ACTIVITY(P+1, Q ) == BEACTIVE .OR.   &
    &   ACTIVITY( I , J ) == BEACTIVE ) THEN
      SVO( I , J ) =   &
      ( SV(P+1,Q-1) * ACTIVITY(P+1, Q )   &
      + SV( I , J ) * ACTIVITY( I , J ) )   &
      / ( ACTIVITY(P+1, Q ) + ACTIVITY( I , J ) )
    ELSE
      SVO( I , J ) = 0.0
    END IF

  END SUBROUTINE MR_INTERP_XY_SS_O_V_IN_JN

  END SUBROUTINE MR_INTERP_XY_SS_O_V

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INV_INTERP_XY_UV_FROM_VV( NI , NJ , VV , UV )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ,1:2) :: VV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ,1:2) :: UV

    INTEGER(IJID_KIND) :: I , J
    INTEGER            :: DIM

    DO DIM = 1 , 2

      DO J = 1 , NJ
       !DIR$ VECTOR ALIGNED
        DO I = 1 , NI
          IF( ACTIVITY( I , J ) == BEACTIVE ) THEN
            UV( I , J ,DIM) = 0.5 * ( VV( I , J ,DIM) + VV( I ,J-1,DIM) )
          ELSE
            UV( I , J ,DIM) = 0.0
          END IF
        END DO
      END DO

    END DO

  END SUBROUTINE MR_INV_INTERP_XY_UV_FROM_VV

!***********************************************************************************************************************************
! UNIT:
!
!  (SUBROUTINE)
!
! PURPOSE:
!
!   TO
!
! DEFINITION OF VARIABLES:
!
!
!
! RECORD OF REVISIONS:
!
!      DATE       |    PROGRAMMER    |    DESCRIPTION OF CHANGE
!      ====       |    ==========    |    =====================
!   20XX-XX-XX    |     DR. HYDE     |    ORIGINAL CODE.
!
!***********************************************************************************************************************************
  SUBROUTINE MR_INV_INTERP_XY_SS_FROM_SV( NI , NJ , SV , SS )

    IMPLICIT NONE

    INTEGER(IJID_KIND) , INTENT(IN ) :: NI , NJ

    REAL   (FDRD_KIND) , INTENT(IN ) , DIMENSION(1:NI1(NI,FDRD_KIND),0:NJ) :: SV
    REAL   (FDRD_KIND) , INTENT(OUT) , DIMENSION(1:NI1(NI,FDRD_KIND),1:NJ) :: SS

    INTEGER(IJID_KIND) :: I , J

    DO J = 1 , NJ
     !DIR$ VECTOR ALIGNED
      DO I = 1 , NI
        IF( ACTIVITY( I , J ) == BEACTIVE ) THEN
          SS( I , J ) = 0.5 * ( SV( I , J ) + SV( I ,J-1) )
        ELSE
          SS( I , J ) = 0.0
        END IF
      END DO
    END DO

  END SUBROUTINE MR_INV_INTERP_XY_SS_FROM_SV

  END MODULE MR_MOD_INTERP_XY

__Sources/MR_MOD_OPERATIONS/MR_MOD_INTERP_XY - for Anti-Symmetry BC.f90


!=======================================================================
! This is part of the 2DECOMP&FFT library
!
! 2DECOMP&FFT is a software framework for general-purpose 2D (pencil)
! decomposition. It also implements a highly scalable distributed
! three-dimensional Fast Fourier Transform (FFT).
!
! Copyright (C) 2009-2012 Ning Li, the Numerical Algorithms Group (NAG)
!
!=======================================================================

! This is the FFTE implementation of the FFT library
! Note that FFTE only support transform size with prime factor 2/3/5.
! Other sizes are computed by the generic engine.

module decomp_2d_fft

  use decomp_2d  ! 2D decomposition module
  use glassman

  implicit none

  private        ! Make everything private unless declared public

  ! engine-specific global variables
  complex(mytype), allocatable, dimension(:) :: buf, scratch

  logical, save :: x_goodsize, y_goodsize, z_goodsize

  ! common code used for all engines, including global variables,
  ! generic interface definitions and several subroutines
#include "fft_common.f90"

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  This routine performs one-time initialisations for the FFT engine
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  subroutine init_fft_engine

    implicit none

    integer :: cbuf_size, errorcode

    if (KIND(0.0) == mytype) then
       errorcode = 5
       call decomp_2d_abort(errorcode, &
            'FFTE engine only suppport double-precision calculations')
    end if

    if (nrank==0) then
       write(*,*) ' '
       write(*,*) '***** Using the FFTE engine *****'
       write(*,*) ' '
    end if

    cbuf_size = max(ph%xsz(1), ph%ysz(2))
    cbuf_size = max(cbuf_size, ph%zsz(3))
    allocate(buf(cbuf_size))
    allocate(scratch(2*cbuf_size))  ! twice space for vffte library

    ! check the transform sizes
    x_goodsize = check_size(ph%xsz(1))
    y_goodsize = check_size(ph%ysz(2))
    z_goodsize = check_size(ph%zsz(3))

    return
  end subroutine init_fft_engine

  ! factorisation routine
#include "factor.f90"

  logical function check_size(nsize)

    integer, intent(IN) :: nsize

    integer, allocatable, dimension(:) :: factors
    integer :: nfact, i

    i = ceiling(log(real(nsize))*1.442695)  ! log_2_N
    allocate(factors(i))

    call primefactors(nsize,factors,nfact)

    check_size = .true.

    do i=1,nfact
       if (factors(i) > 5) then
          check_size = .false.
          exit
       end if
    end do

    return
  end function check_size

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !  This routine performs one-time finalisations for the FFT engine
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  subroutine finalize_fft_engine

    implicit none

    deallocate(buf,scratch)

    return
  end subroutine finalize_fft_engine

  ! Following routines calculate multiple one-dimensional FFTs to form
  ! the basis of three-dimensional FFTs.

  ! c2c transform, multiple 1D FFTs in x direction
  subroutine c2c_1m_x(inout, isign, decomp)

    implicit none

    complex(mytype), dimension(:,:,:), intent(INOUT) :: inout
    integer, intent(IN) :: isign
    TYPE(DECOMP_INFO), intent(IN) :: decomp

    integer :: i,j,k

    if (x_goodsize) then
       call zfft1d(buf,decomp%xsz(1),0,scratch)
    end if

    do k=1,decomp%xsz(3)
       do j=1,decomp%xsz(2)
          do i=1,decomp%xsz(1)
             buf(i) = inout(i,j,k)
          end do
          if (x_goodsize) then
             call zfft1d(buf,decomp%xsz(1),isign,scratch)
          else
             call spcfft(buf,decomp%xsz(1),isign,scratch)
          end if
          do i=1,decomp%xsz(1)
             inout(i,j,k) = buf(i)
          end do
       end do
    end do

    ! Note FFTE backward transform is scaled, unscale here
    if (x_goodsize .AND. isign==DECOMP_2D_FFT_BACKWARD) then
       inout = inout * real(decomp%xsz(1), kind=mytype)
    end if

    return

  end subroutine c2c_1m_x

  ! c2c transform, multiple 1D FFTs in y direction
  subroutine c2c_1m_y(inout, isign, decomp)

    implicit none

    complex(mytype), dimension(:,:,:), intent(INOUT) :: inout
    integer, intent(IN) :: isign
    TYPE(DECOMP_INFO), intent(IN) :: decomp

    integer :: i,j,k

    if (y_goodsize) then
       call zfft1d(buf,decomp%ysz(2),0,scratch)
    end if

    do k=1,decomp%ysz(3)
       do i=1,decomp%ysz(1)
          do j=1,decomp%ysz(2)
             buf(j) = inout(i,j,k)
          end do
          if (y_goodsize) then
             call zfft1d(buf,decomp%ysz(2),isign,scratch)
          else
             call spcfft(buf,decomp%ysz(2),isign,scratch)
          end if
          do j=1,decomp%ysz(2)
             inout(i,j,k) = buf(j)
          end do
       end do
    end do

    if (y_goodsize .AND. isign==DECOMP_2D_FFT_BACKWARD) then
       inout = inout * real(decomp%ysz(2), kind=mytype)
    end if

    return

  end subroutine c2c_1m_y

  ! c2c transform, multiple 1D FFTs in z direction
  subroutine c2c_1m_z(inout, isign, decomp)

    implicit none

    complex(mytype), dimension(:,:,:), intent(INOUT) :: inout
    integer, intent(IN) :: isign
    TYPE(DECOMP_INFO), intent(IN) :: decomp

    integer :: i,j,k

    if (z_goodsize) then
       call zfft1d(buf,decomp%zsz(3),0,scratch)
    end if

    do j=1,decomp%zsz(2)
       do i=1,decomp%zsz(1)
          do k=1,decomp%zsz(3)
             buf(k) = inout(i,j,k)
          end do
          if (z_goodsize) then
             call zfft1d(buf,decomp%zsz(3),isign,scratch)
          else
             call spcfft(buf,decomp%zsz(3),isign,scratch)
          end if
          do k=1,decomp%zsz(3)
             inout(i,j,k) = buf(k)
          end do
       end do
    end do

    if (z_goodsize .AND. isign==DECOMP_2D_FFT_BACKWARD) then
       inout = inout * real(decomp%zsz(3), kind=mytype)
    end if

    return

  end subroutine c2c_1m_z

  ! r2c transform, multiple 1D FFTs in x direction
  subroutine r2c_1m_x(input, output)

    implicit none

    real(mytype), dimension(:,:,:), intent(IN)  ::  input
    complex(mytype), dimension(:,:,:), intent(OUT) :: output

    integer :: i,j,k, s1,s2,s3, d1

    s1 = size(input,1)
    s2 = size(input,2)
    s3 = size(input,3)
    d1 = size(output,1)

    if (x_goodsize) then
       call zfft1d(buf,s1,0,scratch)
    end if

    do k=1,s3
       do j=1,s2
          ! The base FFT engine is c2c only,
          ! needing some pre- and post-processing for r2c
          ! pack real input in complex storage
          do i=1,s1
             buf(i) = cmplx(input(i,j,k),0._mytype, kind=mytype)
          end do
          if (x_goodsize) then
             call zfft1d(buf,s1,-1,scratch)
          else
             call spcfft(buf,s1,-1,scratch)
          end if
          ! note d1 ~ s1/2+1
          ! simply drop the redundant part of the complex output
          do i=1,d1
             output(i,j,k) = buf(i)
          end do
       end do
    end do

    return

  end subroutine r2c_1m_x

  ! r2c transform, multiple 1D FFTs in z direction
  subroutine r2c_1m_z(input, output)

    implicit none

    real(mytype), dimension(:,:,:), intent(IN)  ::  input
    complex(mytype), dimension(:,:,:), intent(OUT) :: output

    integer :: i,j,k, s1,s2,s3, d3

    s1 = size(input,1)
    s2 = size(input,2)
    s3 = size(input,3)
    d3 = size(output,3)

    if (z_goodsize) then
       call zfft1d(buf,s3,0,scratch)
    end if

    do j=1,s2
       do i=1,s1
          do k=1,s3
             buf(k) = cmplx(input(i,j,k),0._mytype, kind=mytype)
          end do
          if (z_goodsize) then
             call zfft1d(buf,s3,-1,scratch)
          else
             call spcfft(buf,s3,-1,scratch)
          end if
          do k=1,d3
             output(i,j,k) = buf(k)
          end do
       end do
    end do

    return

  end subroutine r2c_1m_z

  ! c2r transform, multiple 1D FFTs in x direction
  subroutine c2r_1m_x(input, output)

    implicit none

    complex(mytype), dimension(:,:,:), intent(IN)  ::  input
    real(mytype), dimension(:,:,:), intent(OUT) :: output

    integer :: i,j,k, d1,d2,d3

    d1 = size(output,1)
    d2 = size(output,2)
    d3 = size(output,3)

    if (x_goodsize) then
       call zfft1d(buf,d1,0,scratch)
    end if

    do k=1,d3
       do j=1,d2
          ! The base FFT engine is c2c only,
          ! needing some pre- and post-processing for c2r
          do i=1,d1/2+1
             buf(i) = input(i,j,k)
          end do
          ! expanding to a full-size complex array
          ! For odd N, the storage is:
          !  1, 2, ...... N/2+1   integer division rounded down
          !     N, ...... N/2+2   => a(i) is conjugate of a(N+2-i)
          ! For even N, the storage is:
          !  1, 2, ...... N/2  , N/2+1
          !     N, ...... N/2+2  again a(i) conjugate of a(N+2-i)
          do i=d1/2+2,d1
             buf(i) =  conjg(buf(d1+2-i))
          end do
          if (x_goodsize) then
             call zfft1d(buf,d1,1,scratch)
          else
             call spcfft(buf,d1,1,scratch)
          end if
          do i=1,d1
             ! simply drop imaginary part
             output(i,j,k) = real(buf(i), kind=mytype)
          end do
       end do
    end do

    if (x_goodsize) then
       output = output * real(d1, kind=mytype)
    end if

    return

  end subroutine c2r_1m_x

  ! c2r transform, multiple 1D FFTs in z direction
  subroutine c2r_1m_z(input, output)

    implicit none

    complex(mytype), dimension(:,:,:), intent(IN)  ::  input
    real(mytype), dimension(:,:,:), intent(OUT) :: output

    integer :: i,j,k, d1,d2,d3

    d1 = size(output,1)
    d2 = size(output,2)
    d3 = size(output,3)

    if (z_goodsize) then
       call zfft1d(buf,d3,0,scratch)
    end if

    do j=1,d2
       do i=1,d1
          do k=1,d3/2+1
             buf(k) = input(i,j,k)
          end do
          do k=d3/2+2,d3
             buf(k) =  conjg(buf(d3+2-k))
          end do
          if (z_goodsize) then
             call zfft1d(buf,d3,1,scratch)
          else
             call spcfft(buf,d3,1,scratch)
          end if
          do k=1,d3
             output(i,j,k) = real(buf(k), kind=mytype)
          end do
       end do
    end do

    if (z_goodsize) then
       output = output * real(d3, kind=mytype)
    end if

    return

  end subroutine c2r_1m_z

#include "fft_common_3d.f90"

end module decomp_2d_fft