/[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.16 - (hide annotations) (download)
Wed May 5 18:32:34 1999 UTC (25 years, 1 month ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint21
Changes since 1.15: +38 -19 lines
Implemented new I/O package (mdsio.F). This package does parallel
I/O in much the same way as dfile.F used to except it uses "direct
access" rather than (f77) unformatted sequential access.

Problems with dfile.F package included:
  o unnecessary memory use (each process had two global sized buffers)
  o inability to read the files it had written without post-processing
  o "tiled" files were tiled by process/thread rather than actual tiles
  o created huge numbers of files with no alternatives

Features of the mdsio.F package:
  o direct-access binary writes
  o no excessive memory use
  o ability to read/write from multiple record files
  o "tiled" files are based on "WRAPPER" tiles so that the number
    and content of files is independent of the number of threads
    and/or processes
  o option to create single "global" files rather than "tiled" files
  o ability to read both "global" and "tiled" files
    [Caveat: the tiling of files must match the model tiles]
  o checkpoints now use a single file per model section
    ie.  one file for the hydrostatic model core, one file
    for the non-hydrostatic extensions and one file for the C-D
    extensions
  o the mid-level I/O routines now is broken into more source files
    read_write_fld.F supplies basic I/O routines with the same interface
                     as the original I/O package
    read_write_rec.F supplies I/O routines which allow multiple records
    write_state.F    writes the model state
    checkpoint.F     supplies the read/write checkpoint routines

All the example input data has had to be modified to be direct-access.
Otherwise only routines that used I/O have been affected and not
all of those have been due to the continuity of arguments in
the read_write_fld.F routines.

What needs to be done?  We have to create a suite of conversion
utilities for users with old-style data. Also supply the option
for using old-style I/O, not just for die-hards but for reading
data too extensive to be converted. And more...

1 adcroft 1.16 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_masks_etc.F,v 1.15 1999/03/22 15:54:04 adcroft Exp $
2 adcroft 1.1
3 cnh 1.11 #include "CPP_OPTIONS.h"
4 adcroft 1.1
5     CStartOfInterface
6     SUBROUTINE INI_MASKS_ETC( myThid )
7     C /==========================================================\
8     C | SUBROUTINE INI_MASKS_ETC |
9     C | o Initialise masks and topography factors |
10     C |==========================================================|
11     C | These arrays are used throughout the code and describe |
12     C | the topography of the domain through masks (0s and 1s) |
13     C | and fractional height factors (0<hFac<1). The latter |
14     C | distinguish between the lopped-cell and full-step |
15     C | topographic representations. |
16     C \==========================================================/
17 adcroft 1.13 IMPLICIT NONE
18 adcroft 1.1
19     C === Global variables ===
20     #include "SIZE.h"
21     #include "EEPARAMS.h"
22     #include "PARAMS.h"
23     #include "GRID.h"
24    
25     C == Routine arguments ==
26 cnh 1.6 C myThid - Number of this instance of INI_MASKS_ETC
27 adcroft 1.1 INTEGER myThid
28     CEndOfInterface
29    
30     C == Local variables ==
31     C bi,bj - Loop counters
32     C I,J,K
33     INTEGER bi, bj
34     INTEGER I, J, K
35 adcroft 1.15 #ifdef ALLOW_NONHYDROSTATIC
36     INTEGER Km1
37     _RL hFacUpper,hFacLower
38     #endif
39 adcroft 1.1
40 adcroft 1.2 C Calculate lopping factor hFacC
41     DO bj=myByLo(myThid), myByHi(myThid)
42     DO bi=myBxLo(myThid), myBxHi(myThid)
43 cnh 1.4 DO K=1, Nr
44 adcroft 1.2 DO J=1,sNy
45     DO I=1,sNx
46 cnh 1.7 C Round depths within a small fraction of layer depth to that
47     C layer depth.
48 cnh 1.9 IF ( ABS(H(I,J,bi,bj)-rF(K)) .LT.
49     & 1. _d -6*ABS(rF(K)) .AND.
50     & ABS(H(I,J,bi,bj)-rF(K)) .LT.
51     & 1. _d -6*ABS(H(I,J,bi,bj)) )THEN
52 cnh 1.7 H(I,J,bi,bj) = rF(K)
53     ENDIF
54 cnh 1.6 IF ( H(I,J,bi,bj)*rkFac .GE. rF(K)*rkFac ) THEN
55 adcroft 1.3 C Top of cell is below base of domain
56 adcroft 1.2 hFacC(I,J,K,bi,bj) = 0.
57 cnh 1.6 ELSEIF ( H(I,J,bi,bj)*rkFac .LE. rF(K+1)*rkFac ) THEN
58 adcroft 1.3 C Base of domain is below bottom of this cell
59 adcroft 1.2 hFacC(I,J,K,bi,bj) = 1.
60     ELSE
61     C Base of domain is in this cell
62 adcroft 1.3 C Set hFac to the fraction of the cell that is open.
63 adcroft 1.15 hFacC(I,J,K,bi,bj) =
64     & (rF(K)*rkFac-H(I,J,bi,bj)*rkFac)*recip_drF(K)
65 adcroft 1.3 ENDIF
66     C Impose minimum fraction
67     IF (hFacC(I,J,K,bi,bj).LT.hFacMin) THEN
68     IF (hFacC(I,J,K,bi,bj).LT.hFacMin*0.5) THEN
69     hFacC(I,J,K,bi,bj)=0.
70     ELSE
71     hFacC(I,J,K,bi,bj)=hFacMin
72     ENDIF
73     ENDIF
74     C Impose minimum size (dimensional)
75 cnh 1.5 IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDr) THEN
76     IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDr*0.5) THEN
77 adcroft 1.3 hFacC(I,J,K,bi,bj)=0.
78     ELSE
79 cnh 1.5 hFacC(I,J,K,bi,bj)=hFacMinDr*recip_drF(k)
80 adcroft 1.3 ENDIF
81 adcroft 1.2 ENDIF
82 cnh 1.9 depthInK(i,j,bi,bj) = depthInK(i,j,bi,bj)
83     & +hFacC(i,j,k,bi,bj)
84 adcroft 1.2 ENDDO
85     ENDDO
86     ENDDO
87     ENDDO
88     ENDDO
89     _EXCH_XYZ_R4(hFacC , myThid )
90 cnh 1.7 _EXCH_XY_R4( depthInK, myThid )
91    
92 cnh 1.9 CALL PLOT_FIELD_XYRS( depthInK,
93     & 'Model Depths K Index' , 1, myThid )
94 adcroft 1.16
95     C Re-calculate depth of ocean, taking into account hFacC
96     DO bj=myByLo(myThid), myByHi(myThid)
97     DO bi=myBxLo(myThid), myBxHi(myThid)
98     DO J=1,sNy
99     DO I=1,sNx
100     H(I,J,bi,bj)=0.
101     DO K=1,Nr
102     H(I,J,bi,bj)=H(I,J,bi,bj)-
103     & rkFac*drF(k)*hFacC(I,J,K,bi,bj)
104     ENDDO
105     ENDDO
106     ENDDO
107     ENDDO
108     ENDDO
109     _EXCH_XY_R4(H , myThid )
110     CALL WRITE_FLD_XY_RS( 'Depth',' ',H,0,myThid)
111     C CALL MDSWRITEFIELD( 'Depth', writeBinaryPrec, .TRUE.,
112     C & 'RS', 1, H, 1, -1, myThid )
113    
114     C Calculate quantities derived from XY depth map
115     DO bj = myByLo(myThid), myByHi(myThid)
116     DO bi = myBxLo(myThid), myBxHi(myThid)
117     DO J=1,sNy
118     DO I=1,sNx
119     C Inverse of depth
120     IF ( h(i,j,bi,bj) .EQ. 0. _d 0 ) THEN
121     recip_H(i,j,bi,bj) = 0. _d 0
122     ELSE
123     recip_H(i,j,bi,bj) = 1. _d 0 / abs( H(i,j,bi,bj) )
124     ENDIF
125     depthInK(i,j,bi,bj) = 0.
126     ENDDO
127     ENDDO
128     ENDDO
129     ENDDO
130     _EXCH_XY_R4( recip_H, myThid )
131 adcroft 1.1
132     C hFacW and hFacS (at U and V points)
133     DO bj=myByLo(myThid), myByHi(myThid)
134     DO bi=myBxLo(myThid), myBxHi(myThid)
135 cnh 1.4 DO K=1, Nr
136 adcroft 1.1 DO J=1,sNy
137     DO I=1,sNx
138     hFacW(I,J,K,bi,bj)=
139     & MIN(hFacC(I,J,K,bi,bj),hFacC(I-1,J,K,bi,bj))
140     hFacS(I,J,K,bi,bj)=
141     & MIN(hFacC(I,J,K,bi,bj),hFacC(I,J-1,K,bi,bj))
142     ENDDO
143     ENDDO
144     ENDDO
145     ENDDO
146     ENDDO
147     _EXCH_XYZ_R4(hFacW , myThid )
148     _EXCH_XYZ_R4(hFacS , myThid )
149    
150     C Masks and reciprocals of hFac[CWS]
151     DO bj = myByLo(myThid), myByHi(myThid)
152     DO bi = myBxLo(myThid), myBxHi(myThid)
153 cnh 1.4 DO K=1,Nr
154 adcroft 1.1 DO J=1,sNy
155     DO I=1,sNx
156 cnh 1.10 IF (HFacC(I,J,K,bi,bj) .NE. 0. _d 0 ) THEN
157     recip_HFacC(I,J,K,bi,bj) = 1. _d 0 / HFacC(I,J,K,bi,bj)
158 adcroft 1.1 ELSE
159 cnh 1.10 recip_HFacC(I,J,K,bi,bj) = 0. _d 0
160 adcroft 1.1 ENDIF
161 cnh 1.10 IF (HFacW(I,J,K,bi,bj) .NE. 0. _d 0 ) THEN
162     recip_HFacW(I,J,K,bi,bj) = 1. _d 0 / HFacW(I,J,K,bi,bj)
163     maskW(I,J,K,bi,bj) = 1. _d 0
164 adcroft 1.1 ELSE
165 cnh 1.10 recip_HFacW(I,J,K,bi,bj) = 0. _d 0
166     maskW(I,J,K,bi,bj) = 0.0 _d 0
167 adcroft 1.1 ENDIF
168 cnh 1.10 IF (HFacS(I,J,K,bi,bj) .NE. 0. _d 0 ) THEN
169     recip_HFacS(I,J,K,bi,bj) = 1. _d 0 / HFacS(I,J,K,bi,bj)
170     maskS(I,J,K,bi,bj) = 1. _d 0
171 adcroft 1.1 ELSE
172 cnh 1.10 recip_HFacS(I,J,K,bi,bj) = 0. _d 0
173     maskS(I,J,K,bi,bj) = 0. _d 0
174 adcroft 1.1 ENDIF
175     ENDDO
176     ENDDO
177     ENDDO
178     ENDDO
179     ENDDO
180 cnh 1.4 _EXCH_XYZ_R4(recip_HFacC , myThid )
181     _EXCH_XYZ_R4(recip_HFacW , myThid )
182     _EXCH_XYZ_R4(recip_HFacS , myThid )
183 adcroft 1.1 _EXCH_XYZ_R4(maskW , myThid )
184     _EXCH_XYZ_R4(maskS , myThid )
185    
186     C Calculate recipricols grid lengths
187     DO bj = myByLo(myThid), myByHi(myThid)
188     DO bi = myBxLo(myThid), myBxHi(myThid)
189     DO J=1,sNy
190     DO I=1,sNx
191 cnh 1.4 recip_dxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj)
192     recip_dyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj)
193     recip_dxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj)
194     recip_dyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj)
195     recip_dxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj)
196     recip_dyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj)
197     recip_dxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj)
198     recip_dyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj)
199 adcroft 1.1 ENDDO
200     ENDDO
201     ENDDO
202     ENDDO
203 cnh 1.4 _EXCH_XY_R4(recip_dxG, myThid )
204     _EXCH_XY_R4(recip_dyG, myThid )
205     _EXCH_XY_R4(recip_dxC, myThid )
206     _EXCH_XY_R4(recip_dyC, myThid )
207     _EXCH_XY_R4(recip_dxF, myThid )
208     _EXCH_XY_R4(recip_dyF, myThid )
209     _EXCH_XY_R4(recip_dxV, myThid )
210     _EXCH_XY_R4(recip_dyU, myThid )
211 adcroft 1.1
212 adcroft 1.15 #ifdef ALLOW_NONHYDROSTATIC
213     C-- Calculate the reciprocal hfac distance/volume for W cells
214     DO bj = myByLo(myThid), myByHi(myThid)
215     DO bi = myBxLo(myThid), myBxHi(myThid)
216     DO K=1,Nr
217     Km1=max(K-1,1)
218     hFacUpper=drF(Km1)/(drF(Km1)+drF(K))
219     IF (Km1.EQ.K) hFacUpper=0.
220     hFacLower=drF(K)/(drF(Km1)+drF(K))
221     DO J=1,sNy
222     DO I=1,sNx
223     IF (hFacC(I,J,K,bi,bj).NE.0.) THEN
224     IF (hFacC(I,J,K,bi,bj).LE.0.5) THEN
225     recip_hFacU(I,J,K,bi,bj)=
226     & hFacUpper+hFacLower*hFacC(I,J,K,bi,bj)
227     ELSE
228     recip_hFacU(I,J,K,bi,bj)=1.
229     ENDIF
230     ELSE
231     recip_hFacU(I,J,K,bi,bj)=0.
232     ENDIF
233     IF (recip_hFacU(I,J,K,bi,bj).NE.0.)
234     & recip_hFacU(I,J,K,bi,bj)=1./recip_hFacU(I,J,K,bi,bj)
235     ENDDO
236     ENDDO
237     ENDDO
238     ENDDO
239     ENDDO
240     _EXCH_XY_R4(recip_hFacU, myThid )
241     #endif
242 adcroft 1.1 C
243     RETURN
244     END

  ViewVC Help
Powered by ViewVC 1.1.22