Changeset 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/LDF
- Timestamp:
- 2015-12-21T12:35:23+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/LDF
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
r5836 r6140 28 28 29 29 !! * Substitutions 30 # include "domzgr_substitute.h90"31 30 # include "vectopt_loop_substitute.h90" 32 31 !!---------------------------------------------------------------------- … … 72 71 CASE( 'DYN' ) ! T- and F-points 73 72 DO jk = 1, jpk ! pah1 at T-point 74 pah1(:,:,jk) = pahs1(:,:) * ( prat + zc * ( 1._wp + TANH( - ( fsdept(:,:,jk) - zh ) * zw) ) ) * tmask(:,:,jk)73 pah1(:,:,jk) = pahs1(:,:) * ( prat + zc * ( 1._wp + TANH( - ( gdept_n(:,:,jk) - zh ) * zw) ) ) * tmask(:,:,jk) 75 74 END DO 76 75 DO jk = 1, jpk ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 77 76 DO jj = 1, jpjm1 78 77 DO ji = 1, fs_jpim1 79 zdep2 = ( fsdept(ji,jj+1,jk) + fsdept(ji+1,jj+1,jk) &80 & + fsdept(ji,jj ,jk) + fsdept(ji+1,jj ,jk) ) * 0.25_wp78 zdep2 = ( gdept_n(ji,jj+1,jk) + gdept_n(ji+1,jj+1,jk) & 79 & + gdept_n(ji,jj ,jk) + gdept_n(ji+1,jj ,jk) ) * 0.25_wp 81 80 pah2(ji,jj,jk) = pahs2(ji,jj) * ( prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) ) ) * fmask(ji,jj,jk) 82 81 END DO … … 89 88 DO jj = 1, jpjm1 90 89 DO ji = 1, fs_jpim1 91 zdep1 = ( fsdept(ji,jj,jk) + fsdept(ji+1,jj,jk) ) * 0.5_wp92 zdep2 = ( fsdept(ji,jj,jk) + fsdept(ji,jj+1,jk) ) * 0.5_wp90 zdep1 = ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) ) * 0.5_wp 91 zdep2 = ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) ) * 0.5_wp 93 92 pah1(ji,jj,jk) = pahs1(ji,jj) * ( prat + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) ) ) * umask(ji,jj,jk) 94 93 pah2(ji,jj,jk) = pahs2(ji,jj) * ( prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) ) ) * vmask(ji,jj,jk) -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r5836 r6140 52 52 53 53 !! * Substitutions 54 # include "domzgr_substitute.h90"55 54 # include "vectopt_loop_substitute.h90" 56 55 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5836 r6140 73 73 74 74 !! * Substitutions 75 # include "domzgr_substitute.h90"76 75 # include "vectopt_loop_substitute.h90" 77 76 !!---------------------------------------------------------------------- … … 112 111 !! 113 112 INTEGER :: ji , jj , jk ! dummy loop indices 114 INTEGER :: ii0, ii1 , iku! temporary integer115 INTEGER :: ij0, ij1 , ikv! temporary integer113 INTEGER :: ii0, ii1 ! temporary integer 114 INTEGER :: ij0, ij1 ! temporary integer 116 115 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 117 116 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 118 117 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 119 118 REAL(wp) :: zck, zfk, zbw ! - - 119 REAL(wp) :: zdepu, zdepv ! - - 120 REAL(wp), POINTER, DIMENSION(:,: ) :: zslpml_hmlpu, zslpml_hmlpv 120 121 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 121 122 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr … … 126 127 ! 127 128 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 129 CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 128 130 129 131 zeps = 1.e-20_wp !== Local constant initialization ==! … … 149 151 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 150 152 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 153 END DO 154 END DO 155 ENDIF 156 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 157 DO jj = 1, jpjm1 158 DO ji = 1, jpim1 159 IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 160 IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 151 161 END DO 152 162 END DO … … 171 181 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 172 182 ! 183 IF ( ln_isfcav ) THEN 184 DO jj = 2, jpjm1 185 DO ji = fs_2, fs_jpim1 ! vector opt. 186 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) & 187 & - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji+1,jj ) ) ) 188 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) & 189 & - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji ,jj+1) ) ) 190 END DO 191 END DO 192 ELSE 193 DO jj = 2, jpjm1 194 DO ji = fs_2, fs_jpim1 ! vector opt. 195 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 196 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) 197 END DO 198 END DO 199 END IF 200 173 201 DO jk = 2, jpkm1 !* Slopes at u and v points 174 202 DO jj = 2, jpjm1 … … 181 209 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 182 210 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 183 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/ fse3u(ji,jj,jk)* ABS( zau ) )184 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/ fse3v(ji,jj,jk)* ABS( zav ) )211 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau ) ) 212 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav ) ) 185 213 ! ! uslp and vslp output in zwz and zww, resp. 186 214 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 187 215 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 188 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 189 & + zfi * uslpml(ji,jj) & 190 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 191 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 192 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 193 & + zfj * vslpml(ji,jj) & 194 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 195 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 216 ! thickness of water column between surface and level k at u/v point 217 zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj ,jk) ) & 218 - ( risfdep(ji,jj) + risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj)) ) 219 zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) ) & 220 - ( risfdep(ji,jj) + risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj)) ) 221 ! 222 zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps ) & 223 & + zfi * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk) 224 zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps ) & 225 & + zfj * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk) 196 226 !!gm modif to suppress omlmask.... (as in Griffies case) 197 227 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. 198 228 ! zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 199 229 ! zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 200 ! zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )201 ! zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )230 ! zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 231 ! zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 202 232 ! zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 203 233 ! zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) … … 265 295 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 266 296 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 267 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk)297 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * wmask (ji,jj,jk) 268 298 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 269 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk)299 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * wmask (ji,jj,jk) 270 300 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 271 301 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 272 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/ fse3w(ji,jj,jk)* ABS( zai ) )273 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/ fse3w(ji,jj,jk)* ABS( zaj ) )302 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai ) ) 303 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj ) ) 274 304 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 275 305 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 276 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )277 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk)278 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk)306 zck = ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - gdepw_n(ji,jj,mikt(ji,jj)), 10._wp ) 307 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * wmask(ji,jj,jk) 308 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * wmask(ji,jj,jk) 279 309 280 310 !!gm modif to suppress omlmask.... (as in Griffies operator) 281 311 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 282 312 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 283 ! zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. )313 ! zck = gdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 284 314 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 285 315 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) … … 340 370 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 341 371 342 343 372 IF(ln_ctl) THEN 344 373 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) … … 347 376 ! 348 377 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 378 CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 349 379 ! 350 380 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 441 471 zdks = 0._wp 442 472 ENDIF 443 zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)473 zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / e3w_n(ji,jj,jk+kp) 444 474 zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw ) ! force zdzrho >= repsln 445 475 END DO … … 451 481 DO ji = 1, jpi 452 482 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth 453 z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk)483 z1_mlbw(ji,jj) = 1._wp / gdepw_n(ji,jj,jk) 454 484 END DO 455 485 END DO … … 480 510 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 481 511 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 482 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk)483 ze3_e1 = fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)512 & - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk) 513 ze3_e1 = e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 484 514 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1 , ABS( zti_g_raw ) ), zti_g_raw ) 485 515 ENDIF 486 516 ! 487 517 jk = nmln(ji,jj+jp) + 1 488 IF( jk .GT.mbkt(ji,jj+jp) ) THEN !ML reaches bottom518 IF( jk > mbkt(ji,jj+jp) ) THEN !ML reaches bottom 489 519 ztj_mlb(ji ,jj+jp,1-jp,kp) = 0.0_wp 490 520 ELSE 491 521 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 492 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk)493 ze3_e2 = fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj)522 & - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk) 523 ze3_e2 = e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj) 494 524 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2 , ABS( ztj_g_raw ) ), ztj_g_raw ) 495 525 ENDIF … … 523 553 ! 524 554 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 525 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj)526 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) ! unmasked555 zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) 556 ztj_coord = znot_thru_surface * ( gdept_n(ji ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) ! unmasked 527 557 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 528 558 ztj_g_raw = ztj_raw - ztj_coord 529 559 ! additional limit required in bilaplacian case 530 ze3_e1 = fse3w(ji+ip,jj ,jk+kp) * r1_e1u(ji,jj)531 ze3_e2 = fse3w(ji ,jj+jp,jk+kp) * r1_e2v(ji,jj)560 ze3_e1 = e3w_n(ji+ip,jj ,jk+kp) * r1_e1u(ji,jj) 561 ze3_e2 = e3w_n(ji ,jj+jp,jk+kp) * r1_e2v(ji,jj) 532 562 ! NB: hard coded factor 5 (can be a namelist parameter...) 533 563 zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) … … 542 572 zti_g_lim = ( zfacti * zti_g_lim & 543 573 & + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp) & 544 & * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)574 & * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 545 575 ztj_g_lim = ( zfactj * ztj_g_lim & 546 576 & + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp) & 547 & * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)577 & * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 548 578 ! 549 579 triadi_g(ji+ip,jj ,jk,1-ip,kp) = zti_g_lim … … 577 607 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw 578 608 ! 579 zbu = e1e2u(ji ,jj ) * fse3u(ji ,jj ,jk )580 zbv = e1e2v(ji ,jj ) * fse3v(ji ,jj ,jk )581 zbti = e1e2t(ji+ip,jj ) * fse3w(ji+ip,jj ,jk+kp)582 zbtj = e1e2t(ji ,jj+jp) * fse3w(ji ,jj+jp,jk+kp)609 zbu = e1e2u(ji ,jj ) * e3u_n(ji ,jj ,jk ) 610 zbv = e1e2v(ji ,jj ) * e3v_n(ji ,jj ,jk ) 611 zbti = e1e2t(ji+ip,jj ) * e3w_n(ji+ip,jj ,jk+kp) 612 zbtj = e1e2t(ji ,jj+jp) * e3w_n(ji ,jj+jp,jk+kp) 583 613 ! 584 614 wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim ! masked … … 682 712 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 683 713 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 684 zbu = MIN( zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/ fse3u(ji,jj,iku)* ABS( zau ) )685 zbv = MIN( zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/ fse3v(ji,jj,ikv)* ABS( zav ) )714 zbu = MIN( zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau ) ) 715 zbv = MIN( zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav ) ) 686 716 ! !- Slope at u- & v-points (uslpml, vslpml) 687 717 uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) … … 699 729 zcj = MAX( vmask(ji,jj-1,ik ) + vmask(ji,jj,ik ) & 700 730 & + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps ) * e2t(ji,jj) 701 zai = ( p_gru(ji-1,jj,ik ) + p_gru(ji,jj,ik) &731 zai = ( p_gru(ji-1,jj,ik ) + p_gru(ji,jj,ik) & 702 732 & + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1 ) ) / zci * tmask(ji,jj,ik) 703 733 zaj = ( p_grv(ji,jj-1,ik ) + p_grv(ji,jj,ik ) & … … 705 735 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 706 736 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 707 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/ fse3w(ji,jj,ik)* ABS( zai ) )708 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/ fse3w(ji,jj,ik)* ABS( zaj ) )737 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zai ) ) 738 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj ) ) 709 739 ! !- i- & j-slope at w-points (wslpiml, wslpjml) 710 740 wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) … … 767 797 768 798 !!gm I no longer understand this..... 769 !!gm IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. ( lk_vvl.AND. ln_rstart) ) THEN799 !!gm IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN 770 800 ! IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 771 801 ! … … 775 805 ! 776 806 ! ! set the slope of diffusion to the slope of s-surfaces 777 ! ! ( c a u t i o n : minus sign as fsdep has positive value )807 ! ! ( c a u t i o n : minus sign as dep has positive value ) 778 808 ! DO jk = 1, jpk 779 809 ! DO jj = 2, jpjm1 780 810 ! DO ji = fs_2, fs_jpim1 ! vector opt. 781 ! uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)782 ! vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)783 ! wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5784 ! wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5811 ! uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 812 ! vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 813 ! wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 814 ! wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 785 815 ! END DO 786 816 ! END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r5836 r6140 81 81 82 82 !! * Substitutions 83 # include "domzgr_substitute.h90"84 83 # include "vectopt_loop_substitute.h90" 85 84 !!---------------------------------------------------------------------- … … 515 514 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 516 515 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 517 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)516 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 518 517 ! Compute elements required for the inverse time scale of baroclinic 519 518 ! eddies using the isopycnal slopes calculated in ldfslp.F : 520 519 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 521 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)520 ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 522 521 zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 523 522 zhw(ji,jj) = zhw(ji,jj) + ze3w … … 533 532 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 534 533 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 535 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)534 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 536 535 ! Compute elements required for the inverse time scale of baroclinic 537 536 ! eddies using the isopycnal slopes calculated in ldfslp.F : 538 537 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 539 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)538 ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 540 539 zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 541 540 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w … … 711 710 ! 712 711 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 713 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) )712 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 714 713 END DO 715 714 CALL iom_put( "uoce_eiv", zw3d ) 716 715 ! 717 716 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 718 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) )717 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 719 718 END DO 720 719 CALL iom_put( "voce_eiv", zw3d )
Note: See TracChangeset
for help on using the changeset viewer.