C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_init_fixed.F,v 1.11 2017/11/15 23:33:54 jmc 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"
# include "PTRACERS_PARAMS.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 !FUNCTIONS:
INTEGER ILNBLNK
EXTERNAL
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 irbc, iLen
CHARACTER*(MAX_LEN_MBUF) msgBuf
CHARACTER*(12) filName
#ifdef ALLOW_PTRACERS
INTEGER iTr
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C Report RBCS mask setting
_BEGIN_MASTER(myThid)
WRITE(msgBuf,'(2A)') ' '
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A)') ' --- RBCS_INIT_FIXED:',
& ' setting RBCS mask ---'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
IF ( useRBCtemp ) THEN
irbc = MIN(maskLEN,1)
IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
WRITE(msgBuf,'(2A,I3,2A)') '** WARNING ** RBCS_INIT_FIXED:',
& ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
& ' for Temp'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A,I3,2A)') 'Warning:',
& ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
& ' for Temp'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ELSE
iLen = ILNBLNK(relaxMaskTrFile(irbc))
WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
& ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(A,1PE21.13)')
& ' for Temp relaxation with tauRelaxT =', tauRelaxT
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
ENDIF
IF ( useRBCsalt ) THEN
irbc = MIN(maskLEN,2)
IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
WRITE(msgBuf,'(2A,I3,2A)') '** WARNING ** RBCS_INIT_FIXED:',
& ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
& ' for Salt'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A,I3,2A)') 'Warning:',
& ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
& ' for Salt'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ELSE
iLen = ILNBLNK(relaxMaskTrFile(irbc))
WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
& ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(A,1PE21.13)')
& ' for Salt relaxation with tauRelaxS =', tauRelaxS
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
ENDIF
IF ( useRBCuVel ) THEN
IF ( relaxMaskUFile.EQ. ' ' ) THEN
WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
& ' relaxMaskUFile unset ==> use Temp mask instead'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A)') 'Warning:',
& ' relaxMaskUFile unset ==> use Temp mask instead'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ELSE
iLen = ILNBLNK(relaxMaskUFile)
WRITE(msgBuf,'(A,3A)') 'Use relaxMaskUFile',
& ' = "', relaxMaskUFile(1:iLen), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
WRITE(msgBuf,'(A,1PE21.13)')
& ' for U-Vel relaxation with tauRelaxU =', tauRelaxU
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
IF ( useRBCvVel ) THEN
IF ( relaxMaskVFile.EQ. ' ' ) THEN
WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
& ' relaxMaskVFile unset ==> use Temp mask instead'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A)') 'Warning:',
& ' relaxMaskVFile unset ==> use Temp mask instead'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ELSE
iLen = ILNBLNK(relaxMaskVFile)
WRITE(msgBuf,'(A,3A)') 'Use relaxMaskVFile',
& ' = "', relaxMaskVFile(1:iLen), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
WRITE(msgBuf,'(A,1PE21.13)')
& ' for V-Vel relaxation with tauRelaxV =', tauRelaxV
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
#ifdef ALLOW_PTRACERS
IF ( usePTRACERS .AND. PTRACERS_numInUse.GE.1 ) THEN
DO iTr=1,PTRACERS_numInUse
IF ( useRBCpTrNum(iTr) ) THEN
irbc = MIN(maskLEN,2+iTr)
IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
WRITE(msgBuf,'(2A,I3,2A,I3)')
& '** WARNING ** RBCS_INIT_FIXED:',
& ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
& ' for pTr=', iTr
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A,I3,2A,I3)') 'Warning:',
& ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
& ' for pTr=', iTr
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ELSE
iLen = ILNBLNK(relaxMaskTrFile(irbc))
WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
& ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(A,I3,A,1PE21.13)')
& ' for pTr=', iTr, ' relaxation, tauRelaxPTR =',
& tauRelaxPTR(iTr)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
ENDIF
ENDDO
ENDIF
#endif /* ALLOW_PTRACERS */
_END_MASTER(myThid)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#ifndef DISABLE_RBCS_MOM
C Loop over tiles
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) = 0. _d 0
RBC_maskV(i,j,k,bi,bj) = 0. _d 0
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
#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 ( relaxMaskTrFile(irbc).NE. ' ' ) THEN
CALL READ_FLD_XYZ_RS( relaxMaskTrFile(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
WRITE(filName,'(A,I3.3)') 'RBC_mask_',irbc
CALL WRITE_FLD_XYZ_RS( filName,' ',
& RBC_mask(1-OLx,1-OLy,1,1,1,irbc), 0, myThid )
ENDIF
ENDIF
ENDDO
#ifndef DISABLE_RBCS_MOM
IF ( useRBCuVel .AND. relaxMaskUFile.NE. ' ' ) THEN
CALL READ_FLD_XYZ_RS(relaxMaskUFile,' ',RBC_maskU, 0, myThid)
ELSEIF( useRBCuVel ) THEN
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) =
& ( 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
IF ( useRBCvVel .AND. relaxMaskVFile.NE. ' ' ) THEN
CALL READ_FLD_XYZ_RS(relaxMaskVFile,' ',RBC_maskV, 0, myThid)
ELSEIF( useRBCvVel ) THEN
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) =
& ( 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
IF( useRBCuVel .OR. useRBCvVel ) THEN
CALL EXCH_UV_XYZ_RS( RBC_maskU, RBC_maskV, .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) = RBC_maskU(i,j,k,bi,bj)
& * maskW(i,j,k,bi,bj)
RBC_maskV(i,j,k,bi,bj) = RBC_maskV(i,j,k,bi,bj)
& * maskS(i,j,k,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
IF ( debugLevel.GE.debLevC ) THEN
CALL WRITE_FLD_XYZ_RS('RBC_maskU',' ',RBC_maskU,0,myThid )
CALL WRITE_FLD_XYZ_RS('RBC_maskV',' ',RBC_maskV,0,myThid )
ENDIF
ENDIF
#endif /* DISABLE_RBCS_MOM */
_BEGIN_MASTER(myThid)
WRITE(msgBuf,'(2A)') ' --- RBCS_INIT_FIXED:',
& ' setting RBCS mask done'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER(myThid)
#endif /* ALLOW_RBCS */
RETURN
END