| 1 | MODULE icbdyn |
|---|
| 2 | !!====================================================================== |
|---|
| 3 | !! *** MODULE icbdyn *** |
|---|
| 4 | !! Iceberg: time stepping routine for iceberg tracking |
|---|
| 5 | !!====================================================================== |
|---|
| 6 | !! History : 3.3 ! 2010-01 (Martin&Adcroft) Original code |
|---|
| 7 | !! - ! 2011-03 (Madec) Part conversion to NEMO form |
|---|
| 8 | !! - ! Removal of mapping from another grid |
|---|
| 9 | !! - ! 2011-04 (Alderson) Split into separate modules |
|---|
| 10 | !! - ! 2011-05 (Alderson) Replace broken grounding routine with one of |
|---|
| 11 | !! - ! Gurvan's suggestions (just like the broken one) |
|---|
| 12 | !!---------------------------------------------------------------------- |
|---|
| 13 | USE par_oce ! NEMO parameters |
|---|
| 14 | USE dom_oce ! NEMO ocean domain |
|---|
| 15 | USE phycst ! NEMO physical constants |
|---|
| 16 | USE in_out_manager ! IO parameters |
|---|
| 17 | ! |
|---|
| 18 | USE icb_oce ! define iceberg arrays |
|---|
| 19 | USE icbutl ! iceberg utility routines |
|---|
| 20 | USE icbdia ! iceberg budget routines |
|---|
| 21 | |
|---|
| 22 | IMPLICIT NONE |
|---|
| 23 | PRIVATE |
|---|
| 24 | |
|---|
| 25 | PUBLIC icb_dyn ! routine called in icbstp.F90 module |
|---|
| 26 | |
|---|
| 27 | !! * Substitutions |
|---|
| 28 | # include "single_precision_substitute.h90" |
|---|
| 29 | |
|---|
| 30 | !!---------------------------------------------------------------------- |
|---|
| 31 | !! NEMO/OCE 4.0 , NEMO Consortium (2018) |
|---|
| 32 | !! $Id$ |
|---|
| 33 | !! Software governed by the CeCILL license (see ./LICENSE) |
|---|
| 34 | !!---------------------------------------------------------------------- |
|---|
| 35 | CONTAINS |
|---|
| 36 | |
|---|
| 37 | SUBROUTINE icb_dyn( kt ) |
|---|
| 38 | !!---------------------------------------------------------------------- |
|---|
| 39 | !! *** ROUTINE icb_dyn *** |
|---|
| 40 | !! |
|---|
| 41 | !! ** Purpose : iceberg evolution. |
|---|
| 42 | !! |
|---|
| 43 | !! ** Method : - See Martin & Adcroft, Ocean Modelling 34, 2010 |
|---|
| 44 | !!---------------------------------------------------------------------- |
|---|
| 45 | INTEGER, INTENT(in) :: kt ! |
|---|
| 46 | ! |
|---|
| 47 | LOGICAL :: ll_bounced |
|---|
| 48 | REAL(wp) :: zuvel1 , zvvel1 , zu1, zv1, zax1, zay1, zxi1 , zyj1 |
|---|
| 49 | REAL(wp) :: zuvel2 , zvvel2 , zu2, zv2, zax2, zay2, zxi2 , zyj2 |
|---|
| 50 | REAL(wp) :: zuvel3 , zvvel3 , zu3, zv3, zax3, zay3, zxi3 , zyj3 |
|---|
| 51 | REAL(wp) :: zuvel4 , zvvel4 , zu4, zv4, zax4, zay4, zxi4 , zyj4 |
|---|
| 52 | REAL(wp) :: zuvel_n, zvvel_n, zxi_n , zyj_n |
|---|
| 53 | REAL(wp) :: zdt, zdt_2, zdt_6, ze1, ze2 |
|---|
| 54 | TYPE(iceberg), POINTER :: berg |
|---|
| 55 | TYPE(point) , POINTER :: pt |
|---|
| 56 | !!---------------------------------------------------------------------- |
|---|
| 57 | ! |
|---|
| 58 | ! 4th order Runge-Kutta to solve: d/dt X = V, d/dt V = A |
|---|
| 59 | ! with I.C.'s: X=X1 and V=V1 |
|---|
| 60 | ! |
|---|
| 61 | ! ; A1=A(X1,V1) |
|---|
| 62 | ! X2 = X1+dt/2*V1 ; V2 = V1+dt/2*A1 ; A2=A(X2,V2) |
|---|
| 63 | ! X3 = X1+dt/2*V2 ; V3 = V1+dt/2*A2 ; A3=A(X3,V3) |
|---|
| 64 | ! X4 = X1+ dt*V3 ; V4 = V1+ dt*A3 ; A4=A(X4,V4) |
|---|
| 65 | ! |
|---|
| 66 | ! Xn = X1+dt*(V1+2*V2+2*V3+V4)/6 |
|---|
| 67 | ! Vn = V1+dt*(A1+2*A2+2*A3+A4)/6 |
|---|
| 68 | |
|---|
| 69 | ! time steps |
|---|
| 70 | zdt = berg_dt |
|---|
| 71 | zdt_2 = zdt * 0.5_wp |
|---|
| 72 | zdt_6 = zdt / 6._wp |
|---|
| 73 | |
|---|
| 74 | berg => first_berg ! start from the first berg |
|---|
| 75 | ! |
|---|
| 76 | DO WHILE ( ASSOCIATED(berg) ) !== loop over all bergs ==! |
|---|
| 77 | ! |
|---|
| 78 | pt => berg%current_point |
|---|
| 79 | |
|---|
| 80 | ll_bounced = .FALSE. |
|---|
| 81 | |
|---|
| 82 | |
|---|
| 83 | ! STEP 1 ! |
|---|
| 84 | ! ====== ! |
|---|
| 85 | zxi1 = pt%xi ; zuvel1 = pt%uvel !** X1 in (i,j) ; V1 in m/s |
|---|
| 86 | zyj1 = pt%yj ; zvvel1 = pt%vvel |
|---|
| 87 | |
|---|
| 88 | |
|---|
| 89 | ! !** A1 = A(X1,V1) |
|---|
| 90 | CALL icb_accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1, & |
|---|
| 91 | & zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 ) |
|---|
| 92 | ! |
|---|
| 93 | zu1 = zuvel1 / ze1 !** V1 in d(i,j)/dt |
|---|
| 94 | zv1 = zvvel1 / ze2 |
|---|
| 95 | |
|---|
| 96 | ! STEP 2 ! |
|---|
| 97 | ! ====== ! |
|---|
| 98 | ! !** X2 = X1+dt/2*V1 ; V2 = V1+dt/2*A1 |
|---|
| 99 | ! position using di/dt & djdt ! V2 in m/s |
|---|
| 100 | zxi2 = zxi1 + zdt_2 * zu1 ; zuvel2 = zuvel1 + zdt_2 * zax1 |
|---|
| 101 | zyj2 = zyj1 + zdt_2 * zv1 ; zvvel2 = zvvel1 + zdt_2 * zay1 |
|---|
| 102 | ! |
|---|
| 103 | CALL icb_ground( berg, zxi2, zxi1, zu1, & |
|---|
| 104 | & zyj2, zyj1, zv1, ll_bounced ) |
|---|
| 105 | |
|---|
| 106 | ! !** A2 = A(X2,V2) |
|---|
| 107 | CALL icb_accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2, & |
|---|
| 108 | & zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 ) |
|---|
| 109 | ! |
|---|
| 110 | zu2 = zuvel2 / ze1 !** V2 in d(i,j)/dt |
|---|
| 111 | zv2 = zvvel2 / ze2 |
|---|
| 112 | ! |
|---|
| 113 | ! STEP 3 ! |
|---|
| 114 | ! ====== ! |
|---|
| 115 | ! !** X3 = X1+dt/2*V2 ; V3 = V1+dt/2*A2; A3=A(X3) |
|---|
| 116 | zxi3 = zxi1 + zdt_2 * zu2 ; zuvel3 = zuvel1 + zdt_2 * zax2 |
|---|
| 117 | zyj3 = zyj1 + zdt_2 * zv2 ; zvvel3 = zvvel1 + zdt_2 * zay2 |
|---|
| 118 | ! |
|---|
| 119 | CALL icb_ground( berg, zxi3, zxi1, zu3, & |
|---|
| 120 | & zyj3, zyj1, zv3, ll_bounced ) |
|---|
| 121 | |
|---|
| 122 | ! !** A3 = A(X3,V3) |
|---|
| 123 | CALL icb_accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3, & |
|---|
| 124 | & zyj3, ze2, zvvel3, zvvel1, zay3, zdt ) |
|---|
| 125 | ! |
|---|
| 126 | zu3 = zuvel3 / ze1 !** V3 in d(i,j)/dt |
|---|
| 127 | zv3 = zvvel3 / ze2 |
|---|
| 128 | |
|---|
| 129 | ! STEP 4 ! |
|---|
| 130 | ! ====== ! |
|---|
| 131 | ! !** X4 = X1+dt*V3 ; V4 = V1+dt*A3 |
|---|
| 132 | zxi4 = zxi1 + zdt * zu3 ; zuvel4 = zuvel1 + zdt * zax3 |
|---|
| 133 | zyj4 = zyj1 + zdt * zv3 ; zvvel4 = zvvel1 + zdt * zay3 |
|---|
| 134 | |
|---|
| 135 | CALL icb_ground( berg, zxi4, zxi1, zu4, & |
|---|
| 136 | & zyj4, zyj1, zv4, ll_bounced ) |
|---|
| 137 | |
|---|
| 138 | ! !** A4 = A(X4,V4) |
|---|
| 139 | CALL icb_accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4, & |
|---|
| 140 | & zyj4, ze2, zvvel4, zvvel1, zay4, zdt ) |
|---|
| 141 | |
|---|
| 142 | zu4 = zuvel4 / ze1 !** V4 in d(i,j)/dt |
|---|
| 143 | zv4 = zvvel4 / ze2 |
|---|
| 144 | |
|---|
| 145 | ! FINAL STEP ! |
|---|
| 146 | ! ========== ! |
|---|
| 147 | ! !** Xn = X1+dt*(V1+2*V2+2*V3+V4)/6 |
|---|
| 148 | ! !** Vn = V1+dt*(A1+2*A2+2*A3+A4)/6 |
|---|
| 149 | zxi_n = pt%xi + zdt_6 * ( zu1 + 2.*(zu2 + zu3 ) + zu4 ) |
|---|
| 150 | zyj_n = pt%yj + zdt_6 * ( zv1 + 2.*(zv2 + zv3 ) + zv4 ) |
|---|
| 151 | zuvel_n = pt%uvel + zdt_6 * ( zax1 + 2.*(zax2 + zax3) + zax4 ) |
|---|
| 152 | zvvel_n = pt%vvel + zdt_6 * ( zay1 + 2.*(zay2 + zay3) + zay4 ) |
|---|
| 153 | |
|---|
| 154 | CALL icb_ground( berg, zxi_n, zxi1, zuvel_n, & |
|---|
| 155 | & zyj_n, zyj1, zvvel_n, ll_bounced ) |
|---|
| 156 | |
|---|
| 157 | pt%uvel = zuvel_n !** save in berg structure |
|---|
| 158 | pt%vvel = zvvel_n |
|---|
| 159 | pt%xi = zxi_n |
|---|
| 160 | pt%yj = zyj_n |
|---|
| 161 | |
|---|
| 162 | berg => berg%next ! switch to the next berg |
|---|
| 163 | ! |
|---|
| 164 | END DO !== end loop over all bergs ==! |
|---|
| 165 | ! |
|---|
| 166 | END SUBROUTINE icb_dyn |
|---|
| 167 | |
|---|
| 168 | |
|---|
| 169 | SUBROUTINE icb_ground( berg, pi, pi0, pu, & |
|---|
| 170 | & pj, pj0, pv, ld_bounced ) |
|---|
| 171 | !!---------------------------------------------------------------------- |
|---|
| 172 | !! *** ROUTINE icb_ground *** |
|---|
| 173 | !! |
|---|
| 174 | !! ** Purpose : iceberg grounding. |
|---|
| 175 | !! |
|---|
| 176 | !! ** Method : - adjust velocity and then put iceberg back to start position |
|---|
| 177 | !! NB two possibilities available one of which is hard-coded here |
|---|
| 178 | !!---------------------------------------------------------------------- |
|---|
| 179 | TYPE(iceberg ), POINTER, INTENT(in ) :: berg ! berg |
|---|
| 180 | ! |
|---|
| 181 | REAL(wp), INTENT(inout) :: pi , pj ! current iceberg position |
|---|
| 182 | REAL(wp), INTENT(in ) :: pi0, pj0 ! previous iceberg position |
|---|
| 183 | REAL(wp), INTENT(inout) :: pu , pv ! current iceberg velocities |
|---|
| 184 | LOGICAL , INTENT( out) :: ld_bounced ! bounced indicator |
|---|
| 185 | ! |
|---|
| 186 | INTEGER :: ii, ii0 |
|---|
| 187 | INTEGER :: ij, ij0 |
|---|
| 188 | INTEGER :: ikb |
|---|
| 189 | INTEGER :: ibounce_method |
|---|
| 190 | ! |
|---|
| 191 | REAL(wp) :: zD |
|---|
| 192 | REAL(wp), DIMENSION(jpk) :: ze3t |
|---|
| 193 | !!---------------------------------------------------------------------- |
|---|
| 194 | ! |
|---|
| 195 | ld_bounced = .FALSE. |
|---|
| 196 | ! |
|---|
| 197 | ii0 = INT( pi0+0.5 ) ; ij0 = INT( pj0+0.5 ) ! initial gridpoint position (T-cell) |
|---|
| 198 | ii = INT( pi +0.5 ) ; ij = INT( pj +0.5 ) ! current - - |
|---|
| 199 | ! |
|---|
| 200 | IF( ii == ii0 .AND. ij == ij0 ) RETURN ! berg remains in the same cell |
|---|
| 201 | ! |
|---|
| 202 | ! map into current processor |
|---|
| 203 | ii0 = mi1( ii0 ) |
|---|
| 204 | ij0 = mj1( ij0 ) |
|---|
| 205 | ii = mi1( ii ) |
|---|
| 206 | ij = mj1( ij ) |
|---|
| 207 | ! |
|---|
| 208 | ! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0 |
|---|
| 209 | IF ( ln_M2016 .AND. ln_icb_grd ) THEN |
|---|
| 210 | ! |
|---|
| 211 | ! draught (keel depth) |
|---|
| 212 | zD = rho_berg_1_oce * berg%current_point%thickness |
|---|
| 213 | ! |
|---|
| 214 | ! interpol needed data |
|---|
| 215 | CALL icb_utl_interp( pi, pj, pe3t=ze3t ) |
|---|
| 216 | ! |
|---|
| 217 | !compute bottom level |
|---|
| 218 | CALL icb_utl_getkb( ikb, ze3t, zD ) |
|---|
| 219 | ! |
|---|
| 220 | ! berg reach a new t-cell, but an ocean one |
|---|
| 221 | ! .AND. needed in case berg hit an isf (tmask(ii,ij,1) == 0 and tmask(ii,ij,ikb) /= 0) |
|---|
| 222 | IF( tmask(ii,ij,ikb) /= 0._wp .AND. tmask(ii,ij,1) /= 0._wp ) RETURN |
|---|
| 223 | ! |
|---|
| 224 | ELSE |
|---|
| 225 | IF( tmask(ii,ij,1) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one |
|---|
| 226 | END IF |
|---|
| 227 | ! |
|---|
| 228 | ! From here, berg have reach land: treat grounding/bouncing |
|---|
| 229 | ! ------------------------------- |
|---|
| 230 | ld_bounced = .TRUE. |
|---|
| 231 | |
|---|
| 232 | !! not obvious what should happen now |
|---|
| 233 | !! if berg tries to enter a land box, the only location we can return it to is the start |
|---|
| 234 | !! position (pi0,pj0), since it has to be in a wet box to do any melting; |
|---|
| 235 | !! first option is simply to set whole velocity to zero and move back to start point |
|---|
| 236 | !! second option (suggested by gm) is only to set the velocity component in the (i,j) direction |
|---|
| 237 | !! of travel to zero; at a coastal boundary this has the effect of sliding the berg along the coast |
|---|
| 238 | |
|---|
| 239 | ibounce_method = 2 |
|---|
| 240 | SELECT CASE ( ibounce_method ) |
|---|
| 241 | CASE ( 1 ) |
|---|
| 242 | pi = pi0 |
|---|
| 243 | pj = pj0 |
|---|
| 244 | pu = 0._wp |
|---|
| 245 | pv = 0._wp |
|---|
| 246 | CASE ( 2 ) |
|---|
| 247 | IF( ii0 /= ii ) THEN |
|---|
| 248 | pi = pi0 ! return back to the initial position |
|---|
| 249 | pu = 0._wp ! zeroing of velocity in the direction of the grounding |
|---|
| 250 | ENDIF |
|---|
| 251 | IF( ij0 /= ij ) THEN |
|---|
| 252 | pj = pj0 ! return back to the initial position |
|---|
| 253 | pv = 0._wp ! zeroing of velocity in the direction of the grounding |
|---|
| 254 | ENDIF |
|---|
| 255 | END SELECT |
|---|
| 256 | ! |
|---|
| 257 | END SUBROUTINE icb_ground |
|---|
| 258 | |
|---|
| 259 | |
|---|
| 260 | SUBROUTINE icb_accel( berg , pxi, pe1, puvel, puvel0, pax, & |
|---|
| 261 | & pyj, pe2, pvvel, pvvel0, pay, pdt ) |
|---|
| 262 | !!---------------------------------------------------------------------- |
|---|
| 263 | !! *** ROUTINE icb_accel *** |
|---|
| 264 | !! |
|---|
| 265 | !! ** Purpose : compute the iceberg acceleration. |
|---|
| 266 | !! |
|---|
| 267 | !! ** Method : - sum the terms in the momentum budget |
|---|
| 268 | !!---------------------------------------------------------------------- |
|---|
| 269 | TYPE(iceberg ), POINTER, INTENT(in ) :: berg ! berg |
|---|
| 270 | REAL(wp) , INTENT(in ) :: pxi , pyj ! berg position in (i,j) referential |
|---|
| 271 | REAL(wp) , INTENT(in ) :: puvel , pvvel ! berg velocity [m/s] |
|---|
| 272 | REAL(wp) , INTENT(in ) :: puvel0, pvvel0 ! initial berg velocity [m/s] |
|---|
| 273 | REAL(wp) , INTENT( out) :: pe1, pe2 ! horizontal scale factor at (xi,yj) |
|---|
| 274 | REAL(wp) , INTENT(inout) :: pax, pay ! berg acceleration |
|---|
| 275 | REAL(wp) , INTENT(in ) :: pdt ! berg time step |
|---|
| 276 | ! |
|---|
| 277 | REAL(wp), PARAMETER :: pp_alpha = 0._wp ! |
|---|
| 278 | REAL(wp), PARAMETER :: pp_beta = 1._wp ! |
|---|
| 279 | REAL(wp), PARAMETER :: pp_vel_lim =15._wp ! max allowed berg speed |
|---|
| 280 | REAL(wp), PARAMETER :: pp_accel_lim = 1.e-2_wp ! max allowed berg acceleration |
|---|
| 281 | REAL(wp), PARAMETER :: pp_Cr0 = 0.06_wp ! |
|---|
| 282 | ! |
|---|
| 283 | INTEGER :: itloop, ikb, jk |
|---|
| 284 | REAL(wp) :: zuo, zssu, zui, zua, zuwave, zssh_x, zcn, zhi |
|---|
| 285 | REAL(wp) :: zvo, zssv, zvi, zva, zvwave, zssh_y |
|---|
| 286 | REAL(wp) :: zff, zT, zD, zW, zL, zM, zF |
|---|
| 287 | REAL(wp) :: zdrag_ocn, zdrag_atm, zdrag_ice, zwave_rad |
|---|
| 288 | REAL(wp) :: z_ocn, z_atm, z_ice, zdep |
|---|
| 289 | REAL(wp) :: zampl, zwmod, zCr, zLwavelength, zLcutoff, zLtop |
|---|
| 290 | REAL(wp) :: zlambda, zdetA, zA11, zA12, zaxe, zaye, zD_hi |
|---|
| 291 | REAL(wp) :: zuveln, zvveln, zus, zvs, zspeed, zloc_dx, zspeed_new |
|---|
| 292 | REAL(wp), DIMENSION(jpk) :: zuoce, zvoce, ze3t, zdepw |
|---|
| 293 | !!---------------------------------------------------------------------- |
|---|
| 294 | |
|---|
| 295 | ! Interpolate gridded fields to berg |
|---|
| 296 | nknberg = berg%number(1) |
|---|
| 297 | CALL icb_utl_interp( pxi, pyj, pe1=pe1, pe2=pe2, & ! scale factor |
|---|
| 298 | & pssu=zssu, pui=zui, pua=zua, & ! oce/ice/atm velocities |
|---|
| 299 | & pssv=zssv, pvi=zvi, pva=zva, & ! oce/ice/atm velocities |
|---|
| 300 | & pssh_i=zssh_x, pssh_j=zssh_y, & ! ssh gradient |
|---|
| 301 | & phi=zhi, pff=zff) ! ice thickness and coriolis |
|---|
| 302 | |
|---|
| 303 | zM = berg%current_point%mass |
|---|
| 304 | zT = berg%current_point%thickness ! total thickness |
|---|
| 305 | zD = rho_berg_1_oce * zT ! draught (keel depth) |
|---|
| 306 | zF = zT - zD ! freeboard |
|---|
| 307 | zW = berg%current_point%width |
|---|
| 308 | zL = berg%current_point%length |
|---|
| 309 | |
|---|
| 310 | zhi = MIN( zhi , zD ) |
|---|
| 311 | zD_hi = MAX( 0._wp, zD-zhi ) |
|---|
| 312 | |
|---|
| 313 | ! Wave radiation |
|---|
| 314 | zuwave = zua - zssu ; zvwave = zva - zssv ! Use wind speed rel. to ocean for wave model |
|---|
| 315 | zwmod = zuwave*zuwave + zvwave*zvwave ! The wave amplitude and length depend on the current; |
|---|
| 316 | ! ! wind speed relative to the ocean. Actually wmod is wmod**2 here. |
|---|
| 317 | zampl = 0.5 * 0.02025 * zwmod ! This is "a", the wave amplitude |
|---|
| 318 | zLwavelength = 0.32 * zwmod ! Surface wave length fitted to data in table at |
|---|
| 319 | ! ! http://www4.ncsu.edu/eos/users/c/ceknowle/public/chapter10/part2.html |
|---|
| 320 | zLcutoff = 0.125 * zLwavelength |
|---|
| 321 | zLtop = 0.25 * zLwavelength |
|---|
| 322 | zCr = pp_Cr0 * MIN( MAX( 0., (zL-zLcutoff) / ((zLtop-zLcutoff)+1.e-30)) , 1.) ! Wave radiation coefficient |
|---|
| 323 | ! ! fitted to graph from Carrieres et al., POAC Drift Model. |
|---|
| 324 | zwave_rad = 0.5 * pp_rho_seawater / zM * zCr * grav * zampl * MIN( zampl,zF ) * (2.*zW*zL) / (zW+zL) |
|---|
| 325 | zwmod = SQRT( zua*zua + zva*zva ) ! Wind speed |
|---|
| 326 | IF( zwmod /= 0._wp ) THEN |
|---|
| 327 | zuwave = zua/zwmod ! Wave radiation force acts in wind direction ... !!gm this should be the wind rel. to ocean ? |
|---|
| 328 | zvwave = zva/zwmod |
|---|
| 329 | ELSE |
|---|
| 330 | zuwave = 0. ; zvwave=0. ; zwave_rad=0. ! ... and only when wind is present. !!gm wave_rad=0. is useless |
|---|
| 331 | ENDIF |
|---|
| 332 | |
|---|
| 333 | ! Weighted drag coefficients |
|---|
| 334 | z_ocn = pp_rho_seawater / zM * (0.5*pp_Cd_wv*zW*(zD_hi)+pp_Cd_wh*zW*zL) |
|---|
| 335 | z_atm = pp_rho_air / zM * (0.5*pp_Cd_av*zW*zF +pp_Cd_ah*zW*zL) |
|---|
| 336 | z_ice = pp_rho_ice / zM * (0.5*pp_Cd_iv*zW*zhi ) |
|---|
| 337 | IF( abs(zui) + abs(zvi) == 0._wp ) z_ice = 0._wp |
|---|
| 338 | |
|---|
| 339 | ! lateral velocities |
|---|
| 340 | ! default ssu and ssv |
|---|
| 341 | ! ln_M2016: mean velocity along the profile |
|---|
| 342 | IF ( ln_M2016 ) THEN |
|---|
| 343 | ! interpol needed data |
|---|
| 344 | CALL icb_utl_interp( pxi, pyj, puoce=zuoce, pvoce=zvoce, pe3t=ze3t ) ! 3d velocities |
|---|
| 345 | |
|---|
| 346 | !compute bottom level |
|---|
| 347 | CALL icb_utl_getkb( ikb, ze3t, zD ) |
|---|
| 348 | |
|---|
| 349 | ! compute mean velocity |
|---|
| 350 | CALL icb_utl_zavg(zuo, zuoce, ze3t, zD, ikb) |
|---|
| 351 | CALL icb_utl_zavg(zvo, zvoce, ze3t, zD, ikb) |
|---|
| 352 | ELSE |
|---|
| 353 | zuo = zssu |
|---|
| 354 | zvo = zssv |
|---|
| 355 | END IF |
|---|
| 356 | |
|---|
| 357 | zuveln = puvel ; zvveln = pvvel ! Copy starting uvel, vvel |
|---|
| 358 | ! |
|---|
| 359 | DO itloop = 1, 2 ! Iterate on drag coefficients |
|---|
| 360 | ! |
|---|
| 361 | zus = 0.5 * ( zuveln + puvel ) |
|---|
| 362 | zvs = 0.5 * ( zvveln + pvvel ) |
|---|
| 363 | zdrag_ocn = z_ocn * SQRT( (zus-zuo)*(zus-zuo) + (zvs-zvo)*(zvs-zvo) ) |
|---|
| 364 | zdrag_atm = z_atm * SQRT( (zus-zua)*(zus-zua) + (zvs-zva)*(zvs-zva) ) |
|---|
| 365 | zdrag_ice = z_ice * SQRT( (zus-zui)*(zus-zui) + (zvs-zvi)*(zvs-zvi) ) |
|---|
| 366 | ! |
|---|
| 367 | ! Explicit accelerations |
|---|
| 368 | !zaxe= zff*pvvel -grav*zssh_x +zwave_rad*zuwave & |
|---|
| 369 | ! -zdrag_ocn*(puvel-zssu) -zdrag_atm*(puvel-zua) -zdrag_ice*(puvel-zui) |
|---|
| 370 | !zaye=-zff*puvel -grav*zssh_y +zwave_rad*zvwave & |
|---|
| 371 | ! -zdrag_ocn*(pvvel-zssv) -zdrag_atm*(pvvel-zva) -zdrag_ice*(pvvel-zvi) |
|---|
| 372 | zaxe = -grav * zssh_x + zwave_rad * zuwave |
|---|
| 373 | zaye = -grav * zssh_y + zwave_rad * zvwave |
|---|
| 374 | IF( pp_alpha > 0._wp ) THEN ! If implicit, use time-level (n) rather than RK4 latest |
|---|
| 375 | zaxe = zaxe + zff*pvvel0 |
|---|
| 376 | zaye = zaye - zff*puvel0 |
|---|
| 377 | ELSE |
|---|
| 378 | zaxe = zaxe + zff*pvvel |
|---|
| 379 | zaye = zaye - zff*puvel |
|---|
| 380 | ENDIF |
|---|
| 381 | IF( pp_beta > 0._wp ) THEN ! If implicit, use time-level (n) rather than RK4 latest |
|---|
| 382 | zaxe = zaxe - zdrag_ocn*(puvel0-zuo) - zdrag_atm*(puvel0-zua) -zdrag_ice*(puvel0-zui) |
|---|
| 383 | zaye = zaye - zdrag_ocn*(pvvel0-zvo) - zdrag_atm*(pvvel0-zva) -zdrag_ice*(pvvel0-zvi) |
|---|
| 384 | ELSE |
|---|
| 385 | zaxe = zaxe - zdrag_ocn*(puvel -zuo) - zdrag_atm*(puvel -zua) -zdrag_ice*(puvel -zui) |
|---|
| 386 | zaye = zaye - zdrag_ocn*(pvvel -zvo) - zdrag_atm*(pvvel -zva) -zdrag_ice*(pvvel -zvi) |
|---|
| 387 | ENDIF |
|---|
| 388 | |
|---|
| 389 | ! Solve for implicit accelerations |
|---|
| 390 | IF( pp_alpha + pp_beta > 0._wp ) THEN |
|---|
| 391 | zlambda = zdrag_ocn + zdrag_atm + zdrag_ice |
|---|
| 392 | zA11 = 1._wp + pp_beta *pdt*zlambda |
|---|
| 393 | zA12 = pp_alpha*pdt*zff |
|---|
| 394 | zdetA = 1._wp / ( zA11*zA11 + zA12*zA12 ) |
|---|
| 395 | pax = zdetA * ( zA11*zaxe + zA12*zaye ) |
|---|
| 396 | pay = zdetA * ( zA11*zaye - zA12*zaxe ) |
|---|
| 397 | ELSE |
|---|
| 398 | pax = zaxe ; pay = zaye |
|---|
| 399 | ENDIF |
|---|
| 400 | |
|---|
| 401 | zuveln = puvel0 + pdt*pax |
|---|
| 402 | zvveln = pvvel0 + pdt*pay |
|---|
| 403 | ! |
|---|
| 404 | END DO ! itloop |
|---|
| 405 | |
|---|
| 406 | IF( rn_speed_limit > 0._wp ) THEN ! Limit speed of bergs based on a CFL criteria (if asked) |
|---|
| 407 | zspeed = SQRT( zuveln*zuveln + zvveln*zvveln ) ! Speed of berg |
|---|
| 408 | IF( zspeed > 0._wp ) THEN |
|---|
| 409 | zloc_dx = MIN( pe1, pe2 ) ! minimum grid spacing |
|---|
| 410 | zspeed_new = zloc_dx / pdt * rn_speed_limit ! Speed limit as a factor of dx / dt |
|---|
| 411 | IF( zspeed_new < zspeed ) THEN |
|---|
| 412 | zuveln = zuveln * ( zspeed_new / zspeed ) ! Scale velocity to reduce speed |
|---|
| 413 | zvveln = zvveln * ( zspeed_new / zspeed ) ! without changing the direction |
|---|
| 414 | CALL icb_dia_speed() |
|---|
| 415 | ENDIF |
|---|
| 416 | ENDIF |
|---|
| 417 | ENDIF |
|---|
| 418 | ! ! check the speed and acceleration limits |
|---|
| 419 | IF (nn_verbose_level > 0) THEN |
|---|
| 420 | IF( ABS( zuveln ) > pp_vel_lim .OR. ABS( zvveln ) > pp_vel_lim ) & |
|---|
| 421 | WRITE(numicb,'("pe=",i3,x,a)') narea,'Dump triggered by excessive velocity' |
|---|
| 422 | IF( ABS( pax ) > pp_accel_lim .OR. ABS( pay ) > pp_accel_lim ) & |
|---|
| 423 | WRITE(numicb,'("pe=",i3,x,a)') narea,'Dump triggered by excessive acceleration' |
|---|
| 424 | ENDIF |
|---|
| 425 | ! |
|---|
| 426 | END SUBROUTINE icb_accel |
|---|
| 427 | |
|---|
| 428 | !!====================================================================== |
|---|
| 429 | END MODULE icbdyn |
|---|
