File indexing completed on 2023-09-21 05:10:50 UTC
view on githubraw file Latest commit 96b00645 on 2023-09-20 15:15:14 UTC
5ca83cd8f7 Dani*0001 #include "STREAMICE_OPTIONS.h"
0002
0003
0004
0005
96b006450c dngo*0006 SUBROUTINE STREAMICE_DRIVING_STRESS( myThid )
0007
0008
5ca83cd8f7 Dani*0009
0010
96b006450c dngo*0011
5ca83cd8f7 Dani*0012
0013
0014
0015
0016 IMPLICIT NONE
0017
0018
0019 #include "SIZE.h"
0020 #include "EEPARAMS.h"
0021 #include "PARAMS.h"
0022 #include "GRID.h"
0023 #include "STREAMICE.h"
0024 #include "STREAMICE_CG.h"
0025
0026
0027 INTEGER myThid
96b006450c dngo*0028
0029
5ca83cd8f7 Dani*0030
0031 #ifdef ALLOW_STREAMICE
0032
96b006450c dngo*0033 INTEGER i, j, bi, bj, Gi, Gj
0034 LOGICAL at_west_bdry, at_east_bdry,
5ca83cd8f7 Dani*0035 & at_north_bdry, at_south_bdry
050473d034 Dani*0036 _RL grd_below_sl
96b006450c dngo*0037 _RL sx, sy, diffx, diffy
0038
e4cfce0a6c Dani*0039 _RL i_rhow
0040 _RL avg_density
0041 & (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0042 #ifdef STREAMICE_FIRN_CORRECTION
0043 _RL firn_depth, h
0044 #endif
96b006450c dngo*0045
5ca83cd8f7 Dani*0046 IF (myXGlobalLo.eq.1) at_west_bdry = .true.
0047 IF (myYGlobalLo.eq.1) at_south_bdry = .true.
96b006450c dngo*0048 IF (myXGlobalLo-1+sNx*nSx.eq.Nx)
5ca83cd8f7 Dani*0049 & at_east_bdry = .false.
96b006450c dngo*0050 IF (myYGlobalLo-1+sNy*nSy.eq.Ny)
5ca83cd8f7 Dani*0051 & at_north_bdry = .false.
e4cfce0a6c Dani*0052 #ifdef STREAMICE_FIRN_CORRECTION
96b006450c dngo*0053 firn_depth = streamice_density *
e4cfce0a6c Dani*0054 & streamice_firn_correction
0055 & / (streamice_density-streamice_density_firn)
0056 #endif
0057 i_rhow = 1./streamice_density_ocean_avg
5ca83cd8f7 Dani*0058
0059 DO bj = myByLo(myThid), myByHi(myThid)
0060 DO bi = myBxLo(myThid), myBxHi(myThid)
bdd8102d3e Dani*0061 DO j=1-OLy+1,sNy+OLy-1
0062 DO i=1-OLx+1,sNx+OLx-1
5ca83cd8f7 Dani*0063 taudx_SI(i,j,bi,bj) = 0. _d 0
0064 taudy_SI(i,j,bi,bj) = 0. _d 0
e4cfce0a6c Dani*0065 #ifdef STREAMICE_FIRN_CORRECTION
0066 if (STREAMICE_apply_firn_correction) then
0067 if (streamice_hmask(i,j,bi,bj).eq.1) then
0068 h = h_streamice(i,j,bi,bj)
0069 if (h.lt.firn_depth) then
0070 avg_density(i,j,bi,bj) = streamice_density_firn
0071 else
96b006450c dngo*0072 avg_density(i,j,bi,bj) = streamice_density *
e4cfce0a6c Dani*0073 & (h - streamice_firn_correction) / h
0074 endif
0075 endif
0076 else
0077 #endif
0078 avg_density(i,j,bi,bj) = streamice_density
0079 #ifdef STREAMICE_FIRN_CORRECTION
0080 endif
0081 #endif
5ca83cd8f7 Dani*0082 ENDDO
0083 ENDDO
0084 ENDDO
0085 ENDDO
0086
0087 DO bj = myByLo(myThid), myByHi(myThid)
0088 DO bi = myBxLo(myThid), myBxHi(myThid)
96b006450c dngo*0089
6a651fd056 Dani*0090 DO i=1,sNx
0091 DO j=1,sNy
5ca83cd8f7 Dani*0092
0093 diffx = 0. _d 0
0094 diffy = 0. _d 0
0095 sx = 0. _d 0
0096 sy = 0. _d 0
0097
0098 Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
0099 Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
0100
6a651fd056 Dani*0101 IF (streamice_umask(i,j,bi,bj).eq.1.0) THEN
5ca83cd8f7 Dani*0102
6a651fd056 Dani*0103 IF (streamice_hmask(i-1,j,bi,bj).eq.1.0.AND.
0104 & streamice_hmask(i,j,bi,bj).eq.1.0) THEN
5ca83cd8f7 Dani*0105
96b006450c dngo*0106
0107
e4cfce0a6c Dani*0108
96b006450c dngo*0109 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
26481ac222 Dani*0110 & 0.25 * dyG(i,j,bi,bj) *
e4cfce0a6c Dani*0111 & gravity *
0112 & (H_streamice(i,j,bi,bj)*avg_density(i,j,bi,bj)+
0113 & H_streamice(i-1,j,bi,bj)*avg_density(i-1,j,bi,bj)) *
6a651fd056 Dani*0114 & (surf_el_streamice(i,j,bi,bj)-
26481ac222 Dani*0115 & surf_el_streamice(i-1,j,bi,bj))
5ca83cd8f7 Dani*0116
e4cfce0a6c Dani*0117
4a973b81ed Dani*0118 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
96b006450c dngo*0119 & streamice_density * gravity *
4a973b81ed Dani*0120 & streamice_bg_surf_slope_x * .25 * rA(i,j,bi,bj) *
0121 & (H_streamice(i-1,j,bi,bj) + H_streamice(i,j,bi,bj))
e4cfce0a6c Dani*0122
4a973b81ed Dani*0123
6a651fd056 Dani*0124 ELSE IF (streamice_hmask(i-1,j,bi,bj).eq.1.0) THEN
5ca83cd8f7 Dani*0125
6a651fd056 Dani*0126 IF (float_frac_streamice(i-1,j,bi,bj) .eq. 1.0) THEN
5ca83cd8f7 Dani*0127
050473d034 Dani*0128 #ifdef USE_ALT_RLOW
0129 IF (R_low_si(i-1,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0130 #else
050473d034 Dani*0131 IF (R_low(i-1,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0132 #endif
050473d034 Dani*0133 grd_below_sl = 1. _d 0
0134 else
0135 grd_below_sl = 0. _d 0
0136 endif
96b006450c dngo*0137
6a651fd056 Dani*0138 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
26481ac222 Dani*0139 & 0.25 * dyG(i,j,bi,bj) *
96b006450c dngo*0140 & gravity *
e4cfce0a6c Dani*0141 & (avg_density(i-1,j,bi,bj) * H_streamice(i-1,j,bi,bj)**2-
6a651fd056 Dani*0142 #ifdef USE_ALT_RLOW
96b006450c dngo*0143 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0144 & R_low_si(i-1,j,bi,bj)**2)
96b006450c dngo*0145 #else
0146 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0147 & R_low(i-1,j,bi,bj)**2)
6a651fd056 Dani*0148 #endif
5ca83cd8f7 Dani*0149
0150 ELSE
0151
e4cfce0a6c Dani*0152 #ifdef STREAMICE_FIRN_CORRECTION
96b006450c dngo*0153
e4cfce0a6c Dani*0154 if (STREAMICE_apply_firn_correction) then
0155 if (H_streamice(i-1,j,bi,bj).lt.firn_depth) then
0156 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
0157 & 0.25 * dyG(i,j,bi,bj) *
0158 & streamice_density_firn * gravity *
0159 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0160 & H_streamice(i-1,j,bi,bj)**2
e4cfce0a6c Dani*0161 else
0162 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
0163 & 0.25 * dyG(i,j,bi,bj) * gravity * (
96b006450c dngo*0164 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0165 & (h_streamice(i-1,j,bi,bj)-firn_depth) *
0166 & (streamice_density_firn*firn_depth+streamice_density*
0167 & (h_streamice(i-1,j,bi,bj)-streamice_firn_correction)) -
0168 & streamice_density**2*i_rhow*
0169 & (h_streamice(i-1,j,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0170 & )
e4cfce0a6c Dani*0171 endif
0172 else
0173
0174 #endif
6a651fd056 Dani*0175 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
26481ac222 Dani*0176 & 0.25 * dyG(i,j,bi,bj) *
6a651fd056 Dani*0177 & streamice_density * gravity *
e4cfce0a6c Dani*0178 & (1-streamice_density*i_rhow) *
96b006450c dngo*0179 & H_streamice(i-1,j,bi,bj)**2
5ca83cd8f7 Dani*0180
e4cfce0a6c Dani*0181 #ifdef STREAMICE_FIRN_CORRECTION
0182 endif
0183 #endif
0184
5ca83cd8f7 Dani*0185 ENDIF
0186
6a651fd056 Dani*0187 ELSE IF (streamice_hmask(i,j,bi,bj).eq.1.0) THEN
5ca83cd8f7 Dani*0188
6a651fd056 Dani*0189 IF (float_frac_streamice(i,j,bi,bj) .eq. 1.0) THEN
5ca83cd8f7 Dani*0190
050473d034 Dani*0191 #ifdef USE_ALT_RLOW
0192 IF (R_low_si(i,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0193 #else
050473d034 Dani*0194 IF (R_low(i,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0195 #endif
0196 grd_below_sl = 1. _d 0
050473d034 Dani*0197 else
0198 grd_below_sl = 0. _d 0
0199 endif
0200
6a651fd056 Dani*0201 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
26481ac222 Dani*0202 & 0.25 * dyG(i,j,bi,bj) *
6a651fd056 Dani*0203 & gravity *
e4cfce0a6c Dani*0204 & (avg_density(i,j,bi,bj) * H_streamice(i,j,bi,bj)**2 -
6a651fd056 Dani*0205 #ifdef USE_ALT_RLOW
96b006450c dngo*0206 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0207 & R_low_si(i,j,bi,bj)**2)
96b006450c dngo*0208 #else
0209 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0210 & R_low(i,j,bi,bj)**2)
6a651fd056 Dani*0211 #endif
5ca83cd8f7 Dani*0212
6a651fd056 Dani*0213 ELSE
0214
e4cfce0a6c Dani*0215 #ifdef STREAMICE_FIRN_CORRECTION
0216
0217 if (STREAMICE_apply_firn_correction) then
0218 if (H_streamice(i,j,bi,bj).lt.firn_depth) then
e0987c9b93 Dani*0219 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
e4cfce0a6c Dani*0220 & 0.25 * dyG(i,j,bi,bj) *
0221 & streamice_density_firn * gravity *
0222 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0223 & H_streamice(i,j,bi,bj)**2
e4cfce0a6c Dani*0224 else
e0987c9b93 Dani*0225 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
e4cfce0a6c Dani*0226 & 0.25 * dyG(i,j,bi,bj) * gravity * (
96b006450c dngo*0227 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0228 & (h_streamice(i,j,bi,bj)-firn_depth) *
0229 & (streamice_density_firn*firn_depth+streamice_density*
0230 & (h_streamice(i,j,bi,bj)-streamice_firn_correction)) -
0231 & streamice_density**2*i_rhow*
0232 & (h_streamice(i,j,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0233 & )
e4cfce0a6c Dani*0234 endif
0235 else
0236
0237 #endif
e0987c9b93 Dani*0238 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
26481ac222 Dani*0239 & 0.25 * dyG(i,j,bi,bj) *
6a651fd056 Dani*0240 & streamice_density * gravity *
e4cfce0a6c Dani*0241 & (1-streamice_density*i_rhow) *
96b006450c dngo*0242 & H_streamice(i,j,bi,bj)**2
e4cfce0a6c Dani*0243 #ifdef STREAMICE_FIRN_CORRECTION
0244 endif
0245 #endif
0246
6a651fd056 Dani*0247 END IF
0248 END IF
0249
96b006450c dngo*0250
0251
6a651fd056 Dani*0252 IF (streamice_hmask(i-1,j-1,bi,bj).eq.1.0.AND.
0253 & streamice_hmask(i,j-1,bi,bj).eq.1.0) THEN
0254
96b006450c dngo*0255
0256
0257
0258 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
26481ac222 Dani*0259 & 0.25 * dyg(i,j-1,bi,bj) *
e4cfce0a6c Dani*0260 & gravity *
0261 & (H_streamice(i,j-1,bi,bj)*avg_density(i,j-1,bi,bj)+
0262 & H_streamice(i-1,j-1,bi,bj)*avg_density(i-1,j-1,bi,bj)) *
6a651fd056 Dani*0263 & (surf_el_streamice(i,j-1,bi,bj)-
26481ac222 Dani*0264 & surf_el_streamice(i-1,j-1,bi,bj))
6a651fd056 Dani*0265
4a973b81ed Dani*0266 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
0267 & streamice_density * gravity *
96b006450c dngo*0268 & streamice_bg_surf_slope_x * .25 * rA(i,j-1,bi,bj) *
4a973b81ed Dani*0269 & (H_streamice(i-1,j-1,bi,bj) + H_streamice(i,j-1,bi,bj))
0270
6a651fd056 Dani*0271 ELSE IF (streamice_hmask(i-1,j-1,bi,bj).eq.1.0) THEN
0272
0273 IF (float_frac_streamice(i-1,j-1,bi,bj) .eq. 1.0) THEN
0274
050473d034 Dani*0275 #ifdef USE_ALT_RLOW
0276 IF (R_low_si(i-1,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0277 #else
050473d034 Dani*0278 IF (R_low(i-1,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0279 #endif
050473d034 Dani*0280 grd_below_sl = 1. _d 0
0281 else
0282 grd_below_sl = 0. _d 0
0283 endif
0284
6a651fd056 Dani*0285 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
26481ac222 Dani*0286 & 0.25 * dyg(i,j-1,bi,bj) *
96b006450c dngo*0287 & gravity *
e4cfce0a6c Dani*0288 & (avg_density(i-1,j-1,bi,bj)*H_streamice(i-1,j-1,bi,bj)**2-
6a651fd056 Dani*0289 #ifdef USE_ALT_RLOW
96b006450c dngo*0290 & streamice_density_ocean_avg*grd_below_sl *
050473d034 Dani*0291 & R_low_si(i-1,j-1,bi,bj)**2)
96b006450c dngo*0292 #else
0293 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0294 & R_low(i-1,j-1,bi,bj)**2)
6a651fd056 Dani*0295 #endif
5ca83cd8f7 Dani*0296
0297 ELSE
0298
e4cfce0a6c Dani*0299 #ifdef STREAMICE_FIRN_CORRECTION
0300
0301 if (STREAMICE_apply_firn_correction) then
0302 if (H_streamice(i-1,j-1,bi,bj).lt.firn_depth) then
0303 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
0304 & 0.25 * dyG(i,j-1,bi,bj) *
0305 & streamice_density_firn * gravity *
0306 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0307 & H_streamice(i-1,j-1,bi,bj)**2
e4cfce0a6c Dani*0308 else
0309 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
0310 & 0.25 * dyG(i,j-1,bi,bj) * gravity * (
96b006450c dngo*0311 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0312 & (h_streamice(i-1,j-1,bi,bj)-firn_depth) *
0313 & (streamice_density_firn*firn_depth+streamice_density*
0314 & (h_streamice(i-1,j-1,bi,bj)-streamice_firn_correction))-
0315 & streamice_density**2*i_rhow*
0316 & (h_streamice(i-1,j-1,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0317 & )
e4cfce0a6c Dani*0318 endif
0319 else
0320
0321 #endif
6a651fd056 Dani*0322 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) +
e4cfce0a6c Dani*0323 & 0.25 * dyG(i,j-1,bi,bj) *
6a651fd056 Dani*0324 & streamice_density * gravity *
e4cfce0a6c Dani*0325 & (1-streamice_density*i_rhow) *
96b006450c dngo*0326 & H_streamice(i-1,j-1,bi,bj)**2
e4cfce0a6c Dani*0327 #ifdef STREAMICE_FIRN_CORRECTION
0328 endif
0329 #endif
0330
5ca83cd8f7 Dani*0331 ENDIF
0332
6a651fd056 Dani*0333 ELSE IF (streamice_hmask(i,j-1,bi,bj).eq.1.0) THEN
5ca83cd8f7 Dani*0334
6a651fd056 Dani*0335 IF (float_frac_streamice(i,j-1,bi,bj) .eq. 1.0) THEN
5ca83cd8f7 Dani*0336
050473d034 Dani*0337 #ifdef USE_ALT_RLOW
0338 IF (R_low_si(i,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0339 #else
050473d034 Dani*0340 IF (R_low(i,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0341 #endif
050473d034 Dani*0342 grd_below_sl = 1. _d 0
0343 else
0344 grd_below_sl = 0. _d 0
0345 endif
0346
6a651fd056 Dani*0347 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
26481ac222 Dani*0348 & 0.25 * dyg(i,j-1,bi,bj) *
6a651fd056 Dani*0349 & gravity *
e4cfce0a6c Dani*0350 & (avg_density(i,j-1,bi,bj) * H_streamice(i,j-1,bi,bj)**2 -
6a651fd056 Dani*0351 #ifdef USE_ALT_RLOW
96b006450c dngo*0352 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0353 & R_low_si(i,j-1,bi,bj)**2)
96b006450c dngo*0354 #else
0355 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0356 & R_low(i,j-1,bi,bj)**2)
6a651fd056 Dani*0357 #endif
5ca83cd8f7 Dani*0358
0359 ELSE
0360
e4cfce0a6c Dani*0361 #ifdef STREAMICE_FIRN_CORRECTION
0362 if (STREAMICE_apply_firn_correction) then
0363 if (H_streamice(i,j-1,bi,bj).lt.firn_depth) then
e0987c9b93 Dani*0364 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
e4cfce0a6c Dani*0365 & 0.25 * dyG(i,j-1,bi,bj) *
0366 & streamice_density_firn * gravity *
0367 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0368 & H_streamice(i,j-1,bi,bj)**2
e4cfce0a6c Dani*0369 else
e0987c9b93 Dani*0370 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
e4cfce0a6c Dani*0371 & 0.25 * dyG(i,j-1,bi,bj) * gravity * (
96b006450c dngo*0372 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0373 & (h_streamice(i,j-1,bi,bj)-firn_depth) *
0374 & (streamice_density_firn*firn_depth+streamice_density*
0375 & (h_streamice(i,j-1,bi,bj)-streamice_firn_correction))-
0376 & streamice_density**2*i_rhow*
0377 & (h_streamice(i,j-1,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0378 & )
e4cfce0a6c Dani*0379 endif
0380 else
0381
0382 #endif
e0987c9b93 Dani*0383 taudx_si(i,j,bi,bj) = taudx_si(i,j,bi,bj) -
e4cfce0a6c Dani*0384 & 0.25 * dyG(i,j-1,bi,bj) *
6a651fd056 Dani*0385 & streamice_density * gravity *
e4cfce0a6c Dani*0386 & (1-streamice_density*i_rhow) *
96b006450c dngo*0387 & H_streamice(i,j-1,bi,bj)**2
e4cfce0a6c Dani*0388 #ifdef STREAMICE_FIRN_CORRECTION
0389 endif
0390 #endif
0391
96b006450c dngo*0392 END IF
6a651fd056 Dani*0393 END IF
96b006450c dngo*0394 END IF
5ca83cd8f7 Dani*0395
96b006450c dngo*0396
5ca83cd8f7 Dani*0397
6a651fd056 Dani*0398 IF (streamice_vmask(i,j,bi,bj).eq.1.0) THEN
0399
0400 IF (streamice_hmask(i,j-1,bi,bj).eq.1.0.AND.
0401 & streamice_hmask(i,j,bi,bj).eq.1.0) THEN
0402
96b006450c dngo*0403
0404
0405
0406 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
26481ac222 Dani*0407 & 0.25 * dxG(i,j,bi,bj) *
e4cfce0a6c Dani*0408 & gravity *
0409 & (H_streamice(i,j,bi,bj)*avg_density(i,j,bi,bj)+
0410 & H_streamice(i,j-1,bi,bj)*avg_density(i,j-1,bi,bj))*
6a651fd056 Dani*0411 & (surf_el_streamice(i,j,bi,bj)-
26481ac222 Dani*0412 & surf_el_streamice(i,j-1,bi,bj))
6a651fd056 Dani*0413
4a973b81ed Dani*0414 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
0415 & streamice_density * gravity *
96b006450c dngo*0416 & streamice_bg_surf_slope_y * .25 * rA(i,j,bi,bj) *
4a973b81ed Dani*0417 & (H_streamice(i,j-1,bi,bj) + H_streamice(i,j,bi,bj))
0418
6a651fd056 Dani*0419 ELSE IF (streamice_hmask(i,j-1,bi,bj).eq.1.0) THEN
0420
0421 IF (float_frac_streamice(i,j-1,bi,bj) .eq. 1.0) THEN
0422
050473d034 Dani*0423 #ifdef USE_ALT_RLOW
0424 IF (R_low_si(i,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0425 #else
050473d034 Dani*0426 IF (R_low(i,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0427 #endif
050473d034 Dani*0428 grd_below_sl = 1. _d 0
0429 else
0430 grd_below_sl = 0. _d 0
0431 endif
0432
6a651fd056 Dani*0433 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
26481ac222 Dani*0434 & 0.25 * dxG(i,j,bi,bj) *
96b006450c dngo*0435 & gravity *
e4cfce0a6c Dani*0436 & (avg_density(i,j-1,bi,bj) * H_streamice(i,j-1,bi,bj)**2 -
6a651fd056 Dani*0437 #ifdef USE_ALT_RLOW
96b006450c dngo*0438 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0439 & R_low_si(i,j-1,bi,bj)**2)
96b006450c dngo*0440 #else
0441 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0442 & R_low(i,j-1,bi,bj)**2)
6a651fd056 Dani*0443 #endif
5ca83cd8f7 Dani*0444
0445 ELSE
6a651fd056 Dani*0446
e4cfce0a6c Dani*0447 #ifdef STREAMICE_FIRN_CORRECTION
0448 if (STREAMICE_apply_firn_correction) then
0449 if (H_streamice(i,j-1,bi,bj).lt.firn_depth) then
751a06e847 Dani*0450 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
c04e36832e Dani*0451 & 0.25 * dxG(i,j,bi,bj) *
e4cfce0a6c Dani*0452 & streamice_density_firn * gravity *
0453 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0454 & H_streamice(i,j-1,bi,bj)**2
e4cfce0a6c Dani*0455 else
751a06e847 Dani*0456 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
c04e36832e Dani*0457 & 0.25 * dxG(i,j,bi,bj) * gravity * (
96b006450c dngo*0458 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0459 & (h_streamice(i,j-1,bi,bj)-firn_depth) *
0460 & (streamice_density_firn*firn_depth+streamice_density*
0461 & (h_streamice(i,j-1,bi,bj)-streamice_firn_correction))-
0462 & streamice_density**2*i_rhow*
0463 & (h_streamice(i,j-1,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0464 & )
e4cfce0a6c Dani*0465 endif
0466 else
0467
0468 #endif
751a06e847 Dani*0469 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
c04e36832e Dani*0470 & 0.25 * dxG(i,j,bi,bj) *
6a651fd056 Dani*0471 & streamice_density * gravity *
e4cfce0a6c Dani*0472 & (1-streamice_density*i_rhow) *
96b006450c dngo*0473 & H_streamice(i,j-1,bi,bj)**2
e4cfce0a6c Dani*0474 #ifdef STREAMICE_FIRN_CORRECTION
0475 endif
0476 #endif
0477
5ca83cd8f7 Dani*0478 ENDIF
6a651fd056 Dani*0479
0480 ELSE IF (streamice_hmask(i,j,bi,bj).eq.1.0) THEN
0481
0482 IF (float_frac_streamice(i,j,bi,bj) .eq. 1.0) THEN
0483
050473d034 Dani*0484 #ifdef USE_ALT_RLOW
0485 IF (R_low_si(i,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0486 #else
050473d034 Dani*0487 IF (R_low(i,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0488 #endif
050473d034 Dani*0489 grd_below_sl = 1. _d 0
0490 else
0491 grd_below_sl = 0. _d 0
0492 endif
0493
6a651fd056 Dani*0494 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
26481ac222 Dani*0495 & 0.25 * dxG(i,j,bi,bj) *
6a651fd056 Dani*0496 & gravity *
e4cfce0a6c Dani*0497 & (avg_density(i,j,bi,bj) * H_streamice(i,j,bi,bj)**2 -
6a651fd056 Dani*0498 #ifdef USE_ALT_RLOW
96b006450c dngo*0499 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0500 & R_low_si(i,j,bi,bj)**2)
96b006450c dngo*0501 #else
0502 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0503 & R_low(i,j,bi,bj)**2)
6a651fd056 Dani*0504 #endif
0505
5ca83cd8f7 Dani*0506 ELSE
6a651fd056 Dani*0507
e4cfce0a6c Dani*0508 #ifdef STREAMICE_FIRN_CORRECTION
0509 if (STREAMICE_apply_firn_correction) then
0510 if (H_streamice(i,j,bi,bj).lt.firn_depth) then
751a06e847 Dani*0511 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
c04e36832e Dani*0512 & 0.25 * dxG(i,j,bi,bj) *
e4cfce0a6c Dani*0513 & streamice_density_firn * gravity *
0514 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0515 & H_streamice(i,j,bi,bj)**2
e4cfce0a6c Dani*0516 else
751a06e847 Dani*0517 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
c04e36832e Dani*0518 & 0.25 * dxG(i,j,bi,bj) * gravity * (
96b006450c dngo*0519 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0520 & (h_streamice(i,j,bi,bj)-firn_depth) *
0521 & (streamice_density_firn*firn_depth+streamice_density*
0522 & (h_streamice(i,j,bi,bj)-streamice_firn_correction))-
0523 & streamice_density**2*i_rhow*
0524 & (h_streamice(i,j,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0525 & )
e4cfce0a6c Dani*0526 endif
0527 else
0528
0529 #endif
751a06e847 Dani*0530 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
c04e36832e Dani*0531 & 0.25 * dxG(i,j,bi,bj) *
6a651fd056 Dani*0532 & streamice_density * gravity *
e4cfce0a6c Dani*0533 & (1-streamice_density*i_rhow) *
96b006450c dngo*0534 & H_streamice(i,j,bi,bj)**2
e4cfce0a6c Dani*0535 #ifdef STREAMICE_FIRN_CORRECTION
0536 endif
0537 #endif
0538
6a651fd056 Dani*0539 END IF
0540 END IF
0541
96b006450c dngo*0542
0543
6a651fd056 Dani*0544 IF (streamice_hmask(i-1,j-1,bi,bj).eq.1.0.AND.
0545 & streamice_hmask(i-1,j,bi,bj).eq.1.0) THEN
96b006450c dngo*0546
0547
0548
6a651fd056 Dani*0549
0550 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
26481ac222 Dani*0551 & 0.25 * dxG(i-1,j,bi,bj) *
e4cfce0a6c Dani*0552 & gravity *
0553 & (H_streamice(i-1,j,bi,bj)*avg_density(i-1,j,bi,bj)+
0554 & H_streamice(i-1,j-1,bi,bj)*avg_density(i-1,j-1,bi,bj))*
6a651fd056 Dani*0555 & (surf_el_streamice(i-1,j,bi,bj)-
26481ac222 Dani*0556 & surf_el_streamice(i-1,j-1,bi,bj))
6a651fd056 Dani*0557
4a973b81ed Dani*0558 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
0559 & streamice_density * gravity *
26481ac222 Dani*0560 & streamice_bg_surf_slope_y * .25 * rA(i-1,j,bi,bj) *
4a973b81ed Dani*0561 & (H_streamice(i-1,j-1,bi,bj) + H_streamice(i-1,j,bi,bj))
0562
6a651fd056 Dani*0563 ELSE IF (streamice_hmask(i-1,j-1,bi,bj).eq.1.0) THEN
0564
0565 IF (float_frac_streamice(i-1,j-1,bi,bj) .eq. 1.0) THEN
0566
050473d034 Dani*0567 #ifdef USE_ALT_RLOW
0568 IF (R_low_si(i-1,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0569 #else
050473d034 Dani*0570 IF (R_low(i-1,j-1,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0571 #endif
050473d034 Dani*0572 grd_below_sl = 1. _d 0
0573 else
0574 grd_below_sl = 0. _d 0
0575 endif
0576
6a651fd056 Dani*0577 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
26481ac222 Dani*0578 & 0.25 * dxG(i-1,j,bi,bj) *
96b006450c dngo*0579 & gravity *
e4cfce0a6c Dani*0580 & (avg_density(i-1,j-1,bi,bj)*H_streamice(i-1,j-1,bi,bj)**2-
6a651fd056 Dani*0581 #ifdef USE_ALT_RLOW
96b006450c dngo*0582 & streamice_density_ocean_avg*grd_below_sl *
050473d034 Dani*0583 & R_low_si(i-1,j-1,bi,bj)**2)
96b006450c dngo*0584 #else
0585 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0586 & R_low(i-1,j-1,bi,bj)**2)
6a651fd056 Dani*0587 #endif
0588
5ca83cd8f7 Dani*0589 ELSE
6a651fd056 Dani*0590
e4cfce0a6c Dani*0591 #ifdef STREAMICE_FIRN_CORRECTION
0592 if (STREAMICE_apply_firn_correction) then
0593 if (H_streamice(i-1,j-1,bi,bj).lt.firn_depth) then
751a06e847 Dani*0594 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
c04e36832e Dani*0595 & 0.25 * dxG(i-1,j,bi,bj) *
e4cfce0a6c Dani*0596 & streamice_density_firn * gravity *
0597 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0598 & H_streamice(i-1,j-1,bi,bj)**2
e4cfce0a6c Dani*0599 else
751a06e847 Dani*0600 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
c04e36832e Dani*0601 & 0.25 * dxG(i-1,j,bi,bj) * gravity * (
96b006450c dngo*0602 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0603 & (h_streamice(i-1,j-1,bi,bj)-firn_depth) *
0604 & (streamice_density_firn*firn_depth+streamice_density*
0605 & (h_streamice(i-1,j-1,bi,bj)-streamice_firn_correction))-
0606 & streamice_density**2*i_rhow*
0607 & (h_streamice(i-1,j-1,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0608 & )
e4cfce0a6c Dani*0609 endif
0610 else
0611 #endif
751a06e847 Dani*0612 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) +
c04e36832e Dani*0613 & 0.25 * dxG(i-1,j,bi,bj) *
6a651fd056 Dani*0614 & streamice_density * gravity *
e4cfce0a6c Dani*0615 & (1-streamice_density*i_rhow) *
96b006450c dngo*0616 & H_streamice(i-1,j-1,bi,bj)**2
e4cfce0a6c Dani*0617 #ifdef STREAMICE_FIRN_CORRECTION
0618 endif
0619 #endif
0620
5ca83cd8f7 Dani*0621 ENDIF
6a651fd056 Dani*0622
0623 ELSE IF (streamice_hmask(i-1,j,bi,bj).eq.1.0) THEN
0624
0625 IF (float_frac_streamice(i-1,j,bi,bj) .eq. 1.0) THEN
0626
050473d034 Dani*0627 #ifdef USE_ALT_RLOW
0628 IF (R_low_si(i-1,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0629 #else
050473d034 Dani*0630 IF (R_low(i-1,j,bi,bj) .lt. 0. _d 0) then
96b006450c dngo*0631 #endif
050473d034 Dani*0632 grd_below_sl = 1. _d 0
0633 else
0634 grd_below_sl = 0. _d 0
0635 endif
0636
6a651fd056 Dani*0637 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
26481ac222 Dani*0638 & 0.25 * dxG(i-1,j,bi,bj) *
6a651fd056 Dani*0639 & gravity *
e4cfce0a6c Dani*0640 & (avg_density(i-1,j,bi,bj) * H_streamice(i-1,j,bi,bj)**2 -
5ca83cd8f7 Dani*0641 #ifdef USE_ALT_RLOW
96b006450c dngo*0642 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0643 & R_low_si(i-1,j,bi,bj)**2)
96b006450c dngo*0644 #else
0645 & streamice_density_ocean_avg * grd_below_sl *
050473d034 Dani*0646 & R_low(i-1,j,bi,bj)**2)
5ca83cd8f7 Dani*0647 #endif
6a651fd056 Dani*0648
0649 ELSE
0650
e4cfce0a6c Dani*0651 #ifdef STREAMICE_FIRN_CORRECTION
0652 if (STREAMICE_apply_firn_correction) then
0653 if (H_streamice(i-1,j,bi,bj).lt.firn_depth) then
751a06e847 Dani*0654 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
c04e36832e Dani*0655 & 0.25 * dxG(i-1,j,bi,bj) *
e4cfce0a6c Dani*0656 & streamice_density_firn * gravity *
0657 & (1-streamice_density_firn*i_rhow) *
96b006450c dngo*0658 & H_streamice(i-1,j,bi,bj)**2
e4cfce0a6c Dani*0659 else
751a06e847 Dani*0660 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
c04e36832e Dani*0661 & 0.25 * dxG(i-1,j,bi,bj) * gravity * (
96b006450c dngo*0662 & streamice_density_firn * firn_depth**2 +
e4cfce0a6c Dani*0663 & (h_streamice(i-1,j,bi,bj)-firn_depth) *
0664 & (streamice_density_firn*firn_depth+streamice_density*
0665 & (h_streamice(i-1,j,bi,bj)-streamice_firn_correction))-
0666 & streamice_density**2*i_rhow*
0667 & (h_streamice(i-1,j,bi,bj)-streamice_firn_correction)**2
96b006450c dngo*0668 & )
e4cfce0a6c Dani*0669 endif
0670 else
0671 #endif
751a06e847 Dani*0672 taudy_si(i,j,bi,bj) = taudy_si(i,j,bi,bj) -
c04e36832e Dani*0673 & 0.25 * dxG(i-1,j,bi,bj) *
6a651fd056 Dani*0674 & streamice_density * gravity *
e4cfce0a6c Dani*0675 & (1-streamice_density*i_rhow) *
96b006450c dngo*0676 & H_streamice(i-1,j,bi,bj)**2
e4cfce0a6c Dani*0677 #ifdef STREAMICE_FIRN_CORRECTION
0678 endif
0679 #endif
0680
96b006450c dngo*0681 END IF
6a651fd056 Dani*0682 END IF
0683 END IF
0684
5ca83cd8f7 Dani*0685 ENDDO
0686 ENDDO
0687 ENDDO
0688 ENDDO
0689
96b006450c dngo*0690
0691
0692
0693
5ca83cd8f7 Dani*0694
0695 #endif
0696 RETURN
0697 END