- Timestamp:
- 2020-08-03T15:48:40+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/ICB/icbdyn.F90
r13359 r13374 98 98 zyj2 = zyj1 + zdt_2 * zv1 ; zvvel2 = zvvel1 + zdt_2 * zay1 99 99 ! 100 CALL icb_ground( zxi2, zxi1, zu1, &101 & zyj2, zyj1, zv1, ll_bounced )100 CALL icb_ground( berg, zxi2, zxi1, zu1, & 101 & zyj2, zyj1, zv1, ll_bounced ) 102 102 103 103 ! !** A2 = A(X2,V2) … … 114 114 zyj3 = zyj1 + zdt_2 * zv2 ; zvvel3 = zvvel1 + zdt_2 * zay2 115 115 ! 116 CALL icb_ground( zxi3, zxi1, zu3, &117 & zyj3, zyj1, zv3, ll_bounced )116 CALL icb_ground( berg, zxi3, zxi1, zu3, & 117 & zyj3, zyj1, zv3, ll_bounced ) 118 118 119 119 ! !** A3 = A(X3,V3) … … 130 130 zyj4 = zyj1 + zdt * zv3 ; zvvel4 = zvvel1 + zdt * zay3 131 131 132 CALL icb_ground( zxi4, zxi1, zu4, &133 & zyj4, zyj1, zv4, ll_bounced )132 CALL icb_ground( berg, zxi4, zxi1, zu4, & 133 & zyj4, zyj1, zv4, ll_bounced ) 134 134 135 135 ! !** A4 = A(X4,V4) … … 149 149 zvvel_n = pt%vvel + zdt_6 * ( zay1 + 2.*(zay2 + zay3) + zay4 ) 150 150 151 CALL icb_ground( zxi_n, zxi1, zuvel_n, &152 & zyj_n, zyj1, zvvel_n, ll_bounced )151 CALL icb_ground( berg, zxi_n, zxi1, zuvel_n, & 152 & zyj_n, zyj1, zvvel_n, ll_bounced ) 153 153 154 154 pt%uvel = zuvel_n !** save in berg structure … … 164 164 165 165 166 SUBROUTINE icb_ground( pi, pi0, pu, &167 & pj, pj0, pv, ld_bounced )166 SUBROUTINE icb_ground( berg, pi, pi0, pu, & 167 & pj, pj0, pv, ld_bounced ) 168 168 !!---------------------------------------------------------------------- 169 169 !! *** ROUTINE icb_ground *** … … 174 174 !! NB two possibilities available one of which is hard-coded here 175 175 !!---------------------------------------------------------------------- 176 TYPE(iceberg ), POINTER, INTENT(in ) :: berg ! berg 177 ! 176 178 REAL(wp), INTENT(inout) :: pi , pj ! current iceberg position 177 179 REAL(wp), INTENT(in ) :: pi0, pj0 ! previous iceberg position … … 181 183 INTEGER :: ii, ii0 182 184 INTEGER :: ij, ij0 185 INTEGER :: ikb 183 186 INTEGER :: ibounce_method 187 ! 188 REAL(wp) :: zD 189 REAL(wp), DIMENSION(jpk) :: ze3t 184 190 !!---------------------------------------------------------------------- 185 191 ! … … 198 204 ! 199 205 ! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0 200 !IF ( ln_icb_ground ) THEN 201 ! ! interpol needed data 202 ! CALL icb_utl_interp( pxi, pyj, pe3t=ze3t ) ! 3d velocities 203 ! 204 ! !compute bottom level 205 ! CALL icb_utl_getkb( ikb, ze3t, zD ) 206 ! 207 ! IF( tmask(ii,ij,ikb) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one 208 !ELSE 209 IF( tmask(ii,ij,1) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one 210 !END IF 206 IF ( ln_M2016 .AND. ln_icb_grd ) THEN 207 ! 208 ! draught (keel depth) 209 zD = rho_berg_1_oce * berg%current_point%thickness 210 ! 211 ! interpol needed data 212 CALL icb_utl_interp( pi, pj, pe3t=ze3t ) 213 ! 214 !compute bottom level 215 CALL icb_utl_getkb( ikb, ze3t, zD ) 216 ! 217 ! berg reach a new t-cell, but an ocean one 218 IF( tmask(ii,ij,ikb) /= 0._wp .AND. tmask(ii,ij,1) /= 0._wp ) RETURN 219 ! 220 ELSE 221 IF( tmask(ii,ij,1) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one 222 END IF 211 223 ! 212 224 ! From here, berg have reach land: treat grounding/bouncing
Note: See TracChangeset
for help on using the changeset viewer.