- Timestamp:
- 2017-10-18T19:14:32+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90
r8586 r8637 124 124 CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pv_s(:,:,jl) ) ! Snow volume 125 125 CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pe_s(:,:,1,jl) ) ! Snow heat content 126 IF ( nn_pnd_scheme > 0) THEN126 IF ( ln_pnd_H12 ) THEN 127 127 CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pa_ip(:,:,jl) ) ! Melt pond fraction 128 128 CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pv_ip(:,:,jl) ) ! Melt pond volume … … 191 191 SELECT CASE( k_order ) 192 192 CASE ( 20 ) ! centered second order 193 DO jj = 2, jpjm1194 DO ji = fs_2, fs_jpim1 ! vector opt.193 DO jj = 1, jpjm1 194 DO ji = 1, fs_jpim1 ! vector opt. 195 195 zfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( ptc(ji,jj) + ptc(ji+1,jj) ) 196 196 zfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( ptc(ji,jj) + ptc(ji,jj+1) ) … … 201 201 CALL macho( k_order, kt, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v ) 202 202 ! 203 DO jj = 2, jpjm1204 DO ji = fs_2, fs_jpim1 ! vector opt.203 DO jj = 1, jpjm1 204 DO ji = 1, fs_jpim1 ! vector opt. 205 205 zfu_ho(ji,jj) = puc(ji,jj) * zt_u(ji,jj) 206 206 zfv_ho(ji,jj) = pvc(ji,jj) * zt_v(ji,jj) … … 212 212 ! antidiffusive flux : high order minus low order 213 213 ! -------------------------------------------------- 214 DO jj = 2, jpjm1215 DO ji = fs_2, fs_jpim1 ! vector opt.214 DO jj = 1, jpjm1 215 DO ji = 1, fs_jpim1 ! vector opt. 216 216 zfu_ho(ji,jj) = zfu_ho(ji,jj) - zfu_ups(ji,jj) 217 217 zfv_ho(ji,jj) = zfv_ho(ji,jj) - zfv_ups(ji,jj) 218 218 END DO 219 219 END DO 220 CALL lbc_lnk_multi( zfu_ho, 'U', -1., zfv_ho, 'V', -1. ) ! Lateral bondary conditions221 220 222 221 ! monotonicity algorithm … … 360 359 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 361 360 ! 362 DO jj = 1, jpj361 DO jj = 2, jpjm1 363 362 DO ji = 1, fs_jpim1 ! vector opt. 364 363 pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj) + pt(ji,jj) & … … 369 368 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 370 369 ! 371 DO jj = 1, jpj370 DO jj = 2, jpjm1 372 371 DO ji = 1, fs_jpim1 ! vector opt. 373 372 zcu = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 376 375 END DO 377 376 END DO 378 CALL lbc_lnk( pt_u(:,:) , 'U', 1. )379 377 ! 380 378 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 381 379 ! 382 DO jj = 1, jpj380 DO jj = 2, jpjm1 383 381 DO ji = 1, fs_jpim1 ! vector opt. 384 382 zcu = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 394 392 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 395 393 ! 396 DO jj = 1, jpj394 DO jj = 2, jpjm1 397 395 DO ji = 1, fs_jpim1 ! vector opt. 398 396 zcu = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 408 406 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 409 407 ! 410 DO jj = 1, jpj408 DO jj = 2, jpjm1 411 409 DO ji = 1, fs_jpim1 ! vector opt. 412 410 zcu = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 485 483 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 486 484 DO jj = 1, jpjm1 487 DO ji = 1, jpi485 DO ji = fs_2, fs_jpim1 488 486 pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1) + pt(ji,jj) ) & 489 487 & - SIGN( 1._wp, pvc(ji,jj) ) * ( pt(ji,jj+1) - pt(ji,jj) ) ) … … 493 491 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 494 492 DO jj = 1, jpjm1 495 DO ji = 1, jpi493 DO ji = fs_2, fs_jpim1 496 494 zcv = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 497 495 pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1) + pt(ji,jj) ) & … … 503 501 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 504 502 DO jj = 1, jpjm1 505 DO ji = 1, jpi503 DO ji = fs_2, fs_jpim1 506 504 zcv = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 507 505 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 516 514 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 517 515 DO jj = 1, jpjm1 518 DO ji = 1, jpi516 DO ji = fs_2, fs_jpim1 519 517 zcv = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 520 518 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 529 527 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 530 528 DO jj = 1, jpjm1 531 DO ji = 1, jpi529 DO ji = fs_2, fs_jpim1 532 530 zcv = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 533 531 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 629 627 ! ------------------------------------- 630 628 DO jj = 2, jpjm1 631 DO ji = fs_2, fs_jpim1 ! vector opt.629 DO ji = 1, fs_jpim1 ! vector opt. 632 630 zau = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji+1,jj) ) 633 631 zbu = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji+1,jj) ) 634 632 zcu = 0.5 + SIGN( 0.5 , paa(ji,jj) ) 635 633 ! 634 paa(ji,jj) = paa(ji,jj) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 635 END DO 636 END DO 637 ! 638 DO jj = 1, jpjm1 639 DO ji = fs_2, fs_jpim1 ! vector opt. 636 640 zav = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji,jj+1) ) 637 641 zbv = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji,jj+1) ) 638 642 zcv = 0.5 + SIGN( 0.5 , pbb(ji,jj) ) 639 643 ! 640 paa(ji,jj) = paa(ji,jj) * ( zcu * zau + ( 1._wp - zcu) * zbu )641 644 pbb(ji,jj) = pbb(ji,jj) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 642 ! 643 END DO 644 END DO 645 CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 645 END DO 646 END DO 646 647 ! 647 648 !! IF( nn_timing == 1 ) CALL timing_stop('nonosc_2d')
Note: See TracChangeset
for help on using the changeset viewer.
