pkg/rbcs/rbcs_init_fixed.F

C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_init_fixed.F,v 1.7 2011/06/07 22:25:10 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
      CHARACTER*(12) filName

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
           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
        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
           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 */

#endif /* ALLOW_RBCS */

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_init_fixed.F,v 1.7 2011/06/07 22:25:10 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	jmc	1.8	CHARACTER*(12) filName
41	jmc	1.6
42			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
43
44			#ifndef DISABLE_RBCS_MOM
45			C Loop over tiles
46			DO bj = myByLo(myThid), myByHi(myThid)
47			DO bi = myBxLo(myThid), myBxHi(myThid)
48			DO k=1,Nr
49			DO j=1-Oly,sNy+OLy
50			DO i=1-Olx,sNx+Olx
51			RBC_maskU(i,j,k,bi,bj) = 0. _d 0
52			RBC_maskV(i,j,k,bi,bj) = 0. _d 0
53			ENDDO
54			ENDDO
55			ENDDO
56			ENDDO
57			ENDDO
58			#endif /* DISABLE_RBCS_MOM */
59	stephd	1.1
60	jmc	1.5	C Loop over mask index
61			DO irbc=1,maskLEN
62
63			C Loop over tiles
64	stephd	1.1	DO bj = myByLo(myThid), myByHi(myThid)
65	jmc	1.5	DO bi = myBxLo(myThid), myBxHi(myThid)
66	stephd	1.1
67	jmc	1.5	C Initialize arrays in common blocks :
68			DO k=1,Nr
69			DO j=1-Oly,sNy+OLy
70			DO i=1-Olx,sNx+Olx
71			RBC_mask(i,j,k,bi,bj,irbc) = 0. _d 0
72	stephd	1.1	ENDDO
73	jmc	1.5	ENDDO
74			ENDDO
75
76			C end bi,bj loops
77	stephd	1.1	ENDDO
78			ENDDO
79	jmc	1.5	C end of mask index loop
80	stephd	1.1	ENDDO
81
82			C read in mask for relaxing
83	jmc	1.5	DO irbc=1,maskLEN
84	stephd	1.2	IF ( relaxMaskFile(irbc).NE. ' ' ) THEN
85			CALL READ_FLD_XYZ_RS(relaxMaskFile(irbc),' ',
86			& RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid)
87	jmc	1.5	CALL EXCH_XYZ_RS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc), myThid )
88	jmc	1.6	C-- Apply mask:
89			DO bj = myByLo(myThid), myByHi(myThid)
90			DO bi = myBxLo(myThid), myBxHi(myThid)
91			DO k=1,Nr
92			DO j=1-Oly,sNy+OLy
93			DO i=1-Olx,sNx+Olx
94			RBC_mask(i,j,k,bi,bj,irbc) = RBC_mask(i,j,k,bi,bj,irbc)
95			& * maskC(i,j,k,bi,bj)
96			ENDDO
97			ENDDO
98			ENDDO
99			ENDDO
100			ENDDO
101	jmc	1.7	IF ( debugLevel.GE.debLevC ) THEN
102	jmc	1.8	WRITE(filName,'(A,I3.3)') 'RBC_mask_',irbc
103			CALL WRITE_FLD_XYZ_RS( filName,' ',
104			& RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid )
105			ENDIF
106	stephd	1.2	ENDIF
107	jmc	1.5	ENDDO
108
109	jmc	1.6	#ifndef DISABLE_RBCS_MOM
110			IF ( useRBCuVel .AND. relaxMaskUFile.NE. ' ' ) THEN
111			CALL READ_FLD_XYZ_RS(relaxMaskUFile,' ',RBC_maskU, 0, myThid)
112			ELSEIF( useRBCuVel ) THEN
113			WRITE(msgBuf,'(2A)') ' WARNING RBCS_INIT_FIXED: ',
114			& 'no relaxMaskUFile => use Temp mask instead'
115			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
116			& SQUEEZE_RIGHT, myThid )
117			DO bj = myByLo(myThid), myByHi(myThid)
118			DO bi = myBxLo(myThid), myBxHi(myThid)
119			DO k=1,Nr
120			DO j=1-Oly,sNy+OLy
121			DO i=2-Olx,sNx+Olx
122			RBC_maskU(i,j,k,bi,bj) =
123			& ( RBC_mask(i-1,j,k,bi,bj,1)
124			& + RBC_mask( i ,j,k,bi,bj,1) )*0.5 _d 0
125			ENDDO
126			ENDDO
127			ENDDO
128			ENDDO
129			ENDDO
130			ENDIF
131			IF ( useRBCvVel .AND. relaxMaskVFile.NE. ' ' ) THEN
132			CALL READ_FLD_XYZ_RS(relaxMaskVFile,' ',RBC_maskV, 0, myThid)
133			ELSEIF( useRBCvVel ) THEN
134			WRITE(msgBuf,'(2A)') ' WARNING RBCS_INIT_FIXED: ',
135			& 'no relaxMaskVFile => use Temp mask instead'
136			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
137			& SQUEEZE_RIGHT, myThid )
138			DO bj = myByLo(myThid), myByHi(myThid)
139			DO bi = myBxLo(myThid), myBxHi(myThid)
140			DO k=1,Nr
141			DO j=2-Oly,sNy+OLy
142			DO i=1-Olx,sNx+Olx
143			RBC_maskV(i,j,k,bi,bj) =
144			& ( RBC_mask(i,j-1,k,bi,bj,1)
145			& + RBC_mask(i, j ,k,bi,bj,1) )*0.5 _d 0
146			ENDDO
147			ENDDO
148			ENDDO
149			ENDDO
150			ENDDO
151			ENDIF
152			IF( useRBCuVel .OR. useRBCvVel ) THEN
153			CALL EXCH_UV_XYZ_RS( RBC_maskU, RBC_maskV, .FALSE., myThid )
154			C-- Apply mask:
155			DO bj = myByLo(myThid), myByHi(myThid)
156			DO bi = myBxLo(myThid), myBxHi(myThid)
157			DO k=1,Nr
158			DO j=1-Oly,sNy+OLy
159			DO i=1-Olx,sNx+Olx
160			RBC_maskU(i,j,k,bi,bj) = RBC_maskU(i,j,k,bi,bj)
161			& * maskW(i,j,k,bi,bj)
162			RBC_maskV(i,j,k,bi,bj) = RBC_maskV(i,j,k,bi,bj)
163			& * maskS(i,j,k,bi,bj)
164			ENDDO
165			ENDDO
166			ENDDO
167			ENDDO
168			ENDDO
169	jmc	1.7	IF ( debugLevel.GE.debLevC ) THEN
170	jmc	1.8	CALL WRITE_FLD_XYZ_RS('RBC_maskU',' ',RBC_maskU,0,myThid )
171			CALL WRITE_FLD_XYZ_RS('RBC_maskV',' ',RBC_maskV,0,myThid )
172			ENDIF
173	jmc	1.6	ENDIF
174			#endif /* DISABLE_RBCS_MOM */
175
176	stephd	1.1	#endif /* ALLOW_RBCS */
177
178			RETURN
179			END