/[MITgcm]/MITgcm/pkg/thsice/thsice_step_fwd.F
ViewVC logotype

Contents of /MITgcm/pkg/thsice/thsice_step_fwd.F

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


Revision 1.15 - (show annotations) (download)
Sun Mar 26 00:45:40 2006 UTC (18 years, 1 month ago) by jmc
Branch: MAIN
Changes since 1.14: +3 -3 lines
fix a debug write.

1 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_step_fwd.F,v 1.14 2006/03/14 15:58:27 jmc Exp $
2 C $Name: $
3
4 #include "THSICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: THSICE_STEP_FWD
8 C !INTERFACE:
9 SUBROUTINE THSICE_STEP_FWD(
10 I bi, bj, iMin, iMax, jMin, jMax,
11 I prcAtm,
12 U evpAtm, flxSW,
13 I myTime, myIter, myThid )
14 C !DESCRIPTION: \bv
15 C *==========================================================*
16 C | S/R THSICE_STEP_FWD
17 C | o Step Forward Therm-SeaIce model.
18 C *==========================================================*
19 C \ev
20
21 C !USES:
22 IMPLICIT NONE
23
24 C === Global variables ===
25 #include "SIZE.h"
26 #include "EEPARAMS.h"
27 #include "PARAMS.h"
28 #include "FFIELDS.h"
29 #include "THSICE_SIZE.h"
30 #include "THSICE_PARAMS.h"
31 #include "THSICE_VARS.h"
32 #include "THSICE_TAVE.h"
33
34 C !INPUT/OUTPUT PARAMETERS:
35 C === Routine arguments ===
36 C bi,bj :: tile indices
37 C iMin,iMax :: computation domain: 1rst index range
38 C jMin,jMax :: computation domain: 2nd index range
39 C- input:
40 C prcAtm :: total precip from the atmosphere [kg/m2/s]
41 C evpAtm :: (Inp) evaporation to the atmosphere [kg/m2/s] (>0 if evaporate)
42 C flxSW :: (Inp) short-wave heat flux (+=down): downward comp. only
43 C (part.1), becomes net SW flux into ocean (part.2).
44 C- output
45 C evpAtm :: (Out) net fresh-water flux (E-P) from the atmosphere [m/s] (+=up)
46 C flxSW :: (Out) net surf. heat flux from the atmosphere [W/m2], (+=down)
47 C myTime :: time counter for this thread
48 C myIter :: iteration counter for this thread
49 C myThid :: thread number for this instance of the routine.
50 INTEGER bi,bj
51 INTEGER iMin, iMax
52 INTEGER jMin, jMax
53 _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54 _RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55 _RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56 _RL myTime
57 INTEGER myIter
58 INTEGER myThid
59 CEOP
60
61 #ifdef ALLOW_THSICE
62 C !LOCAL VARIABLES:
63 C === Local variables ===
64 C snowPr :: snow precipitation [kg/m2/s]
65 C agingTime :: aging time scale (s)
66 C ageFac :: snow aging factor [1]
67 C albedo :: surface albedo [0-1]
68 C flxAtm :: net heat flux from the atmosphere (+=down) [W/m2]
69 C frwAtm :: net fresh-water flux (E-P) to the atmosphere [kg/m2/s]
70 C Fbot :: the oceanic heat flux already incorporated (ice_therm)
71 C flx2oc :: net heat flux from the ice to the ocean (+=down) [W/m2]
72 C frw2oc :: fresh-water flux from the ice to the ocean
73 C fsalt :: mass salt flux to the ocean
74 C frzmltMxL :: ocean mixed-layer freezing/melting potential [W/m2]
75 C TFrzOce :: sea-water freezing temperature [oC] (function of S)
76 C isIceFree :: true for ice-free grid-cell that remains ice-free
77 INTEGER i,j
78 _RL snowPr
79 _RL agingTime, ageFac
80 _RL albedo
81 _RL flxAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
82 _RL frwAtm
83 _RL flx2oc
84 _RL frw2oc
85 _RL fsalt
86 _RL TFrzOce, cphm, frzmltMxL
87 _RL Fbot, esurp
88 _RL opFrac, icFrac
89 _RL oceV2s, oceTs
90 _RL compact, hIce, hSnow, Tsf, Tice(nlyr), qicen(nlyr)
91 _RL tmpflx(0:2), tmpdTs
92 LOGICAL isIceFree(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93 #ifdef ALLOW_DIAGNOSTICS
94 _RL tmpFac
95 #endif
96
97 LOGICAL dBug
98
99 1010 FORMAT(A,1P4E14.6)
100 dBug = .FALSE.
101 C- Initialise flxAtm
102 DO j = 1-Oly, sNy+Oly
103 DO i = 1-Olx, sNx+Olx
104 flxAtm(i,j) = 0.
105 isIceFree(i,j) = .FALSE.
106 ENDDO
107 ENDDO
108
109 IF ( fluidIsWater ) THEN
110 DO j = jMin, jMax
111 DO i = iMin, iMax
112 c dBug = ( bi.EQ.3 .AND. i.EQ.15 .AND. j.EQ.11 )
113
114 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115 C part.1 : ice-covered fraction ;
116 C Solve for surface and ice temperature (implicitly) ; compute surf. fluxes
117 C-------
118 IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
119 icFrac = iceMask(i,j,bi,bj)
120 TFrzOce = -mu_Tf*sOceMxL(i,j,bi,bj)
121 hIce = iceHeight(i,j,bi,bj)
122 hSnow = snowHeight(i,j,bi,bj)
123 Tsf = Tsrf(i,j,bi,bj)
124 qicen(1)= Qice1(i,j,bi,bj)
125 qicen(2)= Qice2(i,j,bi,bj)
126 IF ( dBug ) THEN
127 WRITE(6,'(A,2I4,2I2)') 'ThSI_FWD: i,j=',i,j,bi,bj
128 WRITE(6,1010) 'ThSI_FWD:-0- iceMask, hIc, hSn, Tsf =',
129 & icFrac, hIce,hSnow,Tsf
130 ENDIF
131
132 CALL THSICE_ALBEDO(
133 I hIce, hSnow, Tsf, snowAge(i,j,bi,bj),
134 O albedo,
135 I myThid )
136 flxSW(i,j) = flxSW(i,j)*(1. _d 0 - albedo)
137 siceAlb(i,j,bi,bj) = albedo
138
139 CALL THSICE_SOLVE4TEMP(
140 I useBulkForce, tmpflx, TFrzOce, hIce, hSnow,
141 U flxSW(i,j), Tsf, qicen,
142 O Tice, sHeating(i,j,bi,bj), flxCndBt(i,j,bi,bj),
143 O tmpdTs, flxAtm(i,j), evpAtm(i,j),
144 I i,j, bi,bj, myThid)
145
146 #ifdef SHORTWAVE_HEATING
147 C-- Update Fluxes :
148 opFrac= 1. _d 0-icFrac
149 Qsw(i,j,bi,bj)=-icFrac*flxSW(i,j) +opFrac*Qsw(i,j,bi,bj)
150 #endif
151 C-- Update Sea-Ice state :
152 Tsrf(i,j,bi,bj) =Tsf
153 Tice1(i,j,bi,bj)=Tice(1)
154 Tice2(i,j,bi,bj)=Tice(2)
155 Qice1(i,j,bi,bj)=qicen(1)
156 Qice2(i,j,bi,bj)=qicen(2)
157 IF ( dBug ) THEN
158 WRITE(6,1010) 'ThSI_FWD: Tsf, Tice(1,2), TFrzOce =',
159 & Tsf, Tice, TFrzOce
160 WRITE(6,1010) 'ThSI_FWD: sHeat,fxCndBt, fxAtm,evAtm=',
161 & sHeating(i,j,bi,bj), flxCndBt(i,j,bi,bj),
162 & flxAtm(i,j), evpAtm(i,j)
163 ENDIF
164 ENDIF
165 ENDDO
166 ENDDO
167 ENDIF
168 dBug = .FALSE.
169
170 #ifdef ALLOW_DIAGNOSTICS
171 IF ( useDiagnostics ) THEN
172 tmpFac = 1. _d 0
173 CALL DIAGNOSTICS_FRACT_FILL(
174 I snowPrc, iceMask,tmpFac,1,'SIsnwPrc',
175 I 0,1,1,bi,bj,myThid)
176 CALL DIAGNOSTICS_FRACT_FILL(
177 I siceAlb, iceMask,tmpFac,1,'SIalbedo',
178 I 0,1,1,bi,bj,myThid)
179 ENDIF
180 #endif /* ALLOW_DIAGNOSTICS */
181 DO j = jMin, jMax
182 DO i = iMin, iMax
183 siceAlb(i,j,bi,bj) = iceMask(i,j,bi,bj)*siceAlb(i,j,bi,bj)
184 ENDDO
185 ENDDO
186
187 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
188 C part.2 : ice-covered fraction ;
189 C change in ice/snow thickness and ice-fraction
190 C note: can only reduce the ice-fraction but not increase it.
191 C-------
192 agingTime = 50. _d 0 * 86400. _d 0
193 ageFac = 1. _d 0 - thSIce_deltaT/agingTime
194 DO j = jMin, jMax
195 DO i = iMin, iMax
196 c dBug = ( bi.EQ.3 .AND. i.EQ.15 .AND. j.EQ.11 )
197
198 TFrzOce = -mu_Tf*sOceMxL(i,j,bi,bj)
199 oceTs = tOceMxL(i,j,bi,bj)
200 cphm = cpwater*rhosw*hOceMxL(i,j,bi,bj)
201 frzmltMxL = (TFrzOce-oceTs)*cphm/ocean_deltaT
202
203 Fbot = 0. _d 0
204 saltFlux(i,j,bi,bj) = 0. _d 0
205 compact= iceMask(i,j,bi,bj)
206 C-------
207 IF (dBug .AND. (frzmltMxL.GT.0. .OR. compact.GT.0.) ) THEN
208 WRITE(6,'(A,2I4,2I2)') 'ThSI_FWD: i,j=',i,j,bi,bj
209 WRITE(6,1010) 'ThSI_FWD:-1- iceMask, hIc, hSn, Tsf =',
210 & compact, iceHeight(i,j,bi,bj),
211 & snowHeight(i,j,bi,bj), Tsrf(i,j,bi,bj)
212 WRITE(6,1010) 'ThSI_FWD: ocTs,TFrzOce,frzmltMxL,Qnet=',
213 & oceTs, TFrzOce, frzmltMxL,Qnet(i,j,bi,bj)
214 ENDIF
215 C-------
216 IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
217
218 oceV2s = v2ocMxL(i,j,bi,bj)
219 snowPr = snowPrc(i,j,bi,bj)
220 hIce = iceHeight(i,j,bi,bj)
221 hSnow = snowHeight(i,j,bi,bj)
222 Tsf = Tsrf(i,j,bi,bj)
223 qicen(1)= Qice1(i,j,bi,bj)
224 qicen(2)= Qice2(i,j,bi,bj)
225 flx2oc = flxSW(i,j)
226
227 CALL THSICE_CALC_THICKN(
228 I frzmltMxL, TFrzOce, oceTs, oceV2s, snowPr,
229 I sHeating(i,j,bi,bj), flxCndBt(i,j,bi,bj), evpAtm(i,j),
230 U compact, hIce, hSnow, Tsf, qicen, flx2oc,
231 O frw2oc, fsalt, Fbot,
232 I dBug, myThid)
233
234 C- note : snowPr was not supposed to be modified in THSICE_THERM ;
235 C but to reproduce old results, is reset to zero if Tsf >= 0
236 snowPrc(i,j,bi,bj) = snowPr
237
238 C-- Snow aging :
239 snowAge(i,j,bi,bj) = thSIce_deltaT
240 & + snowAge(i,j,bi,bj)*ageFac
241 IF ( snowPr.GT.0. _d 0 )
242 & snowAge(i,j,bi,bj) = snowAge(i,j,bi,bj)
243 & * EXP( -(thSIce_deltaT*snowPr/rhos)/hNewSnowAge )
244 C--
245
246 C-- Diagnostic of Atmospheric Fluxes over sea-ice :
247 frwAtm = evpAtm(i,j) - prcAtm(i,j)
248 C note: Any flux of mass (here fresh water) that enter or leave the system
249 C with a non zero energy HAS TO be counted: add snow precip.
250 flxAtm(i,j) = flxAtm(i,j) - Lfresh*snowPrc(i,j,bi,bj)
251
252 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
253 IF (dBug) WRITE(6,1010) 'ThSI_FWD: icFrac,flxAtm,evpAtm,flxSnw=',
254 & iceMask(i,j,bi,bj),flxAtm(i,j),evpAtm(i,j),-Lfresh*snowPr
255 IF (dBug) WRITE(6,1010) 'ThSI_FWD: compact,flx2oc,fsalt,frw2oc=',
256 & compact,flx2oc,fsalt,frw2oc
257 #ifdef CHECK_ENERGY_CONSERV
258 icFrac = iceMask(i,j,bi,bj)
259 CALL THSICE_CHECK_CONSERV( dBug, i, j, bi, bj, 0,
260 I icFrac, compact, hIce, hSnow, qicen,
261 I flx2oc, frw2oc, fsalt, flxAtm(i,j), frwAtm,
262 I myTime, myIter, myThid )
263 #endif /* CHECK_ENERGY_CONSERV */
264 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
265
266 C-- Update Sea-Ice state :
267 c iceMask(i,j,bi,bj)=compact
268 iceHeight(i,j,bi,bj) = hIce
269 snowHeight(i,j,bi,bj)= hSnow
270 Tsrf(i,j,bi,bj) =Tsf
271 Qice1(i,j,bi,bj)=qicen(1)
272 Qice2(i,j,bi,bj)=qicen(2)
273
274 C-- Net fluxes :
275 frw2oc = frw2oc + (prcAtm(i,j)-snowPrc(i,j,bi,bj))
276 C- weighted average net fluxes:
277 icFrac = iceMask(i,j,bi,bj)
278 opFrac= 1. _d 0-icFrac
279 flxAtm(i,j) = icFrac*flxAtm(i,j) - opFrac*Qnet(i,j,bi,bj)
280 frwAtm = icFrac*frwAtm + opFrac*rhofw*EmPmR(i,j,bi,bj)
281 Qnet(i,j,bi,bj)=-icFrac*flx2oc +opFrac*Qnet(i,j,bi,bj)
282 EmPmR(i,j,bi,bj)=-icFrac*frw2oc/rhofw+opFrac*EmPmR(i,j,bi,bj)
283 saltFlux(i,j,bi,bj)=-icFrac*fsalt
284
285 IF (dBug) WRITE(6,1010)
286 & 'ThSI_FWD:-3- compact, hIc, hSn, Qnet =',
287 & compact,hIce,hSnow,Qnet(i,j,bi,bj)
288
289 ELSEIF (hOceMxL(i,j,bi,bj).gt.0. _d 0) THEN
290 flxAtm(i,j) = -Qnet(i,j,bi,bj)
291 frwAtm = rhofw*EmPmR(i,j,bi,bj)
292 ELSE
293 flxAtm(i,j) = 0. _d 0
294 frwAtm = 0. _d 0
295 ENDIF
296
297 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
298 C part.3 : freezing of sea-water
299 C over ice-free fraction and what is left from ice-covered fraction
300 C-------
301 c compact= iceMask(i,j,bi,bj)
302 hIce = iceHeight(i,j,bi,bj)
303 hSnow = snowHeight(i,j,bi,bj)
304
305 esurp = frzmltMxL - Fbot*iceMask(i,j,bi,bj)
306 IF (esurp.GT.0. _d 0) THEN
307 icFrac = compact
308 qicen(1)= Qice1(i,j,bi,bj)
309 qicen(2)= Qice2(i,j,bi,bj)
310 CALL THSICE_EXTEND(
311 I esurp, TFrzOce,
312 U oceTs, compact, hIce, hSnow, qicen,
313 O flx2oc, frw2oc, fsalt,
314 I dBug, myThid )
315 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
316 IF (dBug) WRITE(6,1010) 'ThSI_FWD: compact,flx2oc,fsalt,frw2oc='
317 & ,compact,flx2oc,fsalt,frw2oc
318 #ifdef CHECK_ENERGY_CONSERV
319 tmpflx(1) = 0.
320 tmpflx(2) = 0.
321 CALL THSICE_CHECK_CONSERV( dBug, i, j, bi, bj, 1,
322 I icFrac, compact, hIce, hSnow, qicen,
323 I flx2oc, frw2oc, fsalt, tmpflx(1), tmpflx(2),
324 I myTime, myIter, myThid )
325 #endif /* CHECK_ENERGY_CONSERV */
326 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
327 C-- Update Sea-Ice state :
328 IF ( compact.GT.0. _d 0 .AND. icFrac.EQ.0. _d 0) THEN
329 Tsrf(i,j,bi,bj) = TFrzOce
330 Tice1(i,j,bi,bj) = TFrzOce
331 Tice2(i,j,bi,bj) = TFrzOce
332 Qice1(i,j,bi,bj) = qicen(1)
333 Qice2(i,j,bi,bj) = qicen(2)
334 ENDIF
335 iceHeight(i,j,bi,bj) = hIce
336 snowHeight(i,j,bi,bj)= hSnow
337 C-- Net fluxes :
338 Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) - flx2oc
339 EmPmR(i,j,bi,bj)= EmPmR(i,j,bi,bj)- frw2oc/rhofw
340 saltFlux(i,j,bi,bj)=saltFlux(i,j,bi,bj) - fsalt
341
342 IF (dBug) WRITE(6,1010)
343 & 'ThSI_FWD:-4- compact, hIc, hSn, Qnet =',
344 & compact,hIce,hSnow,Qnet(i,j,bi,bj)
345 C-- - if esurp > 0 : end
346 ENDIF
347
348 IF ( hOceMxL(i,j,bi,bj).GT.0. _d 0 )
349 & isIceFree(i,j) = iceMask(i,j,bi,bj).LE.0. _d 0
350 & .AND. compact .LE.0. _d 0
351 IF ( compact .GT. 0. _d 0 ) THEN
352 iceMask(i,j,bi,bj)=compact
353 IF ( hSnow .EQ. 0. _d 0 ) snowAge(i,j,bi,bj) = 0. _d 0
354 ELSE
355 iceMask(i,j,bi,bj) = 0. _d 0
356 iceHeight(i,j,bi,bj)= 0. _d 0
357 snowHeight(i,j,bi,bj)=0. _d 0
358 snowAge(i,j,bi,bj) = 0. _d 0
359 Tsrf(i,j,bi,bj) = oceTs
360 Tice1(i,j,bi,bj) = 0. _d 0
361 Tice2(i,j,bi,bj) = 0. _d 0
362 Qice1(i,j,bi,bj) = 0. _d 0
363 Qice2(i,j,bi,bj) = 0. _d 0
364 ENDIF
365
366 C-- Return atmospheric fluxes in evpAtm & flxSW (same sign and units):
367 evpAtm(i,j) = frwAtm
368 flxSW (i,j) = flxAtm(i,j)
369
370 #ifdef ATMOSPHERIC_LOADING
371 C-- Compute Sea-Ice Loading (= mass of sea-ice + snow / area unit)
372 sIceLoad(i,j,bi,bj) = ( snowHeight(i,j,bi,bj)*rhos
373 & + iceHeight(i,j,bi,bj)*rhoi
374 & )*iceMask(i,j,bi,bj)
375 #endif
376
377 ENDDO
378 ENDDO
379
380 #ifdef ALLOW_BULK_FORCE
381 IF ( useBulkForce ) THEN
382 CALL BULKF_FLUX_ADJUST(
383 I bi, bj, iMin, iMax, jMin, jMax,
384 I isIceFree, myTime, myIter, myThid )
385 ENDIF
386 #endif /* ALLOW_BULK_FORCE */
387
388 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
389 #endif /* ALLOW_THSICE */
390
391 RETURN
392 END

  ViewVC Help
Powered by ViewVC 1.1.22