/[MITgcm]/MITgcm/pkg/rbcs/rbcs_init_fixed.F
ViewVC logotype

Diff of /MITgcm/pkg/rbcs/rbcs_init_fixed.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.5 by jmc, Tue Apr 6 20:38:18 2010 UTC revision 1.6 by jmc, Sat May 14 19:52:12 2011 UTC
# Line 7  C !INTERFACE: ========================== Line 7  C !INTERFACE: ==========================
7        SUBROUTINE RBCS_INIT_FIXED( myThid )        SUBROUTINE RBCS_INIT_FIXED( myThid )
8    
9  C !DESCRIPTION:  C !DESCRIPTION:
10  C calls subroutines that initialized fixed variables for relaxed  C calls subroutines that initializes fixed variables for relaxed
11  c boundary conditions  c boundary conditions
12    
13  C !USES: ===============================================================  C !USES: ===============================================================
# Line 15  C !USES: =============================== Line 15  C !USES: ===============================
15  #include "SIZE.h"  #include "SIZE.h"
16  #include "EEPARAMS.h"  #include "EEPARAMS.h"
17  #include "PARAMS.h"  #include "PARAMS.h"
18  c#include "GRID.h"  #include "GRID.h"
19  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
20  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
21  #endif  #endif
22  #include "RBCS.h"  #include "RBCS_SIZE.h"
23    #include "RBCS_PARAMS.h"
24    #include "RBCS_FIELDS.h"
25    
26  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
27  C  myThid               :: my Thread Id number  C  myThid               :: my Thread Id number
# Line 28  CEOP Line 30  CEOP
30    
31  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
32  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
33  C     i,j,k,bi,bj,iTracer  :: loop indices  C     i,j,k,bi,bj,irbc  :: loop indices
34    C     msgBuf      :: Informational/error message buffer
35        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
36        INTEGER irbc        INTEGER irbc
37    #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    
59  C     Loop over mask index  C     Loop over mask index
60        DO irbc=1,maskLEN        DO irbc=1,maskLEN
# Line 60  C read in mask for relaxing Line 84  C read in mask for relaxing
84           CALL READ_FLD_XYZ_RS(relaxMaskFile(irbc),' ',           CALL READ_FLD_XYZ_RS(relaxMaskFile(irbc),' ',
85       &                RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid)       &                RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid)
86           CALL EXCH_XYZ_RS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc), myThid )           CALL EXCH_XYZ_RS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc), myThid )
87  c        IF ( debugMode ) THEN  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           IF ( debugLevel .GE. debLevB ) THEN           IF ( debugLevel .GE. debLevB ) THEN
101               _BARRIER
102             _BEGIN_MASTER( myThid )             _BEGIN_MASTER( myThid )
103             CALL PLOT_FIELD_XYRS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc),             CALL PLOT_FIELD_XYRS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc),
104       &                          'Boundary Relaxing' ,1, myThid )       &                          'Boundary Relaxing' ,1, myThid )
# Line 70  c        IF ( debugMode ) THEN Line 107  c        IF ( debugMode ) THEN
107         ENDIF         ENDIF
108        ENDDO        ENDDO
109    
110    #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             IF ( debugLevel .GE. debLevB ) THEN
171               _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  #endif /* ALLOW_RBCS */  #endif /* ALLOW_RBCS */
183    
184        RETURN        RETURN
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22