- Timestamp:
- 2012-07-11T13:22:58+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r3211 r3432 33 33 PUBLIC dyn_ldf_bilapg ! called by step.F90 34 34 35 !FTRANS zfuw zfvw zdiu zdiv :I :z 35 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zfvw , zdiu, zdiv ! 2D workspace (ldfguv) 37 !FTRANS zdju zdj1u zdjv zdj1v :I :z 36 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdju, zdj1u, zdjv, zdj1v ! 2D workspace (ldfguv) 37 39 … … 113 115 IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate' 114 116 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 115 zwk1(:,:,:) = 0.e0 ; zwk3(:,:,:) = 0.e0116 zwk2(:,:,:) = 0.e0 ; zwk4(:,:,:) = 0.e0117 zwk1(:,:,:) = 0.e0_wp ; zwk3(:,:,:) = 0.e0_wp 118 zwk2(:,:,:) = 0.e0_wp ; zwk4(:,:,:) = 0.e0_wp 117 119 ! ! allocate dyn_ldf_bilapg arrays 118 120 IF( dyn_ldf_bilapg_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays') … … 195 197 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 196 198 USE wrk_nemo, ONLY: ziut => wrk_2d_1 , zjuf => wrk_2d_2 , zjvt => wrk_2d_3 197 USE wrk_nemo, ONLY: zivf => wrk_2d_4 , zdku => wrk_2d_5 , zdk1u => wrk_2d_6 199 USE wrk_nemo, ONLY: zivf => wrk_2d_4 200 #if ! defined key_z_first 201 USE wrk_nemo, ONLY: zdku => wrk_2d_5 , zdk1u => wrk_2d_6 198 202 USE wrk_nemo, ONLY: zdkv => wrk_2d_7 , zdk1v => wrk_2d_8 203 #endif 204 USE timing , ONLY: timing_start, timing_stop 199 205 !! 200 206 !FTRANS pu :I :I :z … … 213 219 ! 214 220 INTEGER :: ji, jj, jk ! dummy loop indices 221 INTEGER :: jif, jjf ! dummy loop indices over full domain 215 222 REAL(wp) :: zabe1 , zabe2 , zcof1 , zcof2 ! local scalar 216 223 REAL(wp) :: zcoef0, zcoef3, zcoef4 ! - - 217 224 REAL(wp) :: zbur, zbvr, zmkt, zmkf, zuav, zvav ! - - 218 225 REAL(wp) :: zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 226 #if defined key_z_first 227 ! Can use scalars instead of work arrays when built with z-first 228 REAL(wp) :: zdku, zdkv, zdk1u, zdk1v 229 #endif 219 230 !!---------------------------------------------------------------------- 231 232 CALL timing_start('ldfguv') 220 233 221 234 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 222 235 CALL ctl_stop('dyn:ldfguv: requested workspace arrays unavailable') ; RETURN 223 236 END IF 237 CALL timing_start('ldfguv_1st') 238 239 #if defined key_z_first 240 ! ! ********** ! ! =============== 241 ! DO jk = 1, jpkm1 ! First step ! ! Horizontal slab 242 ! ! ********** ! ! =============== 243 244 ! I.1 Vertical gradient of pu and pv at level jk and jk+1 245 ! ------------------------------------------------------- 246 ! surface boundary condition: zdku(jk=1)=zdku(jk=2) 247 ! zdkv(jk=1)=zdkv(jk=2) 248 #if 0 249 DO jjf = 1, jpj 250 DO jif = 1, jpi 251 252 !!$ jj= jjf 253 !!$ ji = jif 254 !!$ 255 !!$ zdk1u = ( pu(ji,jj,jk) - pu(ji,jj,jk+1) ) * umask(ji,jj,jk+1) 256 !!$ zdk1v = ( pv(ji,jj,jk) - pv(ji,jj,jk+1) ) * vmask(ji,jj,jk+1) 257 !!$ 258 !!$ IF( jk == 1 ) THEN 259 !!$ zdku = zdk1u 260 !!$ zdkv = zdk1v 261 !!$ ELSE 262 !!$ zdku = ( pu(ji,jj,jk-1) - pu(ji,jj,jk) ) * umask(ji,jj,jk) 263 !!$ zdkv = ( pv(ji,jj,jk-1) - pv(ji,jj,jk) ) * vmask(ji,jj,jk) 264 !!$ ENDIF 265 ! END DO 266 ! END DO 267 ! -----f----- 268 ! I.2 Horizontal fluxes on U | 269 ! ------------------------=== t u t 270 ! | 271 ! i-flux at t-point -----f----- 272 ! DO jj = 1, jpjm1 273 ! DO ji = 2, jpi 274 ! DO jjf = 1, jpj 275 ! DO jif = 1, jpi 276 277 jj = MIN(jjf, jpjm1) 278 ji = MAX(2, jif) 279 280 ! zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 281 282 ! zmkt = 1._wp/MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 283 ! + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1._wp ) 284 285 ! zcof1 = -e2t(ji,jj) / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 286 ! + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1._wp ) & 287 ! * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 288 289 IF( jk == 1 )THEN 290 ziut(ji,jj) = tmask(ji,jj,jk) * & 291 ( (e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 292 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 293 + (-e2t(ji,jj) / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 294 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1._wp ) & 295 * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) ) * & 296 ( ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji,jj,jk+1) + & 297 ( pu(ji-1,jj,jk) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) + & 298 ! +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 299 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji,jj,jk+1) + & 300 ( pu(ji-1,jj,jk) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) & 301 ) ) 302 ELSE 303 ziut(ji,jj) = tmask(ji,jj,jk) * & 304 ( (e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 305 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 306 + (-e2t(ji,jj) / MAX(umask(ji-1,jj,jk)+umask(ji,jj,jk+1) & 307 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk), 1._wp ) & 308 * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) ) * & 309 ( ( pu(ji ,jj,jk-1) - pu(ji ,jj,jk ) ) * umask(ji,jj,jk) + & 310 ( pu(ji-1,jj,jk ) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) + & 311 ! +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 312 ( pu(ji ,jj,jk ) - pu(ji ,jj,jk+1) ) * umask(ji,jj,jk+1) + & 313 ( pu(ji-1,jj,jk-1) - pu(ji-1,jj,jk ) ) * umask(ji-1,jj,jk) & 314 ) ) 315 END IF 316 ! END DO 317 ! END DO 318 319 ! j-flux at f-point 320 ! DO jj = 1, jpjm1 321 ! DO ji = 1, jpim1 322 ! DO jjf = 1, jpj 323 ! DO jif = 1, jpi 324 325 jj = MIN(jjf, jpjm1) 326 ji = MIN(jif, jpim1) 327 328 !zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 329 330 !zmkf = 1./MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & 331 ! + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. ) 332 333 !zcof2 = -e1f(ji,jj) /MAX(umask(ji,jj+1,jk)+umask(ji,jj,jk+1) & 334 ! + umask(ji,jj+1,jk+1)+umask(ji,jj,jk), 1. ) & 335 ! * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 336 337 IF(jk == 1)THEN 338 ! zdku = zdk1u 339 zjuf(ji,jj) = fmask(ji,jj,jk) * & 340 ( (e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) ) * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 341 ! + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 342 + (-e1f(ji,jj) /MAX(umask(ji,jj+1,jk)+umask(ji,jj,jk+1) & 343 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk), 1. ) & 344 * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) ) * & 345 ( & 346 ( pu(ji,jj+1,jk) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) & 347 + ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj ,jk+1) & 348 ! +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 349 + ( pu(ji,jj+1,jk) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) & 350 + ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) & 351 ) ) 352 353 ELSE 354 zjuf(ji,jj) = fmask(ji,jj,jk) * & 355 ( (e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) ) * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 356 ! + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 357 + (-e1f(ji,jj) /MAX(umask(ji,jj+1,jk)+umask(ji,jj,jk+1) & 358 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk), 1. ) & 359 * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) ) * & 360 ( & 361 (pu(ji,jj+1,jk-1) - pu(ji,jj+1,jk ) ) * umask(ji,jj+1,jk) + & 362 (pu(ji,jj ,jk ) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) + & 363 ! +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 364 (pu(ji,jj+1,jk ) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) + & 365 (pu(ji,jj ,jk-1) - pu(ji,jj ,jk ) ) * umask(ji,jj,jk) & 366 ) ) 367 ENDIF 368 ! END DO 369 ! END DO 370 371 ! | t | 372 ! I.3 Horizontal fluxes on V | | 373 ! ------------------------=== f---v---f 374 ! | | 375 ! i-flux at f-point | t | 376 ! DO jj = 1, jpjm1 377 ! DO ji = 1, jpim1 378 ! DO jjf = 1, jpj 379 ! DO jif = 1, jpi 380 381 jj = MIN(jjf, jpjm1) 382 ji = MIN(jif, jpim1) 383 384 ! zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 385 386 ! zmkf = 1./MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 387 ! + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. ) 388 389 ! zcof1 = (-e2f(ji,jj) / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 390 ! + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. )) & 391 ! * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 392 393 IF (jk == 1)THEN 394 ! zdku == zdk1u 395 zivf(ji,jj) = fmask(ji,jj,jk) * & 396 ( (e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)) * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 397 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 398 + ((-e2f(ji,jj) / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 399 + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. )) & 400 * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )) * ( & 401 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 402 ( pu(ji+1,jj,jk) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 403 ! +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 404 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 405 ( pu(ji+1,jj,jk) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) ) ) 406 ELSE 407 zivf(ji,jj) = fmask(ji,jj,jk) * & 408 ( (e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)) * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 409 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 410 + ((-e2f(ji,jj) / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 411 + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. )) & 412 * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )) * ( & 413 ( pu(ji ,jj,jk-1) - pu(ji ,jj,jk ) ) * umask(ji ,jj,jk ) + & 414 ( pu(ji+1,jj,jk ) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 415 ! +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 416 ( pu(ji ,jj,jk ) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 417 ( pu(ji+1,jj,jk-1) - pu(ji+1,jj,jk ) ) * umask(ji+1,jj,jk ) ) ) 418 END IF 419 ! END DO 420 ! END DO 421 422 ! j-flux at t-point 423 ! DO jj = 2, jpj 424 ! DO ji = 1, jpim1 425 ! DO jjf = 1, jpj 426 ! DO jif = 1, jpi 427 428 jj = MAX(2,jjf) 429 ji = MIN(jif, jpim1) 430 431 !zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 432 433 !zmkt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 434 ! + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 435 436 !zcof2 = (-e1t(ji,jj)/MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 437 ! + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) ) & 438 ! * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 439 440 IF( jk == 1 )THEN 441 zjvt(ji,jj) = tmask(ji,jj,jk) * & 442 ( (e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 443 ! + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 444 + ((-e1t(ji,jj)/MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 445 + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) ) & 446 * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )) * ( & 447 ( pu(ji,jj-1,jk) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 448 ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) + & 449 ! +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 450 ( pu(ji,jj-1,jk) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 451 ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) ) ) 452 ELSE 453 zjvt(ji,jj) = tmask(ji,jj,jk) * & 454 ( (e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 455 ! + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 456 + ((-e1t(ji,jj)/MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 457 + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) ) & 458 * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )) * & 459 ( & 460 ( pu(ji,jj-1,jk-1) - pu(ji,jj-1,jk ) ) * umask(ji,jj-1,jk) + & 461 ( pu(ji,jj ,jk ) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) + & 462 ! +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 463 ( pu(ji,jj-1,jk ) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 464 ( pu(ji,jj ,jk-1) - pu(ji,jj ,jk ) ) * umask(ji,jj,jk) ) ) 465 END IF 466 END DO 467 END DO 468 #endif 469 470 ! I.4 Second derivative (divergence) (not divided by the volume) 471 ! --------------------- 472 473 474 DO jj = 2, jpjm1 475 DO ji = 2, jpim1 476 477 ! Treat jk = 1 separately as is special case 478 jk = 1 479 480 plu(ji,jj,jk) = & 481 ! ------------- ziut (ji+1, jj) - 482 tmask(ji+1,jj,jk) * & 483 ( (e2t(ji+1,jj) * fse3t(ji+1,jj,jk) / e1t(ji+1,jj)) * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 484 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 485 + (-e2t(ji+1,jj) / MAX( umask(ji,jj,jk )+umask(ji+1,jj,jk+1) & 486 + umask(ji,jj,jk+1)+umask(ji+1,jj,jk ), 1._wp ) & 487 * 0.5 * ( uslp(ji,jj,jk) + uslp(ji+1,jj,jk) ) ) * & 488 ( ( pu(ji+1,jj,jk) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 489 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 490 ! +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 491 ( pu(ji+1,jj,jk) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 492 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) & 493 ) ) - & 494 ! ------------- ziut (ji,jj ) + 495 tmask(ji,jj,jk) * & 496 ( (e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 497 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 498 + (-e2t(ji,jj) / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 499 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1._wp ) & 500 * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) ) * & 501 ( ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji,jj,jk+1) + & 502 ( pu(ji-1,jj,jk) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) + & 503 ! +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 504 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji,jj,jk+1) + & 505 ( pu(ji-1,jj,jk) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) & 506 ) ) + & 507 ! ------------- zjuf (ji ,jj) - 508 fmask(ji,jj,jk) * & 509 ( (e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) ) * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 510 ! + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 511 + (-e1f(ji,jj) /MAX(umask(ji,jj+1,jk)+umask(ji,jj,jk+1) & 512 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk), 1. ) & 513 * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) ) * & 514 ( & 515 ( pu(ji,jj+1,jk) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) & 516 + ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj ,jk+1) & 517 ! +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 518 + ( pu(ji,jj+1,jk) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) & 519 + ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) & 520 ) ) - & 521 ! ------------- zjuf (ji,jj-1) 522 fmask(ji,jj-1,jk) * & 523 ( (e1f(ji,jj-1) * fse3f(ji,jj-1,jk) / e2f(ji,jj-1) ) * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 524 ! + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 525 + (-e1f(ji,jj-1) /MAX(umask(ji,jj,jk)+umask(ji,jj-1,jk+1) & 526 + umask(ji,jj,jk+1)+umask(ji,jj-1,jk), 1. ) & 527 * 0.5 * ( vslp(ji+1,jj-1,jk) + vslp(ji,jj-1,jk) ) ) * & 528 ( & 529 ( pu(ji,jj,jk) - pu(ji,jj,jk+1) ) * umask(ji,jj,jk+1) & 530 + ( pu(ji,jj-1 ,jk) - pu(ji,jj-1 ,jk+1) ) * umask(ji,jj-1 ,jk+1) & 531 ! +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 532 + ( pu(ji,jj,jk) - pu(ji,jj,jk+1) ) * umask(ji,jj,jk+1) & 533 + ( pu(ji,jj-1 ,jk) - pu(ji,jj-1 ,jk+1) ) * umask(ji,jj-1,jk+1) & 534 ) ) 535 536 537 plv(ji,jj,jk) = & 538 ! ------------- zivf (ji,jj ) - 539 fmask(ji,jj,jk) * & 540 ( (e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)) * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 541 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 542 + ((-e2f(ji,jj) / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 543 + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. )) & 544 * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )) * ( & 545 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 546 ( pu(ji+1,jj,jk) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 547 ! +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 548 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 549 ( pu(ji+1,jj,jk) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) & 550 ) ) - & 551 ! ------------- zivf (ji-1,jj) + 552 fmask(ji-1,jj,jk) * & 553 ( (e2f(ji-1,jj) * fse3f(ji-1,jj,jk) / e1f(ji-1,jj)) * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 554 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 555 + ((-e2f(ji-1,jj) / MAX( vmask(ji,jj,jk )+vmask(ji-1,jj,jk+1) & 556 + vmask(ji,jj,jk+1)+vmask(ji-1,jj,jk ), 1. )) & 557 * 0.5 * ( uslp(ji-1,jj+1,jk) + uslp(ji-1,jj,jk) )) * ( & 558 ( pu(ji-1,jj,jk) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) + & 559 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 560 ! +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 561 ( pu(ji-1,jj,jk) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) + & 562 ( pu(ji ,jj,jk) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) & 563 ) ) + & 564 ! ------------- zjvt (ji,jj+1) - 565 tmask(ji,jj+1,jk) * & 566 ( (e1t(ji,jj+1) * fse3t(ji,jj+1,jk) / e2t(ji,jj+1)) * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 567 ! + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 568 + ((-e1t(ji,jj+1)/MAX( vmask(ji,jj,jk )+vmask(ji,jj+1,jk+1) & 569 + vmask(ji,jj,jk+1)+vmask(ji,jj+1,jk ), 1. ) ) & 570 * 0.5 * ( vslp(ji,jj,jk) + vslp(ji,jj+1,jk) )) * ( & 571 ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj ,jk+1) + & 572 ( pu(ji,jj+1,jk) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) + & 573 ! +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 574 ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj ,jk+1) + & 575 ( pu(ji,jj+1,jk) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) & 576 ) ) - & 577 ! ------------- zjvt (ji,jj ) 578 tmask(ji,jj,jk) * & 579 ( (e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 580 ! + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 581 + ((-e1t(ji,jj)/MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 582 + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) ) & 583 * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )) * ( & 584 ( pu(ji,jj-1,jk) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 585 ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) + & 586 ! +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 587 ( pu(ji,jj-1,jk) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 588 ( pu(ji,jj ,jk) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) & 589 ) ) 590 591 592 DO jk = 2, jpkm1 593 594 ! plu(ji,jj,jk) = ziut (ji+1,jj) - & 595 ! ziut (ji,jj ) + & 596 ! zjuf (ji ,jj) - & 597 ! zjuf (ji,jj-1) 598 plu(ji,jj,jk) = & 599 ! ------------- ziut (ji+1, jj ) - 600 tmask(ji+1,jj,jk) * & 601 ( (e2t(ji+1,jj) * fse3t(ji+1,jj,jk) / e1t(ji+1,jj)) * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 602 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 603 + (-e2t(ji+1,jj) / MAX(umask(ji,jj,jk)+umask(ji+1,jj,jk+1) & 604 + umask(ji,jj,jk+1)+umask(ji+1,jj,jk), 1._wp ) & 605 * 0.5 * ( uslp(ji,jj,jk) + uslp(ji+1,jj,jk) ) ) * & 606 ( ( pu(ji+1,jj,jk-1) - pu(ji+1,jj,jk ) ) * umask(ji+1,jj,jk) + & 607 ( pu(ji ,jj,jk ) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 608 ! +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 609 ( pu(ji+1,jj,jk ) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 610 ( pu(ji ,jj,jk-1) - pu(ji ,jj,jk ) ) * umask(ji ,jj,jk) & 611 ) ) - & 612 ! ------------- ziut (ji , jj ) + 613 tmask(ji,jj,jk) * & 614 ( (e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 615 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 616 + (-e2t(ji,jj) / MAX(umask(ji-1,jj,jk)+umask(ji,jj,jk+1) & 617 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk), 1._wp ) & 618 * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) ) * & 619 ( ( pu(ji ,jj,jk-1) - pu(ji ,jj,jk ) ) * umask(ji,jj,jk) + & 620 ( pu(ji-1,jj,jk ) - pu(ji-1,jj,jk+1) ) * umask(ji-1,jj,jk+1) + & 621 ! +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 622 ( pu(ji ,jj,jk ) - pu(ji ,jj,jk+1) ) * umask(ji,jj,jk+1) + & 623 ( pu(ji-1,jj,jk-1) - pu(ji-1,jj,jk ) ) * umask(ji-1,jj,jk) & 624 ) ) + & 625 ! ------------- zjuf (ji , jj ) - 626 fmask(ji,jj,jk) * & 627 ( (e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) ) * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 628 ! + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 629 + (-e1f(ji,jj) /MAX(umask(ji,jj+1,jk)+umask(ji,jj,jk+1) & 630 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk), 1. ) & 631 * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) ) * & 632 ( & 633 (pu(ji,jj+1,jk-1) - pu(ji,jj+1,jk ) ) * umask(ji,jj+1,jk) + & 634 (pu(ji,jj ,jk ) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) + & 635 ! +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 636 (pu(ji,jj+1,jk ) - pu(ji,jj+1,jk+1) ) * umask(ji,jj+1,jk+1) + & 637 (pu(ji,jj ,jk-1) - pu(ji,jj ,jk ) ) * umask(ji,jj,jk) & 638 ) ) - & 639 ! ------------- zjuf (ji , jj-1) 640 fmask(ji,jj-1,jk) * & 641 ( (e1f(ji,jj-1) * fse3f(ji,jj-1,jk) / e2f(ji,jj-1) ) * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 642 ! + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 643 + (-e1f(ji,jj-1) /MAX(umask(ji,jj,jk)+umask(ji,jj-1,jk+1) & 644 + umask(ji,jj,jk+1)+umask(ji,jj-1,jk), 1. ) & 645 * 0.5 * ( vslp(ji+1,jj-1,jk) + vslp(ji,jj-1,jk) ) ) * & 646 ( & 647 (pu(ji,jj,jk-1) - pu(ji,jj,jk ) ) * umask(ji,jj,jk) + & 648 (pu(ji,jj-1,jk ) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 649 ! +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 650 (pu(ji,jj,jk ) - pu(ji,jj,jk+1) ) * umask(ji,jj,jk+1) + & 651 (pu(ji,jj-1,jk-1) - pu(ji,jj-1 ,jk ) ) * umask(ji,jj-1,jk) & 652 ) ) 653 654 655 ! plv(ji,jj,jk) = zivf (ji,jj ) - & 656 ! zivf (ji-1,jj) + & 657 ! zjvt (ji,jj+1) - & 658 ! zjvt (ji,jj ) 659 plv(ji,jj,jk) = & 660 ! ------------- zivf (ji,jj ) - 661 fmask(ji,jj,jk) * & 662 ( (e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)) * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 663 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 664 + ((-e2f(ji,jj) / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 665 + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. )) & 666 * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )) * ( & 667 ( pu(ji ,jj,jk-1) - pu(ji ,jj,jk ) ) * umask(ji ,jj,jk ) + & 668 ( pu(ji+1,jj,jk ) - pu(ji+1,jj,jk+1) ) * umask(ji+1,jj,jk+1) + & 669 ! +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 670 ( pu(ji ,jj,jk ) - pu(ji ,jj,jk+1) ) * umask(ji ,jj,jk+1) + & 671 ( pu(ji+1,jj,jk-1) - pu(ji+1,jj,jk ) ) * umask(ji+1,jj,jk ) & 672 ) ) - & 673 ! ------------- zivf (ji-1,jj) + 674 fmask(ji-1,jj,jk) * & 675 ( (e2f(ji-1,jj) * fse3f(ji-1,jj,jk) / e1f(ji-1,jj)) * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 676 ! + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 677 + ((-e2f(ji-1,jj) / MAX( vmask(ji,jj,jk )+vmask(ji-1,jj,jk+1) & 678 + vmask(ji,jj,jk+1)+vmask(ji-1,jj,jk ), 1. )) & 679 * 0.5 * ( uslp(ji-1,jj+1,jk) + uslp(ji-1,jj,jk) )) * ( & 680 ( pu(ji-1 ,jj,jk-1) - pu(ji-1 ,jj,jk ) ) * umask(ji-1 ,jj,jk ) + & 681 ( pu(ji,jj,jk ) - pu(ji,jj,jk+1) ) * umask(ji,jj,jk+1) + & 682 ! +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 683 ( pu(ji-1 ,jj,jk ) - pu(ji-1 ,jj,jk+1) ) * umask(ji-1 ,jj,jk+1) + & 684 ( pu(ji,jj,jk-1) - pu(ji,jj,jk ) ) * umask(ji,jj,jk ) & 685 ) ) + & 686 ! ------------- zjvt (ji,jj+1) - 687 tmask(ji,jj+1,jk) * & 688 ( (e1t(ji,jj+1) * fse3t(ji,jj+1,jk) / e2t(ji,jj+1)) * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 689 ! + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 690 + ((-e1t(ji,jj+1)/MAX( vmask(ji,jj,jk )+vmask(ji,jj+1,jk+1) & 691 + vmask(ji,jj,jk+1)+vmask(ji,jj+1,jk ), 1. ) ) & 692 * 0.5 * ( vslp(ji,jj,jk) + vslp(ji,jj+1,jk) )) * & 693 ( & 694 ( pu(ji,jj,jk-1) - pu(ji,jj,jk ) ) * umask(ji,jj,jk) + & 695 ( pu(ji,jj+1 ,jk ) - pu(ji,jj+1 ,jk+1) ) * umask(ji,jj+1,jk+1) + & 696 ! +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 697 ( pu(ji,jj,jk ) - pu(ji,jj,jk+1) ) * umask(ji,jj,jk+1) + & 698 ( pu(ji,jj+1 ,jk-1) - pu(ji,jj+1 ,jk ) ) * umask(ji,jj+1,jk) & 699 ) ) - & 700 ! ------------- zjvt (ji,jj ) 701 tmask(ji,jj,jk) * & 702 ( (e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)) * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 703 ! + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 704 + ((-e1t(ji,jj)/MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 705 + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) ) & 706 * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )) * & 707 ( & 708 ( pu(ji,jj-1,jk-1) - pu(ji,jj-1,jk ) ) * umask(ji,jj-1,jk) + & 709 ( pu(ji,jj ,jk ) - pu(ji,jj ,jk+1) ) * umask(ji,jj,jk+1) + & 710 ! +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 711 ( pu(ji,jj-1,jk ) - pu(ji,jj-1,jk+1) ) * umask(ji,jj-1,jk+1) + & 712 ( pu(ji,jj ,jk-1) - pu(ji,jj ,jk ) ) * umask(ji,jj,jk) ) ) 713 714 END DO 715 END DO 716 717 ! ! =============== 718 END DO ! End of slab 719 ! ! =============== 720 #else 224 721 ! ! ********** ! ! =============== 225 722 DO jk = 1, jpkm1 ! First step ! ! Horizontal slab … … 338 835 END DO ! End of slab 339 836 ! ! =============== 837 #endif 838 CALL timing_stop('ldfguv_1st','section') 340 839 341 840 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 342 841 842 CALL timing_start('ldfguv_2nd') 343 843 ! ! ************ ! ! =============== 344 844 DO jj = 2, jpjm1 ! Second step ! ! Horizontal slab … … 348 848 ! --------------------------------- 349 849 850 #if defined key_z_first 851 DO ji = 2, jpi 852 DO jk = 1, jpk 853 ! i-gradient of u at jj 854 zdiu (ji,jk) = tmask(ji,jj ,jk) * ( pu(ji,jj ,jk) - pu(ji-1,jj ,jk) ) 855 ! j-gradient of u and v at jj 856 zdju (ji,jk) = fmask(ji,jj ,jk) * ( pu(ji,jj+1,jk) - pu(ji ,jj ,jk) ) 857 zdjv (ji,jk) = tmask(ji,jj ,jk) * ( pv(ji,jj ,jk) - pv(ji ,jj-1,jk) ) 858 ! j-gradient of u and v at jj+1 859 zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj ,jk) - pu(ji ,jj-1,jk) ) 860 zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji ,jj ,jk) ) 861 END DO 862 END DO 863 DO ji = 1, jpim1 864 DO jk = 1, jpk 865 ! i-gradient of v at jj 866 zdiv (ji,jk) = fmask(ji,jj ,jk) * ( pv(ji+1,jj,jk) - pv(ji ,jj ,jk) ) 867 END DO 868 END DO 869 #else 350 870 DO jk = 1, jpk 351 871 DO ji = 2, jpi … … 366 886 END DO 367 887 END DO 368 888 #endif 369 889 370 890 ! II.2 Vertical fluxes … … 380 900 ! interior (2=<jk=<jpk-1) on pu field 381 901 902 #if defined key_z_first 903 DO ji = 2, jpim1 904 DO jk = 2, jpkm1 905 #else 382 906 DO jk = 2, jpkm1 383 907 DO ji = 2, jpim1 908 #endif 384 909 ! i- and j-slopes at uw-point 385 910 zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) … … 408 933 ! interior (2=<jk=<jpk-1) on pv field 409 934 935 #if defined key_z_first 936 DO ji = 2, jpim1 937 DO jk = 2, jpkm1 938 #else 410 939 DO jk = 2, jpkm1 411 940 DO ji = 2, jpim1 941 #endif 412 942 ! i- and j-slopes at vw-point 413 943 zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) … … 440 970 IF( kahm == 1 ) THEN 441 971 ! multiply the laplacian by the eddy viscosity coefficient 972 #if defined key_z_first 973 DO ji = 2, jpim1 974 DO jk = 1, jpkm1 975 #else 442 976 DO jk = 1, jpkm1 443 977 DO ji = 2, jpim1 978 #endif 444 979 ! eddy coef. divided by the volume element 445 980 zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) … … 455 990 ELSEIF( kahm == 2 ) THEN 456 991 ! second call, no multiplication 992 #if defined key_z_first 993 DO ji = 2, jpim1 994 DO jk = 1, jpkm1 995 #else 457 996 DO jk = 1, jpkm1 458 997 DO ji = 2, jpim1 998 #endif 459 999 ! inverse of the volume element 460 1000 zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) … … 476 1016 END DO ! End of slab 477 1017 ! ! =============== 1018 CALL timing_stop('ldfguv_2nd','section') 478 1019 479 1020 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('dyn:ldfguv: failed to release workspace arrays') 480 1021 ! 1022 CALL timing_stop('ldfguv','section') 1023 481 1024 END SUBROUTINE ldfguv 482 1025
Note: See TracChangeset
for help on using the changeset viewer.
