Changeset 5901 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Timestamp:
- 2015-11-20T09:39:06+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5620 r5901 12 12 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 13 13 !!--------------------------------------------------------------------- 14 #if defined key_dynspg_ts || defined key_esopa14 #if defined key_dynspg_ts 15 15 !!---------------------------------------------------------------------- 16 16 !! 'key_dynspg_ts' split explicit free surface … … 98 98 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 99 99 100 IF( ln_dynvor_een .or. ln_dynvor_een_old) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &101 &ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )100 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 101 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 102 102 103 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) … … 107 107 ! 108 108 END FUNCTION dyn_spg_ts_alloc 109 109 110 110 111 SUBROUTINE dyn_spg_ts( kt ) … … 219 220 ! 220 221 IF ( kt == nit000 .OR. lk_vvl ) THEN 221 IF ( ln_dynvor_een_old ) THEN 222 DO jj = 1, jpjm1 223 DO ji = 1, jpim1 224 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 225 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 226 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 227 END DO 228 END DO 222 IF ( ln_dynvor_een ) THEN !== EEN scheme ==! 223 SELECT CASE( nn_een_e3f ) !* ff/e3 at F-point 224 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 225 DO jj = 1, jpjm1 226 DO ji = 1, jpim1 227 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 228 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 229 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 230 END DO 231 END DO 232 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 233 DO jj = 1, jpjm1 234 DO ji = 1, jpim1 235 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 236 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 237 & / ( MAX( 1._wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 238 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 239 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 240 END DO 241 END DO 242 END SELECT 229 243 CALL lbc_lnk( zwz, 'F', 1._wp ) 230 zwz(:,:) = ff(:,:) * zwz(:,:) 231 244 ! 232 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 233 246 DO jj = 2, jpj 234 DO ji = fs_2, jpi ! vector opt.247 DO ji = 2, jpi 235 248 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 236 249 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 239 252 END DO 240 253 END DO 241 ELSE IF ( ln_dynvor_een ) THEN 242 DO jj = 1, jpjm1 243 DO ji = 1, jpim1 244 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 245 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 246 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 247 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 248 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 249 END DO 250 END DO 251 CALL lbc_lnk( zwz, 'F', 1._wp ) 252 zwz(:,:) = ff(:,:) * zwz(:,:) 253 254 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 255 DO jj = 2, jpj 256 DO ji = fs_2, jpi ! vector opt. 257 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 258 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) 259 ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) 260 ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 261 END DO 262 END DO 263 ELSE 254 ! 255 ELSE !== all other schemes (ENE, ENS, MIX) 264 256 zwz(:,:) = 0._wp 265 zhf(:,:) = 0. 257 zhf(:,:) = 0._wp 266 258 IF ( .not. ln_sco ) THEN 259 260 !!gm agree the JC comment : this should be done in a much clear way 261 267 262 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 268 263 ! Set it to zero for the time being … … 276 271 277 272 DO jj = 1, jpjm1 278 zhf(:,jj) = zhf(:,jj) *(1._wp- umask(:,jj,1) * umask(:,jj+1,1))273 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 279 274 END DO 280 275 … … 297 292 ! If forward start at previous time step, and centered integration, 298 293 ! then update averaging weights: 299 IF ( (.NOT.ln_bt_fw).AND.((neuler==0).AND.(kt==nit000+1))) THEN294 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 300 295 ll_fw_start=.FALSE. 301 296 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) … … 338 333 DO jj = 2, jpjm1 339 334 DO ji = fs_2, fs_jpim1 ! vector opt. 340 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)341 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)342 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) /e2v(ji,jj)343 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) /e2v(ji,jj)335 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 336 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 337 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 338 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 344 339 ! energy conserving formulation for planetary vorticity term 345 340 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) … … 352 347 DO ji = fs_2, fs_jpim1 ! vector opt. 353 348 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 354 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)349 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 355 350 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 356 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)351 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 357 352 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 358 353 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 360 355 END DO 361 356 ! 362 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN ! enstrophy and energy conserving scheme357 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 363 358 DO jj = 2, jpjm1 364 359 DO ji = fs_2, fs_jpim1 ! vector opt. 365 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &366 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &367 & + ftse(ji,jj ) * zwy(ji ,jj-1) &368 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )369 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &370 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &371 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &372 & + ftne(ji,jj ) * zwx(ji ,jj ) )360 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 361 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 362 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 363 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 364 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 365 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 366 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 367 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 373 368 END DO 374 369 END DO … … 381 376 DO jj = 2, jpjm1 382 377 DO ji = fs_2, fs_jpim1 ! vector opt. 383 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) /e1u(ji,jj)384 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) /e2v(ji,jj)378 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 379 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 385 380 END DO 386 381 END DO … … 431 426 DO jj = 2, jpjm1 432 427 DO ji = fs_2, fs_jpim1 ! vector opt. 433 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) /e1u(ji,jj)434 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)428 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 429 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 435 430 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 436 431 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 441 436 DO ji = fs_2, fs_jpim1 ! vector opt. 442 437 zu_spg = grav * z1_2 * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 443 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) /e1u(ji,jj)438 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 444 439 zv_spg = grav * z1_2 * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) & 445 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)440 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 446 441 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 447 442 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 454 449 ! ! Surface net water flux and rivers 455 450 IF (ln_bt_fw) THEN 456 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf *fwfisf(:,:) )451 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 457 452 ELSE 458 453 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 459 & + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) ))454 & + fwfisf(:,:) + fwfisf_b(:,:) ) 460 455 ENDIF 461 456 #if defined key_asminc … … 465 460 ENDIF 466 461 #endif 467 ! !* Fill boundary data arrays withAGRIF468 ! ! ------------------------------------ -462 ! !* Fill boundary data arrays for AGRIF 463 ! ! ------------------------------------ 469 464 #if defined key_agrif 470 465 IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) … … 549 544 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 550 545 DO ji = 2, fs_jpim1 ! Vector opt. 551 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &552 & * ( e1 2t(ji ,jj) * zsshp2_e(ji ,jj) &553 & + e1 2t(ji+1,jj) * zsshp2_e(ji+1,jj) )554 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &555 & * ( e1 2t(ji,jj ) * zsshp2_e(ji,jj ) &556 & + e1 2t(ji,jj+1) * zsshp2_e(ji,jj+1) )546 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 547 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 548 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 549 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 550 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 551 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 557 552 END DO 558 553 END DO … … 602 597 ! Sum over sub-time-steps to compute advective velocities 603 598 za2 = wgtbtp2(jn) 604 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) / e2u(:,:)605 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) / e1v(:,:)599 zu_sum(:,:) = zu_sum(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 600 zv_sum(:,:) = zv_sum(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 606 601 ! 607 602 ! Set next sea level: … … 609 604 DO ji = fs_2, fs_jpim1 ! vector opt. 610 605 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 611 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1 2t(ji,jj)606 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1e2t(ji,jj) 612 607 END DO 613 608 END DO … … 627 622 DO jj = 2, jpjm1 628 623 DO ji = 2, jpim1 ! NO Vector Opt. 629 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &630 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &631 & + e1 2t(ji+1,jj ) * ssha_e(ji+1,jj ) )632 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &633 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &634 & + e1 2t(ji ,jj+1) * ssha_e(ji ,jj+1) )624 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 625 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 626 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 627 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 628 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 629 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 635 630 END DO 636 631 END DO … … 666 661 DO jj = 2, jpjm1 667 662 DO ji = 2, jpim1 668 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1 2u(ji ,jj) &669 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj) &670 & + e1 2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) )671 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1 2v(ji ,jj ) &672 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj ) &673 & + e1 2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) )663 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1e2u(ji ,jj) & 664 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 665 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 666 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1e2v(ji ,jj ) & 667 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 668 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 674 669 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 675 670 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 688 683 DO jj = 2, jpjm1 689 684 DO ji = fs_2, fs_jpim1 ! vector opt. 690 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)691 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)692 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) /e2v(ji,jj)693 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)685 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 686 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 687 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 688 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 694 689 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 695 690 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) … … 701 696 DO ji = fs_2, fs_jpim1 ! vector opt. 702 697 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 703 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)698 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 704 699 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 705 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)700 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 706 701 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 707 702 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 709 704 END DO 710 705 ! 711 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN !== energy and enstrophy conserving scheme ==!706 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 712 707 DO jj = 2, jpjm1 713 708 DO ji = fs_2, fs_jpim1 ! vector opt. 714 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &715 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &716 & + ftse(ji,jj ) * zwy(ji ,jj-1) &717 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )718 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &719 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &720 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &721 & + ftne(ji,jj ) * zwx(ji ,jj ) )709 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 710 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 711 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 712 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 713 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 714 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 715 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 716 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 722 717 END DO 723 718 END DO … … 729 724 DO jj = 2, jpjm1 730 725 DO ji = fs_2, fs_jpim1 ! vector opt. 731 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)732 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)726 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 727 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 733 728 zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 734 729 zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg … … 745 740 DO ji = fs_2, fs_jpim1 ! vector opt. 746 741 ! Add surface pressure gradient 747 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) /e1u(ji,jj)748 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) /e2v(ji,jj)742 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 743 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 749 744 zwx(ji,jj) = zu_spg 750 745 zwy(ji,jj) = zv_spg … … 850 845 DO jj = 1, jpjm1 851 846 DO ji = 1, jpim1 ! NO Vector Opt. 852 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &853 & * ( e1 2t(ji ,jj) * ssha(ji ,jj) &854 & + e1 2t(ji+1,jj) * ssha(ji+1,jj) )855 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &856 & * ( e1 2t(ji,jj ) * ssha(ji,jj ) &857 & + e1 2t(ji,jj+1) * ssha(ji,jj+1) )847 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 848 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 849 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 850 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 851 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 852 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 858 853 END DO 859 854 END DO … … 900 895 #if defined key_agrif 901 896 ! Save time integrated fluxes during child grid integration 902 ! (used to update coarse grid transports) 903 ! Useless with 2nd order momentum schemes 897 ! (used to update coarse grid transports at next time step) 904 898 ! 905 899 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN … … 1094 1088 DO jj = 1, jpj 1095 1089 DO ji =1, jpi 1096 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))1097 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))1098 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) )1090 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1091 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 1092 zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 1099 1093 END DO 1100 1094 END DO … … 1102 1096 DO jj = 1, jpj 1103 1097 DO ji =1, jpi 1104 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))1105 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))1106 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) )1107 END DO 1108 END DO 1109 ENDIF 1110 1111 zcmax = MAXVAL( zcu(:,:))1098 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1099 zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1100 zcu(ji,jj) = SQRT( grav * ht(ji,jj) * (zxr2 + zyr2) ) 1101 END DO 1102 END DO 1103 ENDIF 1104 1105 zcmax = MAXVAL( zcu(:,:) ) 1112 1106 IF( lk_mpp ) CALL mpp_max( zcmax ) 1113 1107 … … 1115 1109 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1116 1110 1117 rdtbt = rdt / FLOAT(nn_baro)1111 rdtbt = rdt / REAL( nn_baro , wp ) 1118 1112 zcmax = zcmax * rdtbt 1119 1113 ! Print results … … 1195 1189 !!====================================================================== 1196 1190 END MODULE dynspg_ts 1197 1198 1199
Note: See TracChangeset
for help on using the changeset viewer.
