C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/sciascia/rbcs/rbcs_init_fixed.F,v 1.1 2012/08/08 01:57:14 heimbach Exp $
C $Name:  $

#include "RBCS_OPTIONS.h"

C !INTERFACE: ==========================================================
      SUBROUTINE RBCS_INIT_FIXED( myThid )

C !DESCRIPTION:
C calls subroutines that initializes fixed variables for relaxed
c boundary conditions

C !USES: ===============================================================
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#ifdef ALLOW_PTRACERS
#include "PTRACERS_SIZE.h"
#endif
#include "RBCS_SIZE.h"
#include "RBCS_PARAMS.h"
#include "RBCS_FIELDS.h"

C !INPUT PARAMETERS: ===================================================
C  myThid               :: my Thread Id number
      INTEGER myThid
CEOP

#ifdef ALLOW_RBCS
C     !LOCAL VARIABLES:
C     i,j,k,bi,bj,irbc  :: loop indices
C     msgBuf      :: Informational/error message buffer
      INTEGER i,j,k,bi,bj
      INTEGER ium, ivm,iwm
      INTEGER irbc
#ifndef DISABLE_RBCS_MOM
      CHARACTER*(MAX_LEN_MBUF) msgBuf
#endif

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

#ifndef DISABLE_RBCS_MOM
C     Loop over tiles
       DO ium = 1, UmLEN
	DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO k=1,Nr
           DO j=1-Oly,sNy+OLy
            DO i=1-Olx,sNx+Olx
             RBC_maskU(i,j,k,bi,bj,ium) = 0. _d 0
            ENDDO
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO

       DO ivm = 1,VmLEN
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO k=1,Nr
           DO j=1-Oly,sNy+OLy
            DO i=1-Olx,sNx+Olx
              RBC_maskV(i,j,k,bi,bj,ivm) = 0. _d 0
            ENDDO
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO

#ifdef ALLOW_NONHYDROSTATIC     
       DO iwm = 1,WmLEN
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO k=1,Nr
           DO j=1-Oly,sNy+OLy
            DO i=1-Olx,sNx+Olx
              RBC_maskW(i,j,k,bi,bj,iwm) = 0. _d 0
            ENDDO
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO
#endif
#endif /* DISABLE_RBCS_MOM */

C     Loop over mask index
      DO irbc=1,maskLEN

C     Loop over tiles
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)

C        Initialize arrays in common blocks :
           DO k=1,Nr
            DO j=1-Oly,sNy+OLy
             DO i=1-Olx,sNx+Olx
               RBC_mask(i,j,k,bi,bj,irbc) = 0. _d 0
             ENDDO
            ENDDO
           ENDDO

C        end bi,bj loops
         ENDDO
        ENDDO
C     end of mask index loop
      ENDDO

C read in mask for relaxing
      DO irbc=1,maskLEN
       IF ( relaxMaskFile(irbc).NE. ' ' ) THEN
         CALL READ_FLD_XYZ_RS(relaxMaskFile(irbc),' ',
     &                RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid)
         CALL EXCH_XYZ_RS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc), myThid )
C--   Apply mask:
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
           DO k=1,Nr
            DO j=1-Oly,sNy+OLy
             DO i=1-Olx,sNx+Olx
               RBC_mask(i,j,k,bi,bj,irbc) = RBC_mask(i,j,k,bi,bj,irbc)
     &                                    * maskC(i,j,k,bi,bj)
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
         IF ( debugLevel.GE.debLevC ) THEN
           _BARRIER
           _BEGIN_MASTER( myThid )
           CALL PLOT_FIELD_XYRS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc),
     &                          'Boundary Relaxing' ,1, myThid )
           _END_MASTER(myThid)
        ENDIF
       ENDIF
      ENDDO

#ifndef DISABLE_RBCS_MOM
       DO ium=1,UmLEN
        IF ( useRBCuVel(ium) .AND. 
     &		relaxMaskUFile(ium).NE. ' ' ) THEN
         CALL READ_FLD_XYZ_RS(relaxMaskUFile(ium),' '
     &		,RBC_maskU(1-Olx,1-Oly,1,1,1,ium), 0, myThid)
        ELSEIF( useRBCuVel(ium) ) THEN
         WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED: ',
     &     'no relaxMaskUFile => use Temp mask instead'
         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
           DO k=1,Nr
            DO j=1-Oly,sNy+OLy
             DO i=2-Olx,sNx+Olx
               RBC_maskU(i,j,k,bi,bj,ium) =
     &                  ( RBC_mask(i-1,j,k,bi,bj,1)
     &                  + RBC_mask( i ,j,k,bi,bj,1) )*0.5 _d 0
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
        ENDIF
       ENDDO
      DO ivm=1,VmLEN
       IF ( useRBCvVel(ivm) .AND
     &		 . relaxMaskVFile(ivm).NE. ' ' ) THEN
         CALL READ_FLD_XYZ_RS(relaxMaskVFile(ivm),' '
     &		,RBC_maskV(1-Olx,1-Oly,1,1,1,ivm), 0, myThid)
       ELSEIF( useRBCvVel(ivm) ) THEN
         WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED: ',
     &     'no relaxMaskVFile => use Temp mask instead'
         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
           DO k=1,Nr
            DO j=2-Oly,sNy+OLy
             DO i=1-Olx,sNx+Olx
               RBC_maskV(i,j,k,bi,bj,ivm) =
     &                  ( RBC_mask(i,j-1,k,bi,bj,1)
     &                  + RBC_mask(i, j ,k,bi,bj,1) )*0.5 _d 0
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
       ENDIF
      ENDDO
#ifdef ALLOW_NONHYDROSTATIC
      DO iwm=1,WmLEN
       IF ( useRBCwVel(iwm) .AND. 
     &		 relaxMaskWFile(iwm).NE. ' ' ) THEN
        CALL READ_FLD_XYZ_RS(relaxMaskWFile(iwm),' '
     &		,RBC_maskW(1-Olx,1-Oly,1,1,1,iwm), 0, myThid)
       ELSEIF( useRBCwVel(iwm) ) THEN
        WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED: ',
     &     'no relaxMaskWFile => use Temp mask instead'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO k=1,Nr
           DO j=2-Oly,sNy+OLy
            DO i=1-Olx,sNx+Olx
               RBC_maskW(i,j,k,bi,bj,iwm) =
     &                  ( RBC_mask(i,j-1,k,bi,bj,1)
     &                  + RBC_mask(i, j ,k,bi,bj,1) )*0.5 _d 0
            ENDDO
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDIF
      ENDDO
#endif

      DO ium=1,UmLEN
       DO ivm=1,VmLEN
	IF(ium.EQ.ivm)THEN
        IF( useRBCuVel(ium) .OR. useRBCvVel(ivm) ) THEN
          CALL EXCH_UV_XYZ_RS(RBC_maskU(1-Olx,1-Oly,1,1,1,ium)
     &		,RBC_maskV(1-Olx,1-Oly,1,1,1,ivm)
     &		, .FALSE., myThid)
C--   Apply mask:
       
	DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
           DO k=1,Nr
            DO j=1-Oly,sNy+OLy
             DO i=1-Olx,sNx+Olx
               RBC_maskU(i,j,k,bi,bj,ium) = 
     &			RBC_maskU(i,j,k,bi,bj,ium)
     &			* maskW(i,j,k,bi,bj)
               RBC_maskV(i,j,k,bi,bj,ivm) = 
     &			RBC_maskV(i,j,k,bi,bj,ivm)
     &			* maskS(i,j,k,bi,bj)
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
#ifdef ALLOW_NONHYDROSTATIC
       DO iwm=1,WmLEN 
	DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
           DO k=1,Nr
            DO j=1-Oly,sNy+OLy
             DO i=1-Olx,sNx+Olx
               RBC_maskW(i,j,k,bi,bj,iwm) = 
     &			RBC_maskW(i,j,k,bi,bj,iwm)
     &			* maskS(i,j,k,bi,bj)
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
       ENDDO
#endif
         IF ( debugLevel.GE.debLevC ) THEN
           _BARRIER
           _BEGIN_MASTER( myThid )
           CALL PLOT_FIELD_XYRS( RBC_maskU(1-Olx,1-Oly,1,1,1,ium),
     &                          'Boundary Relaxing U' ,1, myThid )
           CALL PLOT_FIELD_XYRS( RBC_maskV(1-Olx,1-Oly,1,1,1,ivm),
     &                          'Boundary Relaxing V' ,1, myThid )
           CALL PLOT_FIELD_XYRS( RBC_maskW(1-Olx,1-Oly,1,1,1,iwm),
     &                          'Boundary Relaxing W' ,1, myThid )
           _END_MASTER(myThid)
          ENDIF
         ENDIF
        ENDIF
       ENDDO
      ENDDO
#endif /* DISABLE_RBCS_MOM */

#endif /* ALLOW_RBCS */

      RETURN
      END