/[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.1 by stephd, Thu Dec 8 00:14:00 2005 UTC revision 1.11 by jmc, Wed Nov 15 23:33:54 2017 UTC
# Line 1  Line 1 
1  #include "CPP_OPTIONS.h"  C $Header$
2  #include "PACKAGES_CONFIG.h"  C $Name$
3    
4    #include "RBCS_OPTIONS.h"
5    
6  C !INTERFACE: ==========================================================  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: ===============================================================
14        IMPLICIT NONE        IMPLICIT NONE
15  #include "SIZE.h"  #include "SIZE.h"
 #include "GRID.h"  
 #include "DYNVARS.h"  
16  #include "EEPARAMS.h"  #include "EEPARAMS.h"
17  #include "PARAMS.h"  #include "PARAMS.h"
18    #include "GRID.h"
19  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
20  #include "PTRACERS_SIZE.h"  # include "PTRACERS_SIZE.h"
21    # include "PTRACERS_PARAMS.h"
22  #endif  #endif
23  #include "RBCS.h"  #include "RBCS_SIZE.h"
24    #include "RBCS_PARAMS.h"
25    #include "RBCS_FIELDS.h"
26    
27  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
28  C  myThid               :: thread number  C  myThid               :: my Thread Id number
29        INTEGER myThid        INTEGER myThid
30  CEOP  CEOP
31    
32  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
33    C     !FUNCTIONS:
34          INTEGER  ILNBLNK
35          EXTERNAL ILNBLNK
36    
37  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
38  C     i,j,k,bi,bj,iTracer  :: loop indices  C     i,j,k,bi,bj,irbc  :: loop indices
39    C     msgBuf      :: Informational/error message buffer
40        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
41          INTEGER irbc, iLen
42          CHARACTER*(MAX_LEN_MBUF) msgBuf
43          CHARACTER*(12) filName
44  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
45        INTEGER iTracer        INTEGER iTr
46  #endif  #endif
47    
48  C       Loop over tiles  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
49          DO bj = myByLo(myThid), myByHi(myThid)  C     Report RBCS mask setting
           DO bi = myBxLo(myThid), myBxHi(myThid)  
50    
51  C           Initialize arrays in common blocks :        _BEGIN_MASTER(myThid)
52              DO k=1,Nr  
53                DO j=1-Oly,sNy+OLy        WRITE(msgBuf,'(2A)') ' '
54                  DO i=1-Olx,sNx+Olx        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
55                    RBC_mask(i,j,k,bi,bj) = 0. _d 0       &                    SQUEEZE_RIGHT, myThid )
56                    RBCtemp(i,j,k,bi,bj)    = 0. _d 0        WRITE(msgBuf,'(2A)') ' ---  RBCS_INIT_FIXED:',
57                    RBCsalt(i,j,k,bi,bj) = 0. _d 0       &                     ' setting RBCS mask  ---'
58                  ENDDO        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
59                ENDDO       &                    SQUEEZE_RIGHT, myThid )
60               ENDDO  
61          IF ( useRBCtemp ) THEN
62            irbc = MIN(maskLEN,1)
63            IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
64             WRITE(msgBuf,'(2A,I3,2A)') '** WARNING ** RBCS_INIT_FIXED:',
65         &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
66         &     ' for Temp'
67             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
68         &                       SQUEEZE_RIGHT, myThid )
69             WRITE(msgBuf,'(2A,I3,2A)') 'Warning:',
70         &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
71         &     ' for Temp'
72             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
73         &                       SQUEEZE_RIGHT, myThid )
74            ELSE
75             iLen = ILNBLNK(relaxMaskTrFile(irbc))
76             WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
77         &     ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
78             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
79         &                       SQUEEZE_RIGHT, myThid )
80             WRITE(msgBuf,'(A,1PE21.13)')
81         &     ' for Temp  relaxation with tauRelaxT =', tauRelaxT
82             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
83         &                       SQUEEZE_RIGHT, myThid )
84            ENDIF
85          ENDIF
86          IF ( useRBCsalt ) THEN
87            irbc = MIN(maskLEN,2)
88            IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
89             WRITE(msgBuf,'(2A,I3,2A)') '** WARNING ** RBCS_INIT_FIXED:',
90         &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
91         &     ' for Salt'
92             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
93         &                       SQUEEZE_RIGHT, myThid )
94             WRITE(msgBuf,'(2A,I3,2A)') 'Warning:',
95         &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
96         &     ' for Salt'
97             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
98         &                       SQUEEZE_RIGHT, myThid )
99            ELSE
100             iLen = ILNBLNK(relaxMaskTrFile(irbc))
101             WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
102         &     ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
103             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
104         &                       SQUEEZE_RIGHT, myThid )
105             WRITE(msgBuf,'(A,1PE21.13)')
106         &     ' for Salt  relaxation with tauRelaxS =', tauRelaxS
107             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
108         &                       SQUEEZE_RIGHT, myThid )
109            ENDIF
110          ENDIF
111          IF ( useRBCuVel ) THEN
112            IF ( relaxMaskUFile.EQ. ' ' ) THEN
113             WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
114         &     ' relaxMaskUFile unset ==> use Temp mask instead'
115             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
116         &                       SQUEEZE_RIGHT, myThid )
117             WRITE(msgBuf,'(2A)') 'Warning:',
118         &     ' relaxMaskUFile unset ==> use Temp mask instead'
119             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
120         &                       SQUEEZE_RIGHT, myThid )
121            ELSE
122             iLen = ILNBLNK(relaxMaskUFile)
123             WRITE(msgBuf,'(A,3A)') 'Use relaxMaskUFile',
124         &     ' = "', relaxMaskUFile(1:iLen), '"'
125             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
126         &                       SQUEEZE_RIGHT, myThid )
127            ENDIF
128             WRITE(msgBuf,'(A,1PE21.13)')
129         &     ' for U-Vel relaxation with tauRelaxU =', tauRelaxU
130             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
131         &                       SQUEEZE_RIGHT, myThid )
132          ENDIF
133          IF ( useRBCvVel ) THEN
134            IF ( relaxMaskVFile.EQ. ' ' ) THEN
135             WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
136         &     ' relaxMaskVFile unset ==> use Temp mask instead'
137             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
138         &                       SQUEEZE_RIGHT, myThid )
139             WRITE(msgBuf,'(2A)') 'Warning:',
140         &     ' relaxMaskVFile unset ==> use Temp mask instead'
141             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
142         &                       SQUEEZE_RIGHT, myThid )
143            ELSE
144             iLen = ILNBLNK(relaxMaskVFile)
145             WRITE(msgBuf,'(A,3A)') 'Use relaxMaskVFile',
146         &     ' = "', relaxMaskVFile(1:iLen), '"'
147             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
148         &                       SQUEEZE_RIGHT, myThid )
149            ENDIF
150             WRITE(msgBuf,'(A,1PE21.13)')
151         &     ' for V-Vel relaxation with tauRelaxV =', tauRelaxV
152             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
153         &                       SQUEEZE_RIGHT, myThid )
154          ENDIF
155    #ifdef ALLOW_PTRACERS
156          IF ( usePTRACERS .AND. PTRACERS_numInUse.GE.1 ) THEN
157           DO iTr=1,PTRACERS_numInUse
158            IF ( useRBCpTrNum(iTr) ) THEN
159             irbc = MIN(maskLEN,2+iTr)
160             IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
161              WRITE(msgBuf,'(2A,I3,2A,I3)')
162         &     '** WARNING ** RBCS_INIT_FIXED:',
163         &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
164         &     ' for pTr=', iTr
165              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
166         &                        SQUEEZE_RIGHT, myThid )
167              WRITE(msgBuf,'(2A,I3,2A,I3)') 'Warning:',
168         &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
169         &     ' for pTr=', iTr
170              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
171         &                        SQUEEZE_RIGHT, myThid )
172             ELSE
173              iLen = ILNBLNK(relaxMaskTrFile(irbc))
174              WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
175         &     ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
176              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
177         &                        SQUEEZE_RIGHT, myThid )
178              WRITE(msgBuf,'(A,I3,A,1PE21.13)')
179         &     ' for pTr=', iTr, ' relaxation, tauRelaxPTR =',
180         &                          tauRelaxPTR(iTr)
181              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
182         &                        SQUEEZE_RIGHT, myThid )
183             ENDIF
184            ENDIF
185           ENDDO
186          ENDIF
187    #endif /* ALLOW_PTRACERS */
188    
189          _END_MASTER(myThid)
190    
191    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
192    
193    #ifndef DISABLE_RBCS_MOM
194    C     Loop over tiles
195          DO bj = myByLo(myThid), myByHi(myThid)
196           DO bi = myBxLo(myThid), myBxHi(myThid)
197             DO k=1,Nr
198              DO j=1-OLy,sNy+OLy
199               DO i=1-OLx,sNx+OLx
200                 RBC_maskU(i,j,k,bi,bj) = 0. _d 0
201                 RBC_maskV(i,j,k,bi,bj) = 0. _d 0
202               ENDDO
203            ENDDO            ENDDO
204           ENDDO           ENDDO
205  #ifdef ALLOW_PTRACERS         ENDDO
206  C     Loop over tracers        ENDDO
207        DO iTracer = 1, PTRACERS_num  #endif /* DISABLE_RBCS_MOM */
208    
209    C     Loop over mask index
210          DO irbc=1,maskLEN
211    
212  C       Loop over tiles  C     Loop over tiles
213          DO bj = myByLo(myThid), myByHi(myThid)          DO bj = myByLo(myThid), myByHi(myThid)
214            DO bi = myBxLo(myThid), myBxHi(myThid)           DO bi = myBxLo(myThid), myBxHi(myThid)
215    
216  C           Initialize arrays in common blocks :  C        Initialize arrays in common blocks :
217              DO k=1,Nr             DO k=1,Nr
218                DO j=1-Oly,sNy+OLy              DO j=1-OLy,sNy+OLy
219                  DO i=1-Olx,sNx+Olx               DO i=1-OLx,sNx+OLx
220                    RBC_ptracers(i,j,k,bi,bj,iTracer) = 0. _d 0                 RBC_mask(i,j,k,bi,bj,irbc) = 0. _d 0
221                 ENDDO               ENDDO
               ENDDO  
222              ENDDO              ENDDO
223  C           end bi,bj loops             ENDDO
           ENDDO  
         ENDDO  
224    
225  C       end of Tracer loop  C        end bi,bj loops
226             ENDDO
227            ENDDO
228    C     end of mask index loop
229        ENDDO        ENDDO
 #endif  
230    
231  C read in mask for relaxing  C read in mask for relaxing
232        IF ( relaxBoundaryFile.NE. ' ' ) THEN        DO irbc=1,maskLEN
233         _BEGIN_MASTER( myThid )         IF ( relaxMaskTrFile(irbc).NE. ' ' ) THEN
234          CALL READ_FLD_XYZ_RS(relaxBoundaryFile,' ', RBC_mask, 0, myThid)           CALL READ_FLD_XYZ_RS( relaxMaskTrFile(irbc), ' ',
235         _END_MASTER(myThid)       &                RBC_mask(1-OLx,1-OLy,1,1,1,irbc), 0, myThid )
236             CALL EXCH_XYZ_RS( RBC_mask(1-OLx,1-OLy,1,1,1,irbc), myThid )
237    C--   Apply mask:
238             DO bj = myByLo(myThid), myByHi(myThid)
239              DO bi = myBxLo(myThid), myBxHi(myThid)
240               DO k=1,Nr
241                DO j=1-OLy,sNy+OLy
242                 DO i=1-OLx,sNx+OLx
243                   RBC_mask(i,j,k,bi,bj,irbc) = RBC_mask(i,j,k,bi,bj,irbc)
244         &                                    * maskC(i,j,k,bi,bj)
245                 ENDDO
246                ENDDO
247               ENDDO
248              ENDDO
249             ENDDO
250             IF ( debugLevel.GE.debLevC ) THEN
251               WRITE(filName,'(A,I3.3)') 'RBC_mask_',irbc
252               CALL WRITE_FLD_XYZ_RS( filName,' ',
253         &                RBC_mask(1-OLx,1-OLy,1,1,1,irbc), 0, myThid )
254             ENDIF
255           ENDIF
256          ENDDO
257    
258    #ifndef DISABLE_RBCS_MOM
259          IF ( useRBCuVel .AND. relaxMaskUFile.NE. ' ' ) THEN
260            CALL READ_FLD_XYZ_RS(relaxMaskUFile,' ',RBC_maskU, 0, myThid)
261          ELSEIF( useRBCuVel ) THEN
262            DO bj = myByLo(myThid), myByHi(myThid)
263             DO bi = myBxLo(myThid), myBxHi(myThid)
264               DO k=1,Nr
265                DO j=1-OLy,sNy+OLy
266                 DO i=2-OLx,sNx+OLx
267                   RBC_maskU(i,j,k,bi,bj) =
268         &                  ( RBC_mask(i-1,j,k,bi,bj,1)
269         &                  + RBC_mask( i ,j,k,bi,bj,1) )*0.5 _d 0
270                 ENDDO
271                ENDDO
272               ENDDO
273             ENDDO
274            ENDDO
275          ENDIF
276          IF ( useRBCvVel .AND. relaxMaskVFile.NE. ' ' ) THEN
277            CALL READ_FLD_XYZ_RS(relaxMaskVFile,' ',RBC_maskV, 0, myThid)
278          ELSEIF( useRBCvVel ) THEN
279            DO bj = myByLo(myThid), myByHi(myThid)
280             DO bi = myBxLo(myThid), myBxHi(myThid)
281               DO k=1,Nr
282                DO j=2-OLy,sNy+OLy
283                 DO i=1-OLx,sNx+OLx
284                   RBC_maskV(i,j,k,bi,bj) =
285         &                  ( RBC_mask(i,j-1,k,bi,bj,1)
286         &                  + RBC_mask(i, j ,k,bi,bj,1) )*0.5 _d 0
287                 ENDDO
288                ENDDO
289               ENDDO
290             ENDDO
291            ENDDO
292          ENDIF
293          IF( useRBCuVel .OR. useRBCvVel ) THEN
294             CALL EXCH_UV_XYZ_RS( RBC_maskU, RBC_maskV, .FALSE., myThid )
295    C--   Apply mask:
296             DO bj = myByLo(myThid), myByHi(myThid)
297              DO bi = myBxLo(myThid), myBxHi(myThid)
298               DO k=1,Nr
299                DO j=1-OLy,sNy+OLy
300                 DO i=1-OLx,sNx+OLx
301                   RBC_maskU(i,j,k,bi,bj) = RBC_maskU(i,j,k,bi,bj)
302         &                                * maskW(i,j,k,bi,bj)
303                   RBC_maskV(i,j,k,bi,bj) = RBC_maskV(i,j,k,bi,bj)
304         &                                * maskS(i,j,k,bi,bj)
305                 ENDDO
306                ENDDO
307               ENDDO
308              ENDDO
309             ENDDO
310             IF ( debugLevel.GE.debLevC ) THEN
311               CALL WRITE_FLD_XYZ_RS('RBC_maskU',' ',RBC_maskU,0,myThid )
312               CALL WRITE_FLD_XYZ_RS('RBC_maskV',' ',RBC_maskV,0,myThid )
313             ENDIF
314        ENDIF        ENDIF
315  C  #endif /* DISABLE_RBCS_MOM */
       _EXCH_XYZ_R4(RBC_mask, myThid )  
316    
317        CALL PLOT_FIELD_XYRS( RBC_mask, 'Boundary Relaxing' ,        _BEGIN_MASTER(myThid)
318       &                       1, myThid )        WRITE(msgBuf,'(2A)') ' ---  RBCS_INIT_FIXED:',
319         &                     ' setting RBCS mask done'
320          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
321         &                    SQUEEZE_RIGHT, myThid )
322          _END_MASTER(myThid)
323    
324  #endif /* ALLOW_RBCS */  #endif /* ALLOW_RBCS */
325    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22