/[MITgcm]/MITgcm_contrib/dgoldberg/shelfice_remeshing_old/code/shelfice_init_fixed.F
ViewVC logotype

Contents of /MITgcm_contrib/dgoldberg/shelfice_remeshing_old/code/shelfice_init_fixed.F

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


Revision 1.1 - (show annotations) (download)
Thu Jul 19 11:14:58 2018 UTC (7 years ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
record of verification_other experiment before modification for github

1 C $Header: /u/gcmpack/MITgcm_contrib/verification_other/shelfice_remeshing/code/shelfice_init_fixed.F,v 1.6 2017/04/10 23:55:33 jmc Exp $
2 C $Name: $
3
4 #include "SHELFICE_OPTIONS.h"
5 #ifdef ALLOW_COST
6 # include "COST_OPTIONS.h"
7 #endif
8 #ifdef ALLOW_CTRL
9 # include "CTRL_OPTIONS.h"
10 #endif
11
12 SUBROUTINE SHELFICE_INIT_FIXED( myThid )
13 C *============================================================*
14 C | SUBROUTINE SHELFICE_INIT_FIXED
15 C | o Routine to initialize SHELFICE parameters and variables.
16 C *============================================================*
17 C | Initialize SHELFICE parameters and variables.
18 C *============================================================*
19 IMPLICIT NONE
20
21 C === Global variables ===
22 #include "SIZE.h"
23 #include "EEPARAMS.h"
24 #include "PARAMS.h"
25 #include "GRID.h"
26 #include "SHELFICE.h"
27 #ifdef ALLOW_COST
28 # include "cost.h"
29 # include "SHELFICE_COST.h"
30 #endif /* ALLOW_COST */
31
32 C === Routine arguments ===
33 C myThid :: Number of this instance of SHELFICE_INIT_FIXED
34 INTEGER myThid
35
36 #ifdef ALLOW_SHELFICE
37 C === Local variables ===
38 C i, j, bi, bj :: Loop counters
39 INTEGER i, j, bi, bj
40 #ifdef ALLOW_DIAGNOSTICS
41 INTEGER diagNum
42 INTEGER diagMate
43 CHARACTER*8 diagName
44 CHARACTER*16 diagCode
45 CHARACTER*16 diagUnits
46 CHARACTER*(80) diagTitle
47 #endif /* ALLOW_DIAGNOSTICS */
48 #ifdef ALLOW_SHIFWFLX_CONTROL
49 INTEGER k
50 # ifdef ALLOW_SHIFWFLX_COST_CONTRIBUTION
51 _RL dummy
52 # endif
53 #endif
54
55 #ifdef ALLOW_MNC
56 C Initialize MNC variable information for SHELFICE
57 IF ( useMNC .AND. (shelfice_tave_mnc.OR.shelfice_dump_mnc)
58 & ) THEN
59 CALL SHELFICE_MNC_INIT( myThid )
60 ENDIF
61 #endif /* ALLOW_MNC */
62
63 C-----------------------------------------------------------------------
64 C-- Initialize SHELFICE variables kTopC
65 C-- kTopC is the same as kSurfC, except outside ice-shelf area:
66 C-- kTop = 0 where there is no ice-shelf (where kSurfC=1)
67 C-- and over land (completely dry column) where kSurfC = Nr+1
68 C-----------------------------------------------------------------------
69
70 DO bj = myByLo(myThid), myByHi(myThid)
71 DO bi = myBxLo(myThid), myBxHi(myThid)
72 DO j = 1-OLy, sNy+OLy
73 DO i = 1-OLx, sNx+OLx
74 IF ( kSurfC(i,j,bi,bj).LE.Nr .AND.
75 & R_shelfIce(i,j,bi,bj).LT.zeroRS ) THEN
76 kTopC(i,j,bi,bj) = kSurfC(i,j,bi,bj)
77 ELSE
78 kTopC(i,j,bi,bj) = 0
79 ENDIF
80 shelficeMassInit (i,j,bi,bj) = 0. _d 0
81 shelficeLoadAnomaly(i,j,bi,bj) = 0. _d 0
82 shelfIceMassDynTendency(i,j,bi,bj) = 0. _d 0
83 ENDDO
84 ENDDO
85 ENDDO
86 ENDDO
87
88 #ifdef ALLOW_SHIFWFLX_CONTROL
89 C maskSHI is a hack to play along with the general ctrl-package
90 C infrastructure, where only the k=1 layer of a 3D mask is used
91 C for 2D fields. We cannot use maskInC instead, because routines
92 C like ctrl_get_gen and ctrl_set_unpack_xy require 3D masks.
93 DO bj = myByLo(myThid), myByHi(myThid)
94 DO bi = myBxLo(myThid), myBxHi(myThid)
95 DO k=1,Nr
96 DO j=1-OLy,sNy+OLy
97 DO i=1-OLx,sNx+OLx
98 maskSHI(i,j,k,bi,bj) = 0. _d 0
99 ENDDO
100 ENDDO
101 ENDDO
102 DO k=1,Nr
103 DO j=1-OLy,sNy+OLy
104 DO i=1-OLx,sNx+OLx
105 IF ( R_shelfIce(i,j,bi,bj).LT.zeroRS
106 & .AND. hFacC(i,j,k,bi,bj).NE.zeroRS ) THEN
107 maskSHI(i,j,k,bi,bj) = 1. _d 0
108 maskSHI(i,j,1,bi,bj) = 1. _d 0
109 ENDIF
110 ENDDO
111 ENDDO
112 ENDDO
113 ENDDO
114 ENDDO
115 #endif /* ALLOW_SHIFWFLX_CONTROL */
116
117 #ifdef ALLOW_COST
118 #if (defined (ALLOW_SHIFWFLX_COST_CONTRIBUTION) && \
119 defined (ALLOW_SHIFWFLX_CONTROL))
120 IF ( shifwflx_errfile .NE. ' ' ) THEN
121 CALL READ_REC_XY_RL( shifwflx_errfile, wshifwflx, 1, 0, myThid )
122 ENDIF
123
124 DO bj = myByLo(myThid), myByHi(myThid)
125 DO bi = myBxLo(myThid), myBxHi(myThid)
126 DO j = 1-OLy, sNy+OLy
127 DO i = 1-OLx, sNx+OLx
128 c-- Test for missing values.
129 IF (wshifwflx(i,j,bi,bj) .LT. -9900.) THEN
130 wshifwflx(i,j,bi,bj) = 0. _d 0
131 ENDIF
132 c-- use weight as mask
133 wshifwflx(i,j,bi,bj) =
134 & max(wshifwflx(i,j,bi,bj),wshifwflx0)
135 & *maskSHI(i,j,1,bi,bj)
136 IF (wshifwflx(i,j,bi,bj) .NE. 0.) THEN
137 wshifwflx(i,j,bi,bj) =
138 & 1./wshifwflx(i,j,bi,bj)/wshifwflx(i,j,bi,bj)
139 ENDIF
140 ENDDO
141 ENDDO
142 ENDDO
143 ENDDO
144 CALL ACTIVE_WRITE_XY_LOC( 'wshifwflx', wshifwflx,
145 & 1, 0, myThid, dummy )
146 #endif /* ALLOW_SHIFWFLX_COST_CONTRIBUTION and ALLOW_SHIFWFLX_CONTROL */
147 #endif /* ALLOW_COST */
148
149 IF ( SHELFICEloadAnomalyFile .NE. ' ' ) THEN
150 CALL READ_FLD_XY_RL( SHELFICEloadAnomalyFile, ' ',
151 & shelficeLoadAnomaly, 0, myThid )
152 ENDIF
153 IF ( SHELFICEmassFile.NE.' ' ) THEN
154 CALL READ_FLD_XY_RL( SHELFICEmassFile, ' ',
155 & shelficeMassInit, 0, myThid )
156 ELSE
157 DO bj = myByLo(myThid), myByHi(myThid)
158 DO bi = myBxLo(myThid), myBxHi(myThid)
159 DO j = 1, sNy
160 DO i = 1, sNx
161 shelficeMassInit(i,j,bi,bj) =
162 & shelficeLoadAnomaly(i,j,bi,bj)*recip_gravity
163 & - rhoConst*Ro_surf(i,j,bi,bj)
164 ENDDO
165 ENDDO
166 ENDDO
167 ENDDO
168 ENDIF
169 _EXCH_XY_RL( shelficeMassInit, myThid )
170 CALL WRITE_FLD_XY_RL ( 'shelficemassinit', ' ',
171 & shelficeMassInit, 0, myThid )
172
173 c IF ( SHELFICEloadAnomalyFile .EQ. ' ' ) THEN
174 C- In case we need shelficeLoadAnomaly in phi0surf for initial pressure
175 C calculation (if using selectP_inEOS_Zc=2 or 3)
176 DO bj = myByLo(myThid), myByHi(myThid)
177 DO bi = myBxLo(myThid), myBxHi(myThid)
178 DO j = 1-OLy, sNy+OLy
179 DO i = 1-OLx, sNx+OLx
180 shelficeLoadAnomaly(i,j,bi,bj) = gravity
181 & *(shelficeMassInit(i,j,bi,bj)+rhoConst*Ro_surf(i,j,bi,bj))
182 ENDDO
183 ENDDO
184 ENDDO
185 ENDDO
186 c ELSE
187 c _EXCH_XY_RS( shelficeLoadAnomaly, myThid )
188 c ENDIF
189 IF ( debugLevel.GE.debLevC ) THEN
190 CALL WRITE_FLD_XY_RL( 'SHICE_pLoadAnom', ' ',
191 I shelficeLoadAnomaly, -1, myThid )
192 ENDIF
193
194 IF ( SHELFICEMassStepping .AND.
195 & SHELFICEMassDynTendFile .NE. ' ' ) THEN
196 CALL READ_FLD_XY_RS( SHELFICEMassDynTendFile, ' ',
197 & shelfIceMassDynTendency, 0, myThid )
198 ENDIF
199
200 #ifdef ALLOW_DIAGNOSTICS
201 IF ( useDiagnostics ) THEN
202 diagName = 'SHIfwFlx'
203 diagTitle = 'Ice shelf fresh water flux (positive upward)'
204 diagUnits = 'kg/m^2/s '
205 diagCode = 'SM L1 '
206 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
207 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
208
209 diagName = 'SHIhtFlx'
210 diagTitle = 'Ice shelf heat flux (positive upward)'
211 diagUnits = 'W/m^2 '
212 diagCode = 'SM L1 '
213 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
214 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
215
216 diagName = 'SHIUDrag'
217 diagTitle = 'U momentum tendency from ice shelf drag'
218 diagUnits = 'm/s^2 '
219 diagCode = 'UU MR '
220 diagMate = diagNum + 2
221 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
222 I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid )
223
224 diagName = 'SHIVDrag'
225 diagTitle = 'V momentum tendency from ice shelf drag'
226 diagUnits = 'm/s^2 '
227 diagCode = 'VV MR '
228 diagMate = diagNum
229 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
230 I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid )
231
232 diagName = 'SHIForcT'
233 diagTitle = 'Ice shelf forcing for theta, >0 increases theta'
234 diagUnits = 'W/m^2 '
235 diagCode = 'SM L1 '
236 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
237 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
238
239 diagName = 'SHIForcS'
240 diagTitle = 'Ice shelf forcing for salt, >0 increases salt'
241 diagUnits = 'g/m^2/s '
242 diagCode = 'SM L1 '
243 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
244 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
245
246 diagName = 'SHIgammT'
247 diagTitle = 'Ice shelf exchange coefficient for theta'
248 diagUnits = 'm/s '
249 diagCode = 'SM L1 '
250 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
251 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
252
253 diagName = 'SHIgammS'
254 diagTitle = 'Ice shelf exchange coefficient for salt'
255 diagUnits = 'm/s '
256 diagCode = 'SM L1 '
257 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
258 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
259
260 diagName = 'SHIuStar'
261 diagTitle = 'Friction velocity at bottom of ice shelf'
262 diagUnits = 'm/s '
263 diagCode = 'SM L1 '
264 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
265 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
266
267 diagName = 'SHI_mass'
268 diagTitle = 'dynamic ice shelf mass for surface load anomaly'
269 diagUnits = 'kg/m^2 '
270 diagCode = 'SM L1 '
271 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
272 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
273
274 diagName = 'SHIRshel'
275 diagTitle = 'depth of shelfice'
276 diagUnits = 'm '
277 diagCode = 'SM L1 '
278 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
279 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
280
281 diagName = 'SHI_MEff'
282 diagTitle = 'dynamic ice shelf mass for surface load anomaly'
283 diagUnits = 'kg/m^2 '
284 diagCode = 'SM L1 '
285 CALL DIAGNOSTICS_ADDTOLIST( diagNum,
286 I diagName, diagCode, diagUnits, diagTitle, 0, myThid )
287 ENDIF
288 #endif /* ALLOW_DIAGNOSTICS */
289 #endif /* ALLOW_SHELFICE */
290
291 RETURN
292 END

  ViewVC Help
Powered by ViewVC 1.1.22