pkg/rbcs/rbcs_init_fixed.F

C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_init_fixed.F,v 1.6 2011/05/14 19:52:12 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"
#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 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 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 ( 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
      IF ( useRBCuVel .AND. relaxMaskUFile.NE. ' ' ) THEN
        CALL READ_FLD_XYZ_RS(relaxMaskUFile,' ',RBC_maskU, 0, myThid)
      ELSEIF( useRBCuVel ) 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) =
     &                  ( 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
        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) =
     &                  ( 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
           _BARRIER
           _BEGIN_MASTER( myThid )
           CALL PLOT_FIELD_XYRS( RBC_maskU,
     &                          'Boundary Relaxing U' ,1, myThid )
           CALL PLOT_FIELD_XYRS( RBC_maskV,
     &                          'Boundary Relaxing V' ,1, myThid )
           _END_MASTER(myThid)
        ENDIF
      ENDIF
#endif /* DISABLE_RBCS_MOM */

#endif /* ALLOW_RBCS */

      RETURN
      END
1	jmc	1.7	C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_init_fixed.F,v 1.6 2011/05/14 19:52:12 jmc Exp $
2	jmc	1.3	C $Name: $
3
4	jmc	1.5	#include "RBCS_OPTIONS.h"
5	stephd	1.1
6			C !INTERFACE: ==========================================================
7	jmc	1.5	SUBROUTINE RBCS_INIT_FIXED( myThid )
8	stephd	1.1
9			C !DESCRIPTION:
10	jmc	1.6	C calls subroutines that initializes fixed variables for relaxed
11	stephd	1.1	c boundary conditions
12
13			C !USES: ===============================================================
14			IMPLICIT NONE
15			#include "SIZE.h"
16			#include "EEPARAMS.h"
17			#include "PARAMS.h"
18	jmc	1.6	#include "GRID.h"
19	stephd	1.1	#ifdef ALLOW_PTRACERS
20			#include "PTRACERS_SIZE.h"
21			#endif
22	jmc	1.6	#include "RBCS_SIZE.h"
23			#include "RBCS_PARAMS.h"
24			#include "RBCS_FIELDS.h"
25	stephd	1.1
26			C !INPUT PARAMETERS: ===================================================
27	jmc	1.5	C myThid :: my Thread Id number
28	stephd	1.1	INTEGER myThid
29			CEOP
30
31			#ifdef ALLOW_RBCS
32			C !LOCAL VARIABLES:
33	jmc	1.6	C i,j,k,bi,bj,irbc :: loop indices
34			C msgBuf :: Informational/error message buffer
35	stephd	1.1	INTEGER i,j,k,bi,bj
36	stephd	1.2	INTEGER irbc
37	jmc	1.6	#ifndef DISABLE_RBCS_MOM
38			CHARACTER*(MAX_LEN_MBUF) msgBuf
39			#endif
40
41			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
42
43			#ifndef DISABLE_RBCS_MOM
44			C Loop over tiles
45			DO bj = myByLo(myThid), myByHi(myThid)
46			DO bi = myBxLo(myThid), myBxHi(myThid)
47			DO k=1,Nr
48			DO j=1-Oly,sNy+OLy
49			DO i=1-Olx,sNx+Olx
50			RBC_maskU(i,j,k,bi,bj) = 0. _d 0
51			RBC_maskV(i,j,k,bi,bj) = 0. _d 0
52			ENDDO
53			ENDDO
54			ENDDO
55			ENDDO
56			ENDDO
57			#endif /* DISABLE_RBCS_MOM */
58	stephd	1.1
59	jmc	1.5	C Loop over mask index
60			DO irbc=1,maskLEN
61
62			C Loop over tiles
63	stephd	1.1	DO bj = myByLo(myThid), myByHi(myThid)
64	jmc	1.5	DO bi = myBxLo(myThid), myBxHi(myThid)
65	stephd	1.1
66	jmc	1.5	C Initialize arrays in common blocks :
67			DO k=1,Nr
68			DO j=1-Oly,sNy+OLy
69			DO i=1-Olx,sNx+Olx
70			RBC_mask(i,j,k,bi,bj,irbc) = 0. _d 0
71	stephd	1.1	ENDDO
72	jmc	1.5	ENDDO
73			ENDDO
74
75			C end bi,bj loops
76	stephd	1.1	ENDDO
77			ENDDO
78	jmc	1.5	C end of mask index loop
79	stephd	1.1	ENDDO
80
81			C read in mask for relaxing
82	jmc	1.5	DO irbc=1,maskLEN
83	stephd	1.2	IF ( relaxMaskFile(irbc).NE. ' ' ) THEN
84			CALL READ_FLD_XYZ_RS(relaxMaskFile(irbc),' ',
85			& RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid)
86	jmc	1.5	CALL EXCH_XYZ_RS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc), myThid )
87	jmc	1.6	C-- Apply mask:
88			DO bj = myByLo(myThid), myByHi(myThid)
89			DO bi = myBxLo(myThid), myBxHi(myThid)
90			DO k=1,Nr
91			DO j=1-Oly,sNy+OLy
92			DO i=1-Olx,sNx+Olx
93			RBC_mask(i,j,k,bi,bj,irbc) = RBC_mask(i,j,k,bi,bj,irbc)
94			& * maskC(i,j,k,bi,bj)
95			ENDDO
96			ENDDO
97			ENDDO
98			ENDDO
99			ENDDO
100	jmc	1.7	IF ( debugLevel.GE.debLevC ) THEN
101	jmc	1.6	_BARRIER
102	jmc	1.5	_BEGIN_MASTER( myThid )
103			CALL PLOT_FIELD_XYRS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc),
104			& 'Boundary Relaxing' ,1, myThid )
105			_END_MASTER(myThid)
106			ENDIF
107	stephd	1.2	ENDIF
108	jmc	1.5	ENDDO
109
110	jmc	1.6	#ifndef DISABLE_RBCS_MOM
111			IF ( useRBCuVel .AND. relaxMaskUFile.NE. ' ' ) THEN
112			CALL READ_FLD_XYZ_RS(relaxMaskUFile,' ',RBC_maskU, 0, myThid)
113			ELSEIF( useRBCuVel ) THEN
114			WRITE(msgBuf,'(2A)') ' WARNING RBCS_INIT_FIXED: ',
115			& 'no relaxMaskUFile => use Temp mask instead'
116			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
117			& SQUEEZE_RIGHT, myThid )
118			DO bj = myByLo(myThid), myByHi(myThid)
119			DO bi = myBxLo(myThid), myBxHi(myThid)
120			DO k=1,Nr
121			DO j=1-Oly,sNy+OLy
122			DO i=2-Olx,sNx+Olx
123			RBC_maskU(i,j,k,bi,bj) =
124			& ( RBC_mask(i-1,j,k,bi,bj,1)
125			& + RBC_mask( i ,j,k,bi,bj,1) )*0.5 _d 0
126			ENDDO
127			ENDDO
128			ENDDO
129			ENDDO
130			ENDDO
131			ENDIF
132			IF ( useRBCvVel .AND. relaxMaskVFile.NE. ' ' ) THEN
133			CALL READ_FLD_XYZ_RS(relaxMaskVFile,' ',RBC_maskV, 0, myThid)
134			ELSEIF( useRBCvVel ) THEN
135			WRITE(msgBuf,'(2A)') ' WARNING RBCS_INIT_FIXED: ',
136			& 'no relaxMaskVFile => use Temp mask instead'
137			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
138			& SQUEEZE_RIGHT, myThid )
139			DO bj = myByLo(myThid), myByHi(myThid)
140			DO bi = myBxLo(myThid), myBxHi(myThid)
141			DO k=1,Nr
142			DO j=2-Oly,sNy+OLy
143			DO i=1-Olx,sNx+Olx
144			RBC_maskV(i,j,k,bi,bj) =
145			& ( RBC_mask(i,j-1,k,bi,bj,1)
146			& + RBC_mask(i, j ,k,bi,bj,1) )*0.5 _d 0
147			ENDDO
148			ENDDO
149			ENDDO
150			ENDDO
151			ENDDO
152			ENDIF
153			IF( useRBCuVel .OR. useRBCvVel ) THEN
154			CALL EXCH_UV_XYZ_RS( RBC_maskU, RBC_maskV, .FALSE., myThid )
155			C-- Apply mask:
156			DO bj = myByLo(myThid), myByHi(myThid)
157			DO bi = myBxLo(myThid), myBxHi(myThid)
158			DO k=1,Nr
159			DO j=1-Oly,sNy+OLy
160			DO i=1-Olx,sNx+Olx
161			RBC_maskU(i,j,k,bi,bj) = RBC_maskU(i,j,k,bi,bj)
162			& * maskW(i,j,k,bi,bj)
163			RBC_maskV(i,j,k,bi,bj) = RBC_maskV(i,j,k,bi,bj)
164			& * maskS(i,j,k,bi,bj)
165			ENDDO
166			ENDDO
167			ENDDO
168			ENDDO
169			ENDDO
170	jmc	1.7	IF ( debugLevel.GE.debLevC ) THEN
171	jmc	1.6	_BARRIER
172			_BEGIN_MASTER( myThid )
173			CALL PLOT_FIELD_XYRS( RBC_maskU,
174			& 'Boundary Relaxing U' ,1, myThid )
175			CALL PLOT_FIELD_XYRS( RBC_maskV,
176			& 'Boundary Relaxing V' ,1, myThid )
177			_END_MASTER(myThid)
178			ENDIF
179			ENDIF
180			#endif /* DISABLE_RBCS_MOM */
181
182	stephd	1.1	#endif /* ALLOW_RBCS */
183
184			RETURN
185			END