- Timestamp:
- 2014-10-09T19:31:07+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4704 r4812 108 108 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 109 109 REAL(wp) :: zck, zfk, zbw ! - - 110 REAL(wp) :: zdepv, zdepu ! - - 110 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 111 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr 112 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgru, zgrv 114 REAL(wp), POINTER, DIMENSION(:,: ) :: zhmlpu, zhmlpv 113 115 !!---------------------------------------------------------------------- 114 116 ! … … 116 118 ! 117 119 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 120 CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv ) 118 121 119 122 IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN … … 153 156 ! 154 157 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 155 DO jk = 2, jpkm1158 DO jk = 1, jpkm1 156 159 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 157 160 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 … … 162 165 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 163 166 END DO 167 ! surface initialisation 168 DO jj = 1, jpjm1 169 DO ji = 1, jpim1 170 zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 171 END DO 172 END DO 164 173 ! 165 174 ! !== Slopes just below the mixed layer ==! … … 170 179 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 171 180 ! 181 DO jj = 2, jpjm1 182 DO ji = fs_2, fs_jpim1 ! vector opt. 183 IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji ,jj) 184 IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji+1,jj) 185 IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj), hmlpt(ji+1,jj)) 186 IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji ,jj) 187 IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji,jj+1) 188 IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji,jj+1)) 189 ENDDO 190 ENDDO 172 191 DO jk = 2, jpkm1 !* Slopes at u and v points 173 192 DO jj = 2, jpjm1 … … 183 202 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 184 203 ! ! uslp and vslp output in zwz and zww, resp. 185 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 186 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 187 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 188 & + zfi * uslpml(ji,jj) & 189 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 190 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 191 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 192 & + zfj * vslpml(ji,jj) & 193 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 194 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 204 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 205 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 206 ! thickness of water column between surface and level k at u/v point 207 zdepu = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji+1,jj ,jk) ) & 208 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ) & 209 - fse3u(ji,jj,miku(ji,jj)) ) 210 zdepv = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji ,jj+1,jk) ) & 211 - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) & 212 - fse3v(ji,jj,mikv(ji,jj)) ) 213 zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps ) & 214 & + zfi * uslpml(ji,jj) & 215 & * zdepu / MAX( zhmlpu(ji,jj), 5._wp ) 216 zwz(ji,jj,jk) = zwz(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj,jk-1) 217 zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps ) & 218 & + zfj * vslpml(ji,jj) & 219 & * zdepv / MAX( zhmlpv(ji,jj), 5._wp ) 220 zww(ji,jj,jk) = zww(ji,jj,jk) * vmask(ji,jj,jk) * vmask(ji,jj,jk-1) 221 222 195 223 !!gm modif to suppress omlmask.... (as in Griffies case) 196 224 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. … … 242 270 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 243 271 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp & 244 & * tmask(ji,jj,jk-1)272 & * umask(ji,jj,jk-1) !* umask(ji,jj,jk) * umask(ji,jj,jk+1) 245 273 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 246 274 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp & 247 & * tmask(ji,jj,jk-1)275 & * vmask(ji,jj,jk-1) !* vmask(ji,jj,jk) * vmask(ji,jj,jk+1) 248 276 END DO 249 277 END DO … … 258 286 DO ji = fs_2, fs_jpim1 ! vector opt. 259 287 ! !* Local vertical density gradient evaluated from N^2 260 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 288 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 261 289 ! !* Slopes at w point 262 290 ! ! i- & j-gradient of density at w-points … … 266 294 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 267 295 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 268 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk)296 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci 269 297 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 270 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk)298 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj 271 299 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 272 300 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) … … 274 302 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) ) 275 303 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 276 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0277 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )278 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 279 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) 304 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 305 zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 306 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 307 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 280 308 281 309 !!gm modif to suppress omlmask.... (as in Griffies operator) … … 330 358 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 331 359 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 332 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) 333 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) 360 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk) 361 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk) 334 362 END DO 335 363 END DO … … 387 415 uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 388 416 vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 389 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5390 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5417 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 418 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 391 419 END DO 392 420 END DO … … 410 438 411 439 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 440 CALL wrk_dealloc( jpi,jpj, zhmlpu, zhmlpv) 412 441 ! 413 442 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 714 743 # endif 715 744 ik = nmln(ji,jj) - 1 716 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp745 IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN ; omlmask(ji,jj,jk) = 1._wp 717 746 ELSE ; omlmask(ji,jj,jk) = 0._wp 718 747 ENDIF … … 742 771 ! 743 772 ! !- vertical density gradient for u- and v-slopes (from dzr at T-point) 744 iku = MIN( MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1)745 ikv = MIN( MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) !773 iku = MIN( MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1) 774 ikv = MIN( MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) ! 746 775 zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj ,iku) ) 747 776 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) )
Note: See TracChangeset
for help on using the changeset viewer.
