/[MITgcm]/MITgcm/model/src/ini_masks_etc.F
ViewVC logotype

Annotation of /MITgcm/model/src/ini_masks_etc.F

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


Revision 1.22 - (hide annotations) (download)
Thu Jul 5 21:44:25 2001 UTC (22 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre7, checkpoint40pre6, checkpoint40pre8, checkpoint40pre2, checkpoint40pre4, checkpoint40pre5
Changes since 1.21: +18 -6 lines
write hFacW and hFacS;
add a local common for multi-thread output of "Depth".

1 jmc 1.22 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_masks_etc.F,v 1.21 2001/05/29 14:01:37 adcroft Exp $
2 adcroft 1.21 C $Name: $
3 adcroft 1.1
4 cnh 1.11 #include "CPP_OPTIONS.h"
5 adcroft 1.1
6     CStartOfInterface
7     SUBROUTINE INI_MASKS_ETC( myThid )
8     C /==========================================================\
9     C | SUBROUTINE INI_MASKS_ETC |
10     C | o Initialise masks and topography factors |
11     C |==========================================================|
12     C | These arrays are used throughout the code and describe |
13     C | the topography of the domain through masks (0s and 1s) |
14     C | and fractional height factors (0<hFac<1). The latter |
15     C | distinguish between the lopped-cell and full-step |
16     C | topographic representations. |
17     C \==========================================================/
18 adcroft 1.13 IMPLICIT NONE
19 adcroft 1.1
20     C === Global variables ===
21     #include "SIZE.h"
22     #include "EEPARAMS.h"
23     #include "PARAMS.h"
24     #include "GRID.h"
25 adcroft 1.21 #include "SURFACE.h"
26 adcroft 1.1
27     C == Routine arguments ==
28 cnh 1.6 C myThid - Number of this instance of INI_MASKS_ETC
29 adcroft 1.1 INTEGER myThid
30     CEndOfInterface
31    
32 jmc 1.22 C == Local variables in common ==
33     C tmpfld - Temporary array used to compute & write Total Depth
34     C has to be in common for multi threading
35     COMMON / LOCAL_INI_MASKS_ETC / tmpfld
36     _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
37    
38 adcroft 1.1 C == Local variables ==
39     C bi,bj - Loop counters
40     C I,J,K
41     INTEGER bi, bj
42     INTEGER I, J, K
43 adcroft 1.15 #ifdef ALLOW_NONHYDROSTATIC
44     INTEGER Km1
45     _RL hFacUpper,hFacLower
46     #endif
47 adcroft 1.21 _RL hFacCtmp
48 adcroft 1.19 _RL hFacMnSz
49    
50 adcroft 1.21 C- Calculate lopping factor hFacC : over-estimate the part inside of the domain
51     C taking into account the lower_R Boundary (Bathymetrie / Top of Atmos)
52 adcroft 1.2 DO bj=myByLo(myThid), myByHi(myThid)
53     DO bi=myBxLo(myThid), myBxHi(myThid)
54 cnh 1.4 DO K=1, Nr
55 adcroft 1.21 hFacMnSz=max( hFacMin, min(hFacMinDr*recip_drF(k),1. _d 0) )
56 adcroft 1.19 DO J=1-Oly,sNy+Oly
57     DO I=1-Olx,sNx+Olx
58 adcroft 1.21 C o Non-dimensional distance between grid bound. and domain lower_R bound.
59     hFacCtmp = (rF(K)-R_low(I,J,bi,bj))*recip_drF(K)
60     C o Select between, closed, open or partial (0,1,0-1)
61 adcroft 1.19 hFacCtmp=min( max( hFacCtmp, 0. _d 0) , 1. _d 0)
62 adcroft 1.21 C o Impose minimum fraction and/or size (dimensional)
63     IF (hFacCtmp.LT.hFacMnSz) THEN
64     IF (hFacCtmp.LT.hFacMnSz*0.5) THEN
65 adcroft 1.3 hFacC(I,J,K,bi,bj)=0.
66     ELSE
67 adcroft 1.19 hFacC(I,J,K,bi,bj)=hFacMnSz
68 adcroft 1.3 ENDIF
69 adcroft 1.21 ELSE
70     hFacC(I,J,K,bi,bj)=hFacCtmp
71 adcroft 1.2 ENDIF
72     ENDDO
73     ENDDO
74     ENDDO
75 adcroft 1.21
76     C- Re-calculate lower-R Boundary position, taking into account hFacC
77     DO J=1-Oly,sNy+Oly
78     DO I=1-Olx,sNx+Olx
79     R_low(I,J,bi,bj) = rF(1)
80     DO K=Nr,1,-1
81     R_low(I,J,bi,bj) = R_low(I,J,bi,bj)
82     & - drF(k)*hFacC(I,J,K,bi,bj)
83     ENDDO
84     ENDDO
85     ENDDO
86     C - end bi,bj loops.
87 adcroft 1.2 ENDDO
88     ENDDO
89 cnh 1.7
90 adcroft 1.21 C- Calculate lopping factor hFacC : Remove part outside of the domain
91     C taking into account the Reference (=at rest) Surface Position Ro_surf
92 adcroft 1.16 DO bj=myByLo(myThid), myByHi(myThid)
93     DO bi=myBxLo(myThid), myBxHi(myThid)
94 adcroft 1.21 DO K=1, Nr
95     hFacMnSz=max( hFacMin, min(hFacMinDr*recip_drF(k),1. _d 0) )
96     DO J=1-Oly,sNy+Oly
97     DO I=1-Olx,sNx+Olx
98     C o Non-dimensional distance between grid boundary and model surface
99     hFacCtmp = (rF(k)-Ro_surf(I,J,bi,bj))*recip_drF(K)
100     C o Reduce the previous fraction : substract the outside part.
101     hFacCtmp = hFacC(I,J,K,bi,bj) - max( hFacCtmp, 0. _d 0)
102     C o set to zero if empty Column :
103     hFacCtmp = max( hFacCtmp, 0. _d 0)
104     C o Impose minimum fraction and/or size (dimensional)
105     IF (hFacCtmp.LT.hFacMnSz) THEN
106     IF (hFacCtmp.LT.hFacMnSz*0.5) THEN
107     hFacC(I,J,K,bi,bj)=0.
108     ELSE
109     hFacC(I,J,K,bi,bj)=hFacMnSz
110     ENDIF
111     ELSE
112     hFacC(I,J,K,bi,bj)=hFacCtmp
113     ENDIF
114     ENDDO
115     ENDDO
116     ENDDO
117    
118     C- Re-calculate Reference surface position, taking into account hFacC
119     C initialize Total column fluid thickness and surface k index
120 adcroft 1.19 DO J=1-Oly,sNy+Oly
121     DO I=1-Olx,sNx+Olx
122 adcroft 1.21 tmpfld(I,J,bi,bj) = 0.
123     k_surf(I,J,bi,bj) = Nr
124     Ro_surf(I,J,bi,bj) = R_low(I,J,bi,bj)
125     DO K=Nr,1,-1
126     Ro_surf(I,J,bi,bj) = Ro_surf(I,J,bi,bj)
127     & + drF(k)*hFacC(I,J,K,bi,bj)
128     IF (hFacC(I,J,K,bi,bj).NE.0.) THEN
129     k_surf(I,J,bi,bj) = k
130     tmpfld(i,j,bi,bj) = tmpfld(i,j,bi,bj) + 1.
131     ENDIF
132 adcroft 1.16 ENDDO
133     ENDDO
134     ENDDO
135 adcroft 1.21 C - end bi,bj loops.
136 adcroft 1.16 ENDDO
137     ENDDO
138 adcroft 1.21
139     C CALL PLOT_FIELD_XYRS( tmpfld,
140     C & 'Model Depths K Index' , 1, myThid )
141     CALL PLOT_FIELD_XYRS(R_low,
142     & 'Model R_low (ini_masks_etc)', 1, myThid)
143     CALL PLOT_FIELD_XYRS(Ro_surf,
144     & 'Model Ro_surf (ini_masks_etc)', 1, myThid)
145 adcroft 1.16
146     C Calculate quantities derived from XY depth map
147     DO bj = myByLo(myThid), myByHi(myThid)
148     DO bi = myBxLo(myThid), myBxHi(myThid)
149 adcroft 1.21 DO j=1-Oly,sNy+Oly
150     DO i=1-Olx,sNx+Olx
151     C Total fluid column thickness (r_unit) :
152     c Rcolumn(i,j,bi,bj)= Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj)
153     tmpfld(i,j,bi,bj) = Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj)
154     C Inverse of fluid column thickness (1/r_unit)
155     IF ( tmpfld(i,j,bi,bj) .LE. 0. ) THEN
156     recip_Rcol(i,j,bi,bj) = 0.
157 adcroft 1.16 ELSE
158 adcroft 1.21 recip_Rcol(i,j,bi,bj) = 1. / tmpfld(i,j,bi,bj)
159 adcroft 1.16 ENDIF
160     ENDDO
161     ENDDO
162     ENDDO
163     ENDDO
164 adcroft 1.21 C _EXCH_XY_R4( recip_Rcol, myThid )
165 adcroft 1.1
166     C hFacW and hFacS (at U and V points)
167     DO bj=myByLo(myThid), myByHi(myThid)
168     DO bi=myBxLo(myThid), myBxHi(myThid)
169 cnh 1.4 DO K=1, Nr
170 adcroft 1.1 DO J=1,sNy
171     DO I=1,sNx
172     hFacW(I,J,K,bi,bj)=
173     & MIN(hFacC(I,J,K,bi,bj),hFacC(I-1,J,K,bi,bj))
174     hFacS(I,J,K,bi,bj)=
175     & MIN(hFacC(I,J,K,bi,bj),hFacC(I,J-1,K,bi,bj))
176     ENDDO
177     ENDDO
178     ENDDO
179     ENDDO
180     ENDDO
181 adcroft 1.21 CALL EXCH_UV_XYZ_RS(hFacW,hFacS,.FALSE.,myThid)
182     C The following block allows thin walls representation of non-periodic
183     C boundaries such as happen on the lat-lon grid at the N/S poles.
184     C We should really supply a flag for doing this.
185 adcroft 1.19 DO bj=myByLo(myThid), myByHi(myThid)
186     DO bi=myBxLo(myThid), myBxHi(myThid)
187     DO K=1, Nr
188     DO J=1-Oly,sNy+Oly
189 adcroft 1.21 DO I=1-Olx,sNx+Olx
190     IF (DYG(I,J,bi,bj).EQ.0.) hFacW(I,J,K,bi,bj)=0.
191     IF (DXG(I,J,bi,bj).EQ.0.) hFacS(I,J,K,bi,bj)=0.
192 adcroft 1.19 ENDDO
193     ENDDO
194     ENDDO
195     ENDDO
196     ENDDO
197 jmc 1.22
198     C- Write to disk: Total Column Thickness & hFac(C,W,S):
199     _BARRIER
200     _BEGIN_MASTER( myThid )
201     C CALL MDSWRITEFIELD( 'Depth', writeBinaryPrec, .TRUE.,
202     C & 'RS', 1, tmpfld, 1, -1, myThid )
203     CALL WRITE_FLD_XY_RS( 'Depth',' ',tmpfld,0,myThid)
204     CALL WRITE_FLD_XYZ_RS( 'hFacC',' ',hFacC,0,myThid)
205     CALL WRITE_FLD_XYZ_RS( 'hFacW',' ',hFacW,0,myThid)
206     CALL WRITE_FLD_XYZ_RS( 'hFacS',' ',hFacS,0,myThid)
207     _END_MASTER(myThid)
208 adcroft 1.19
209     CALL PLOT_FIELD_XYZRS( hFacC, 'hFacC' , Nr, 1, myThid )
210     CALL PLOT_FIELD_XYZRS( hFacW, 'hFacW' , Nr, 1, myThid )
211     CALL PLOT_FIELD_XYZRS( hFacS, 'hFacS' , Nr, 1, myThid )
212 adcroft 1.1
213     C Masks and reciprocals of hFac[CWS]
214     DO bj = myByLo(myThid), myByHi(myThid)
215     DO bi = myBxLo(myThid), myBxHi(myThid)
216 cnh 1.4 DO K=1,Nr
217 adcroft 1.19 DO J=1-Oly,sNy+Oly
218     DO I=1-Olx,sNx+Olx
219     IF (HFacC(I,J,K,bi,bj) .NE. 0. ) THEN
220     recip_HFacC(I,J,K,bi,bj) = 1. / HFacC(I,J,K,bi,bj)
221 adcroft 1.21 maskC(I,J,K,bi,bj) = 1.
222 adcroft 1.1 ELSE
223 adcroft 1.19 recip_HFacC(I,J,K,bi,bj) = 0.
224 adcroft 1.21 maskC(I,J,K,bi,bj) = 0.
225 adcroft 1.1 ENDIF
226 adcroft 1.19 IF (HFacW(I,J,K,bi,bj) .NE. 0. ) THEN
227     recip_HFacW(I,J,K,bi,bj) = 1. / HFacW(I,J,K,bi,bj)
228     maskW(I,J,K,bi,bj) = 1.
229 adcroft 1.1 ELSE
230 adcroft 1.19 recip_HFacW(I,J,K,bi,bj) = 0.
231     maskW(I,J,K,bi,bj) = 0.
232 adcroft 1.1 ENDIF
233 adcroft 1.19 IF (HFacS(I,J,K,bi,bj) .NE. 0. ) THEN
234     recip_HFacS(I,J,K,bi,bj) = 1. / HFacS(I,J,K,bi,bj)
235     maskS(I,J,K,bi,bj) = 1.
236 adcroft 1.1 ELSE
237 adcroft 1.19 recip_HFacS(I,J,K,bi,bj) = 0.
238     maskS(I,J,K,bi,bj) = 0.
239 adcroft 1.1 ENDIF
240     ENDDO
241     ENDDO
242     ENDDO
243     ENDDO
244     ENDDO
245 adcroft 1.19 C _EXCH_XYZ_R4(recip_HFacC , myThid )
246     C _EXCH_XYZ_R4(recip_HFacW , myThid )
247     C _EXCH_XYZ_R4(recip_HFacS , myThid )
248     C _EXCH_XYZ_R4(maskW , myThid )
249     C _EXCH_XYZ_R4(maskS , myThid )
250 adcroft 1.1
251     C Calculate recipricols grid lengths
252     DO bj = myByLo(myThid), myByHi(myThid)
253     DO bi = myBxLo(myThid), myBxHi(myThid)
254 adcroft 1.19 DO J=1-Oly,sNy+Oly
255     DO I=1-Olx,sNx+Olx
256     IF ( dxG(I,J,bi,bj) .NE. 0. )
257     & recip_dxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj)
258     IF ( dyG(I,J,bi,bj) .NE. 0. )
259     & recip_dyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj)
260     IF ( dxC(I,J,bi,bj) .NE. 0. )
261     & recip_dxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj)
262     IF ( dyC(I,J,bi,bj) .NE. 0. )
263     & recip_dyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj)
264     IF ( dxF(I,J,bi,bj) .NE. 0. )
265     & recip_dxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj)
266     IF ( dyF(I,J,bi,bj) .NE. 0. )
267     & recip_dyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj)
268     IF ( dxV(I,J,bi,bj) .NE. 0. )
269     & recip_dxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj)
270     IF ( dyU(I,J,bi,bj) .NE. 0. )
271     & recip_dyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj)
272     IF ( rA(I,J,bi,bj) .NE. 0. )
273     & recip_rA(I,J,bi,bj)=1.d0/rA(I,J,bi,bj)
274     IF ( rAs(I,J,bi,bj) .NE. 0. )
275     & recip_rAs(I,J,bi,bj)=1.d0/rAs(I,J,bi,bj)
276     IF ( rAw(I,J,bi,bj) .NE. 0. )
277     & recip_rAw(I,J,bi,bj)=1.d0/rAw(I,J,bi,bj)
278     IF ( rAz(I,J,bi,bj) .NE. 0. )
279     & recip_rAz(I,J,bi,bj)=1.d0/rAz(I,J,bi,bj)
280 adcroft 1.1 ENDDO
281     ENDDO
282     ENDDO
283     ENDDO
284 adcroft 1.19 C Do not need these since above denominators are valid over full range
285     C _EXCH_XY_R4(recip_dxG, myThid )
286     C _EXCH_XY_R4(recip_dyG, myThid )
287     C _EXCH_XY_R4(recip_dxC, myThid )
288     C _EXCH_XY_R4(recip_dyC, myThid )
289     C _EXCH_XY_R4(recip_dxF, myThid )
290     C _EXCH_XY_R4(recip_dyF, myThid )
291     C _EXCH_XY_R4(recip_dxV, myThid )
292     C _EXCH_XY_R4(recip_dyU, myThid )
293     C _EXCH_XY_R4(recip_rAw, myThid )
294     C _EXCH_XY_R4(recip_rAs, myThid )
295 adcroft 1.1
296 adcroft 1.15 #ifdef ALLOW_NONHYDROSTATIC
297     C-- Calculate the reciprocal hfac distance/volume for W cells
298     DO bj = myByLo(myThid), myByHi(myThid)
299     DO bi = myBxLo(myThid), myBxHi(myThid)
300     DO K=1,Nr
301     Km1=max(K-1,1)
302     hFacUpper=drF(Km1)/(drF(Km1)+drF(K))
303     IF (Km1.EQ.K) hFacUpper=0.
304     hFacLower=drF(K)/(drF(Km1)+drF(K))
305 adcroft 1.19 DO J=1-Oly,sNy+Oly
306     DO I=1-Olx,sNx+Olx
307 adcroft 1.15 IF (hFacC(I,J,K,bi,bj).NE.0.) THEN
308     IF (hFacC(I,J,K,bi,bj).LE.0.5) THEN
309     recip_hFacU(I,J,K,bi,bj)=
310     & hFacUpper+hFacLower*hFacC(I,J,K,bi,bj)
311     ELSE
312     recip_hFacU(I,J,K,bi,bj)=1.
313     ENDIF
314     ELSE
315     recip_hFacU(I,J,K,bi,bj)=0.
316     ENDIF
317     IF (recip_hFacU(I,J,K,bi,bj).NE.0.)
318     & recip_hFacU(I,J,K,bi,bj)=1./recip_hFacU(I,J,K,bi,bj)
319     ENDDO
320     ENDDO
321     ENDDO
322     ENDDO
323     ENDDO
324 adcroft 1.19 C _EXCH_XY_R4(recip_hFacU, myThid )
325 adcroft 1.15 #endif
326 adcroft 1.1 C
327     RETURN
328     END

  ViewVC Help
Powered by ViewVC 1.1.22