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

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

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


Revision 1.10 - (hide annotations) (download)
Sun Dec 6 15:33:16 2015 UTC (8 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u
Changes since 1.9: +7 -7 lines
fix writing format (in previous modif); thanks to Nils Bruggemann for
 reporting the Pb.

1 jmc 1.10 C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_init_fixed.F,v 1.9 2015/10/25 16:30:38 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 jmc 1.9 # include "PTRACERS_SIZE.h"
21     # include "PTRACERS_PARAMS.h"
22 stephd 1.1 #endif
23 jmc 1.6 #include "RBCS_SIZE.h"
24     #include "RBCS_PARAMS.h"
25     #include "RBCS_FIELDS.h"
26 stephd 1.1
27     C !INPUT PARAMETERS: ===================================================
28 jmc 1.5 C myThid :: my Thread Id number
29 stephd 1.1 INTEGER myThid
30     CEOP
31    
32     #ifdef ALLOW_RBCS
33 jmc 1.9 C !FUNCTIONS:
34     INTEGER ILNBLNK
35     EXTERNAL ILNBLNK
36    
37 stephd 1.1 C !LOCAL VARIABLES:
38 jmc 1.6 C i,j,k,bi,bj,irbc :: loop indices
39     C msgBuf :: Informational/error message buffer
40 stephd 1.1 INTEGER i,j,k,bi,bj
41 jmc 1.9 INTEGER irbc, iLen
42 jmc 1.6 CHARACTER*(MAX_LEN_MBUF) msgBuf
43 jmc 1.9 CHARACTER*(12) filName
44     #ifdef ALLOW_PTRACERS
45     INTEGER iTr
46 jmc 1.6 #endif
47 jmc 1.9
48     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
49     C Report RBCS mask setting
50    
51     _BEGIN_MASTER(myThid)
52    
53     WRITE(msgBuf,'(2A)') ' '
54     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
55     & SQUEEZE_RIGHT, myThid )
56     WRITE(msgBuf,'(2A)') ' --- RBCS_INIT_FIXED:',
57     & ' setting RBCS mask ---'
58     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
59     & SQUEEZE_RIGHT, myThid )
60    
61     IF ( useRBCtemp ) THEN
62     irbc = MIN(maskLEN,1)
63     IF ( relaxMaskFile(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(relaxMaskFile(irbc))
76     WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
77     & ') = "', relaxMaskFile(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 ( relaxMaskFile(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(relaxMaskFile(irbc))
101     WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
102     & ') = "', relaxMaskFile(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 jmc 1.10 WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
114 jmc 1.9 & ' relaxMaskUFile unset ==> use Temp mask instead'
115     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
116     & SQUEEZE_RIGHT, myThid )
117 jmc 1.10 WRITE(msgBuf,'(2A)') 'Warning:',
118 jmc 1.9 & ' relaxMaskUFile unset ==> use Temp mask instead'
119     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
120     & SQUEEZE_RIGHT, myThid )
121     ELSE
122     iLen = ILNBLNK(relaxMaskUFile)
123 jmc 1.10 WRITE(msgBuf,'(A,3A)') 'Use relaxMaskUFile',
124 jmc 1.9 & ' = "', 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 jmc 1.10 WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
136 jmc 1.9 & ' relaxMaskVFile unset ==> use Temp mask instead'
137     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
138     & SQUEEZE_RIGHT, myThid )
139 jmc 1.10 WRITE(msgBuf,'(2A)') 'Warning:',
140 jmc 1.9 & ' relaxMaskVFile unset ==> use Temp mask instead'
141     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
142     & SQUEEZE_RIGHT, myThid )
143     ELSE
144     iLen = ILNBLNK(relaxMaskVFile)
145 jmc 1.10 WRITE(msgBuf,'(A,3A)') 'Use relaxMaskVFile',
146 jmc 1.9 & ' = "', 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 ( relaxMaskFile(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(relaxMaskFile(irbc))
174     WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
175     & ') = "', relaxMaskFile(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 jmc 1.6
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
204     ENDDO
205     ENDDO
206     ENDDO
207     #endif /* DISABLE_RBCS_MOM */
208 stephd 1.1
209 jmc 1.5 C Loop over mask index
210     DO irbc=1,maskLEN
211    
212     C Loop over tiles
213 stephd 1.1 DO bj = myByLo(myThid), myByHi(myThid)
214 jmc 1.5 DO bi = myBxLo(myThid), myBxHi(myThid)
215 stephd 1.1
216 jmc 1.5 C Initialize arrays in common blocks :
217     DO k=1,Nr
218     DO j=1-Oly,sNy+OLy
219     DO i=1-Olx,sNx+Olx
220     RBC_mask(i,j,k,bi,bj,irbc) = 0. _d 0
221 stephd 1.1 ENDDO
222 jmc 1.5 ENDDO
223     ENDDO
224    
225     C end bi,bj loops
226 stephd 1.1 ENDDO
227     ENDDO
228 jmc 1.5 C end of mask index loop
229 stephd 1.1 ENDDO
230    
231     C read in mask for relaxing
232 jmc 1.5 DO irbc=1,maskLEN
233 stephd 1.2 IF ( relaxMaskFile(irbc).NE. ' ' ) THEN
234     CALL READ_FLD_XYZ_RS(relaxMaskFile(irbc),' ',
235     & RBC_mask(1-Olx,1-Oly,1,1,1,irbc), 0, myThid)
236 jmc 1.5 CALL EXCH_XYZ_RS( RBC_mask(1-Olx,1-Oly,1,1,1,irbc), myThid )
237 jmc 1.6 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 jmc 1.7 IF ( debugLevel.GE.debLevC ) THEN
251 jmc 1.8 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 stephd 1.2 ENDIF
256 jmc 1.5 ENDDO
257    
258 jmc 1.6 #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 jmc 1.7 IF ( debugLevel.GE.debLevC ) THEN
311 jmc 1.8 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 jmc 1.6 ENDIF
315     #endif /* DISABLE_RBCS_MOM */
316    
317 jmc 1.9 _BEGIN_MASTER(myThid)
318     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 stephd 1.1 #endif /* ALLOW_RBCS */
325    
326     RETURN
327     END

  ViewVC Help
Powered by ViewVC 1.1.22