Changeset 12340
- Timestamp:
- 2020-01-27T15:31:53+01:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 1 added
- 194 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ABL/ablmod.F90
r12236 r12340 33 33 !! * Substitutions 34 34 # include "vectopt_loop_substitute.h90" 35 # include "do_loop_substitute.h90" 35 36 36 37 CONTAINS … … 126 127 !! needed for surface boundary condition of TKE 127 128 !! pwndm contains | U10m - U_oce | (see blk_oce_1 in sbcblk) 128 DO jj = 1,jpj 129 DO ji = 1,jpi 130 zzoce = pCd_du (ji,jj) * pwndm (ji,jj) 129 DO_2D_11_11 130 zzoce = pCd_du (ji,jj) * pwndm (ji,jj) 131 131 #if defined key_si3 132 133 132 zzice = pCd_du_ice(ji,jj) * pwndm_ice(ji,jj) 133 ustar2(ji,jj) = zzoce * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * zzice 134 134 #else 135 135 ustar2(ji,jj) = zzoce 136 136 #endif 137 END DO 138 END DO 137 END_2D 139 138 ! 140 139 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 243 242 ! 244 243 ! Advance u_abl & v_abl to time n+1 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 zcff = ( fft_abl(ji,jj) * rdt_abl )*( fft_abl(ji,jj) * rdt_abl ) ! (f dt)**2 248 249 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 250 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*u_abl( ji, jj, jk, nt_n ) & 251 & + rdt_abl * fft_abl(ji, jj) * v_abl ( ji , jj , jk, nt_n ) ) & 252 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 253 254 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 255 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*v_abl( ji, jj, jk, nt_n ) & 256 & - rdt_abl * fft_abl(ji, jj) * u_abl ( ji , jj, jk, nt_n ) ) & 257 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 258 END DO 259 END DO 244 DO_2D_11_11 245 zcff = ( fft_abl(ji,jj) * rdt_abl )*( fft_abl(ji,jj) * rdt_abl ) ! (f dt)**2 246 247 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 248 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*u_abl( ji, jj, jk, nt_n ) & 249 & + rdt_abl * fft_abl(ji, jj) * v_abl ( ji , jj , jk, nt_n ) ) & 250 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 251 252 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 253 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*v_abl( ji, jj, jk, nt_n ) & 254 & - rdt_abl * fft_abl(ji, jj) * u_abl ( ji , jj, jk, nt_n ) ) & 255 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 256 END_2D 260 257 ! 261 258 !------------- … … 433 430 DO jk = 2, jpka ! outer loop 434 431 !------------- 435 DO jj = 2, jpj 436 DO ji = 2, jpi 437 zcff1 = pblh( ji, jj ) 438 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 439 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 440 zmsk = msk_abl(ji,jj) 441 zcff2 = jp_alp3_dyn * zsig**3 + jp_alp2_dyn * zsig**2 & 442 & + jp_alp1_dyn * zsig + jp_alp0_dyn 443 zcff = (1._wp-zmsk) + zmsk * zcff2 * rdt ! zcff = 1 for masked points 444 ! rdt = rdt_abl / nn_fsbc 445 zcff = zcff * rest_eq(ji,jj) 446 z_cft( ji, jj, jk ) = zcff 447 u_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * u_abl( ji, jj, jk, nt_a ) & 448 & + zcff * pu_dta( ji, jj, jk ) 449 v_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * v_abl( ji, jj, jk, nt_a ) & 450 & + zcff * pv_dta( ji, jj, jk ) 451 END DO 452 END DO 432 DO_2D_01_01 433 zcff1 = pblh( ji, jj ) 434 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 435 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 436 zmsk = msk_abl(ji,jj) 437 zcff2 = jp_alp3_dyn * zsig**3 + jp_alp2_dyn * zsig**2 & 438 & + jp_alp1_dyn * zsig + jp_alp0_dyn 439 zcff = (1._wp-zmsk) + zmsk * zcff2 * rdt ! zcff = 1 for masked points 440 ! rdt = rdt_abl / nn_fsbc 441 zcff = zcff * rest_eq(ji,jj) 442 z_cft( ji, jj, jk ) = zcff 443 u_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * u_abl( ji, jj, jk, nt_a ) & 444 & + zcff * pu_dta( ji, jj, jk ) 445 v_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * v_abl( ji, jj, jk, nt_a ) & 446 & + zcff * pv_dta( ji, jj, jk ) 447 END_2D 453 448 !------------- 454 449 END DO ! end outer loop … … 459 454 DO jk = 2, jpka ! outer loop 460 455 !------------- 461 DO jj = 1,jpj 462 DO ji = 1,jpi 463 zcff1 = pblh( ji, jj ) 464 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 465 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 466 zmsk = msk_abl(ji,jj) 467 zcff2 = jp_alp3_tra * zsig**3 + jp_alp2_tra * zsig**2 & 468 & + jp_alp1_tra * zsig + jp_alp0_tra 469 zcff = (1._wp-zmsk) + zmsk * zcff2 * rdt ! zcff = 1 for masked points 470 ! rdt = rdt_abl / nn_fsbc 471 !z_cft( ji, jj, jk ) = zcff 472 tq_abl( ji, jj, jk, nt_a, jp_ta ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_ta ) & 473 & + zcff * pt_dta( ji, jj, jk ) 474 475 tq_abl( ji, jj, jk, nt_a, jp_qa ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_qa ) & 476 & + zcff * pq_dta( ji, jj, jk ) 477 478 END DO 479 END DO 456 DO_2D_11_11 457 zcff1 = pblh( ji, jj ) 458 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 459 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 460 zmsk = msk_abl(ji,jj) 461 zcff2 = jp_alp3_tra * zsig**3 + jp_alp2_tra * zsig**2 & 462 & + jp_alp1_tra * zsig + jp_alp0_tra 463 zcff = (1._wp-zmsk) + zmsk * zcff2 * rdt ! zcff = 1 for masked points 464 ! rdt = rdt_abl / nn_fsbc 465 !z_cft( ji, jj, jk ) = zcff 466 tq_abl( ji, jj, jk, nt_a, jp_ta ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_ta ) & 467 & + zcff * pt_dta( ji, jj, jk ) 468 469 tq_abl( ji, jj, jk, nt_a, jp_qa ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_qa ) & 470 & + zcff * pq_dta( ji, jj, jk ) 471 472 END_2D 480 473 !------------- 481 474 END DO ! end outer loop … … 526 519 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 527 520 528 DO jj = 1, jpj 529 DO ji = 1, jpi 530 ztemp = tq_abl ( ji, jj, 2, nt_a, jp_ta ) 531 zhumi = tq_abl ( ji, jj, 2, nt_a, jp_qa ) 532 !zcff = pslp_dta( ji, jj ) / & !<-- At this point ztemp and zhumi should not be zero ... 533 ! & ( R_dry*ztemp * ( 1._wp + rctv0*zhumi ) ) 534 zcff = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 535 psen ( ji, jj ) = cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp ) 536 pevp ( ji, jj ) = rn_efac*MAX( 0._wp, zcff * pevp(ji,jj) * ( pssq(ji,jj) - zhumi ) ) 537 rhoa( ji, jj ) = zcff 538 END DO 539 END DO 521 DO_2D_11_11 522 ztemp = tq_abl ( ji, jj, 2, nt_a, jp_ta ) 523 zhumi = tq_abl ( ji, jj, 2, nt_a, jp_qa ) 524 !zcff = pslp_dta( ji, jj ) / & !<-- At this point ztemp and zhumi should not be zero ... 525 ! & ( R_dry*ztemp * ( 1._wp + rctv0*zhumi ) ) 526 zcff = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 527 psen ( ji, jj ) = cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp ) 528 pevp ( ji, jj ) = rn_efac*MAX( 0._wp, zcff * pevp(ji,jj) * ( pssq(ji,jj) - zhumi ) ) 529 rhoa( ji, jj ) = zcff 530 END_2D 540 531 541 DO jj = 2, jpj 542 DO ji = 2, jpi ! vect. opt. 543 zwnd_i(ji,jj) = u_abl(ji ,jj,2,nt_a) - 0.5_wp * rn_vfac * ( pssu(ji ,jj) + pssu(ji-1,jj) ) 544 zwnd_j(ji,jj) = v_abl(ji,jj ,2,nt_a) - 0.5_wp * rn_vfac * ( pssv(ji,jj ) + pssv(ji,jj-1) ) 545 END DO 546 END DO 532 DO_2D_01_01 533 zwnd_i(ji,jj) = u_abl(ji ,jj,2,nt_a) - 0.5_wp * rn_vfac * ( pssu(ji ,jj) + pssu(ji-1,jj) ) 534 zwnd_j(ji,jj) = v_abl(ji,jj ,2,nt_a) - 0.5_wp * rn_vfac * ( pssv(ji,jj ) + pssv(ji,jj-1) ) 535 END_2D 547 536 ! 548 537 CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1., zwnd_j(:,:) , 'T', -1. ) 549 538 ! 550 539 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 551 DO jj = 1, jpj 552 DO ji = 1, jpi 553 zcff = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) & 554 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) ! * msk_abl(ji,jj) 555 zztmp = rhoa(ji,jj) * pcd_du(ji,jj) 556 557 pwndm (ji,jj) = zcff 558 ptaum (ji,jj) = zztmp * zcff 559 zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 560 zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj) 561 END DO 562 END DO 540 DO_2D_11_11 541 zcff = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) & 542 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) ! * msk_abl(ji,jj) 543 zztmp = rhoa(ji,jj) * pcd_du(ji,jj) 544 545 pwndm (ji,jj) = zcff 546 ptaum (ji,jj) = zztmp * zcff 547 zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 548 zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj) 549 END_2D 563 550 ! ... utau, vtau at U- and V_points, resp. 564 551 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 565 552 ! Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 566 DO jj = 2, jpjm1 567 DO ji = 2, jpim1 568 zcff = 0.5_wp * ( 2._wp - msk_abl(ji,jj)*msk_abl(ji+1,jj) ) 569 zztmp = MAX(msk_abl(ji,jj),msk_abl(ji+1,jj)) 570 ptaui(ji,jj) = zcff * zztmp * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj ) ) 571 zcff = 0.5_wp * ( 2._wp - msk_abl(ji,jj)*msk_abl(ji,jj+1) ) 572 zztmp = MAX(msk_abl(ji,jj),msk_abl(ji,jj+1)) 573 ptauj(ji,jj) = zcff * zztmp * ( zwnd_j(ji,jj) + zwnd_j(ji ,jj+1) ) 574 END DO 575 END DO 553 DO_2D_00_00 554 zcff = 0.5_wp * ( 2._wp - msk_abl(ji,jj)*msk_abl(ji+1,jj) ) 555 zztmp = MAX(msk_abl(ji,jj),msk_abl(ji+1,jj)) 556 ptaui(ji,jj) = zcff * zztmp * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj ) ) 557 zcff = 0.5_wp * ( 2._wp - msk_abl(ji,jj)*msk_abl(ji,jj+1) ) 558 zztmp = MAX(msk_abl(ji,jj),msk_abl(ji,jj+1)) 559 ptauj(ji,jj) = zcff * zztmp * ( zwnd_j(ji,jj) + zwnd_j(ji ,jj+1) ) 560 END_2D 576 561 ! 577 562 CALL lbc_lnk_multi( 'ablmod', ptaui(:,:), 'U', -1., ptauj(:,:), 'V', -1. ) … … 589 574 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 590 575 ! ------------------------------------------------------------ ! 591 DO jj = 2, jpjm1 592 DO ji = 2, jpim1 593 594 zztmp1 = 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) ) 595 zztmp2 = 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 596 597 ptaui_ice(ji,jj) = 0.5_wp * ( rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj) & 598 & + rhoa(ji ,jj) * pCd_du_ice(ji ,jj) ) & 599 & * ( zztmp1 - rn_vfac * pssu_ice(ji,jj) ) 600 ptauj_ice(ji,jj) = 0.5_wp * ( rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1) & 601 & + rhoa(ji,jj ) * pCd_du_ice(ji,jj ) ) & 602 & * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) ) 603 END DO 604 END DO 576 DO_2D_00_00 577 578 zztmp1 = 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) ) 579 zztmp2 = 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 580 581 ptaui_ice(ji,jj) = 0.5_wp * ( rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj) & 582 & + rhoa(ji ,jj) * pCd_du_ice(ji ,jj) ) & 583 & * ( zztmp1 - rn_vfac * pssu_ice(ji,jj) ) 584 ptauj_ice(ji,jj) = 0.5_wp * ( rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1) & 585 & + rhoa(ji,jj ) * pCd_du_ice(ji,jj ) ) & 586 & * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) ) 587 END_2D 605 588 CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 606 589 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icealb.F90
r11960 r12340 38 38 REAL(wp) :: rn_alb_dpnd ! ponded ice albedo 39 39 40 !! * Substitutions 41 # include "do_loop_substitute.h90" 40 42 !!---------------------------------------------------------------------- 41 43 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 117 119 ! 118 120 DO jl = 1, jpl 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 ! !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time) 122 IF( ph_snw(ji,jj,jl) == 0._wp ) THEN 123 zafrac_snw = 0._wp 124 IF( ld_pnd_alb ) THEN 125 zafrac_pnd = pafrac_pnd(ji,jj,jl) 126 ELSE 127 zafrac_pnd = 0._wp 128 ENDIF 129 zafrac_ice = 1._wp - zafrac_pnd 121 DO_2D_11_11 122 ! !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time) 123 IF( ph_snw(ji,jj,jl) == 0._wp ) THEN 124 zafrac_snw = 0._wp 125 IF( ld_pnd_alb ) THEN 126 zafrac_pnd = pafrac_pnd(ji,jj,jl) 130 127 ELSE 131 zafrac_snw = 1._wp ! Snow fully "shades" melt ponds and ice132 128 zafrac_pnd = 0._wp 133 zafrac_ice = 0._wp134 129 ENDIF 135 ! 136 ! !--- Bare ice albedo (for hi > 150cm) 137 IF( ld_pnd_alb ) THEN 138 zalb_ice = rn_alb_idry 139 ELSE 140 IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN ; zalb_ice = rn_alb_imlt 141 ELSE ; zalb_ice = rn_alb_idry ; ENDIF 142 ENDIF 143 ! !--- Bare ice albedo (for hi < 150cm) 144 IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN ! 5cm < hi < 150cm 145 zalb_ice = zalb_ice + ( 0.18 - zalb_ice ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 146 ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN ! 0cm < hi < 5cm 147 zalb_ice = rn_alb_oce + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 148 ENDIF 149 ! 150 ! !--- Snow-covered ice albedo (freezing, melting cases) 151 IF( pt_su(ji,jj,jl) < rt0 ) THEN 152 zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 153 ELSE 154 zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 ) 155 ENDIF 156 ! !--- Ponded ice albedo 157 IF( ld_pnd_alb ) THEN 158 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 159 ELSE 160 zalb_pnd = rn_alb_dpnd 161 ENDIF 162 ! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 163 palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 164 ! 165 palb_cs(ji,jj,jl) = palb_os(ji,jj,jl) & 166 & - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl) & 167 & + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 168 ! 169 END DO 170 END DO 130 zafrac_ice = 1._wp - zafrac_pnd 131 ELSE 132 zafrac_snw = 1._wp ! Snow fully "shades" melt ponds and ice 133 zafrac_pnd = 0._wp 134 zafrac_ice = 0._wp 135 ENDIF 136 ! 137 ! !--- Bare ice albedo (for hi > 150cm) 138 IF( ld_pnd_alb ) THEN 139 zalb_ice = rn_alb_idry 140 ELSE 141 IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN ; zalb_ice = rn_alb_imlt 142 ELSE ; zalb_ice = rn_alb_idry ; ENDIF 143 ENDIF 144 ! !--- Bare ice albedo (for hi < 150cm) 145 IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN ! 5cm < hi < 150cm 146 zalb_ice = zalb_ice + ( 0.18 - zalb_ice ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 147 ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN ! 0cm < hi < 5cm 148 zalb_ice = rn_alb_oce + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 149 ENDIF 150 ! 151 ! !--- Snow-covered ice albedo (freezing, melting cases) 152 IF( pt_su(ji,jj,jl) < rt0 ) THEN 153 zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 154 ELSE 155 zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 ) 156 ENDIF 157 ! !--- Ponded ice albedo 158 IF( ld_pnd_alb ) THEN 159 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 160 ELSE 161 zalb_pnd = rn_alb_dpnd 162 ENDIF 163 ! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 164 palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 165 ! 166 palb_cs(ji,jj,jl) = palb_os(ji,jj,jl) & 167 & - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl) & 168 & + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 169 ! 170 END_2D 171 171 END DO 172 172 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icecor.F90
r12236 r12340 36 36 !! * Substitutions 37 37 # include "vectopt_loop_substitute.h90" 38 # include "do_loop_substitute.h90" 38 39 !!---------------------------------------------------------------------- 39 40 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 88 89 zzc = rhoi * r1_rdtice 89 90 DO jl = 1, jpl 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zsal = sv_i(ji,jj,jl) 93 sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) ) 94 sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux 95 END DO 96 END DO 91 DO_2D_11_11 92 zsal = sv_i(ji,jj,jl) 93 sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) ) 94 sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux 95 END_2D 97 96 END DO 98 97 ENDIF … … 108 107 ! !----------------------------------------------------- 109 108 IF( kn == 2 ) THEN ! Ice drift case: Corrections to avoid wrong values ! 110 DO jj = 2, jpjm1 !----------------------------------------------------- 111 DO ji = 2, jpim1 112 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 113 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side 114 IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 115 IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj ) = 0._wp ! upper side 116 IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 117 ENDIF 118 END DO 119 END DO 109 DO_2D_00_00 110 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 111 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side 112 IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 113 IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj ) = 0._wp ! upper side 114 IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 115 ENDIF 116 END_2D 120 117 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 121 118 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icectl.F90
r12236 r12340 52 52 !! * Substitutions 53 53 # include "vectopt_loop_substitute.h90" 54 # include "do_loop_substitute.h90" 54 55 !!---------------------------------------------------------------------- 55 56 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 368 369 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 369 370 DO jl = 1, jpl 370 DO jj = 1, jpj 371 DO ji = 1, jpi 372 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 373 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 374 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 375 ENDIF 376 END DO 377 END DO 371 DO_2D_11_11 372 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 373 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 374 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 375 ENDIF 376 END_2D 378 377 END DO 379 378 … … 382 381 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 383 382 jl = jpl 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 IF( h_i(ji,jj,jl) > 50._wp ) THEN 387 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 388 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 389 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 390 ENDIF 391 END DO 392 END DO 383 DO_2D_11_11 384 IF( h_i(ji,jj,jl) > 50._wp ) THEN 385 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 386 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 387 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 388 ENDIF 389 END_2D 393 390 394 391 ! Alert if very fast ice 395 392 ialert_id = 4 ! reference number of this alert 396 393 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 397 DO jj = 1, jpj 398 DO ji = 1, jpi 399 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 400 & at_i(ji,jj) > 0._wp ) THEN 401 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 402 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 403 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 404 ENDIF 405 END DO 406 END DO 394 DO_2D_11_11 395 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 396 & at_i(ji,jj) > 0._wp ) THEN 397 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 398 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 399 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 400 ENDIF 401 END_2D 407 402 408 403 ! Alert on salt flux 409 404 ialert_id = 5 ! reference number of this alert 410 405 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 414 WRITE(numout,*) ' ALERTE 5 : High salt flux' 415 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 416 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 417 ENDIF 418 END DO 419 END DO 406 DO_2D_11_11 407 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 408 WRITE(numout,*) ' ALERTE 5 : High salt flux' 409 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 410 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 411 ENDIF 412 END_2D 420 413 421 414 ! Alert if there is ice on continents 422 415 ialert_id = 6 ! reference number of this alert 423 416 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 427 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 428 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 429 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 430 ENDIF 431 END DO 432 END DO 417 DO_2D_11_11 418 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 419 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 420 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 421 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 422 ENDIF 423 END_2D 433 424 434 425 ! … … 437 428 cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert 438 429 DO jl = 1, jpl 439 DO jj = 1, jpj 440 DO ji = 1, jpi 441 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 442 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 430 DO_2D_11_11 431 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 432 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 443 433 ! CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 444 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 445 ENDIF 446 END DO 447 END DO 434 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 435 ENDIF 436 END_2D 448 437 END DO 449 438 ! … … 451 440 ialert_id = 8 ! reference number of this alert 452 441 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 453 DO jj = 1, jpj 454 DO ji = 1, jpi 455 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 456 ! 457 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 458 !CALL ice_prt( kt, ji, jj, 2, ' ') 459 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 460 ! 461 ENDIF 462 END DO 463 END DO 442 DO_2D_11_11 443 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 444 ! 445 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 446 !CALL ice_prt( kt, ji, jj, 2, ' ') 447 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 448 ! 449 ENDIF 450 END_2D 464 451 !+++++ 465 452 … … 468 455 cl_alname(ialert_id) = ' Very old ice ' ! name of the alert 469 456 DO jl = 1, jpl 470 DO jj = 1, jpj 471 DO ji = 1, jpi 472 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 473 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 474 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 475 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 476 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 477 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 478 ENDIF 479 END DO 480 END DO 457 DO_2D_11_11 458 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 459 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 460 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 461 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 462 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 463 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 464 ENDIF 465 END_2D 481 466 END DO 482 467 … … 486 471 inb_alp(ialert_id) = 0 487 472 DO jl = 1, jpl 488 DO jk = 1, nlay_i 489 DO jj = 1, jpj 490 DO ji = 1, jpi 491 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 492 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 493 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 494 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 495 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 496 ENDIF 497 END DO 498 END DO 499 END DO 473 DO_3D_11_11( 1, nlay_i ) 474 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 475 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 476 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 477 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 478 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 479 ENDIF 480 END_3D 500 481 END DO 501 482 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn.F90
r11960 r12340 53 53 !! * Substitutions 54 54 # include "vectopt_loop_substitute.h90" 55 # include "do_loop_substitute.h90" 55 56 !!---------------------------------------------------------------------- 56 57 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 126 127 ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 127 128 ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 131 zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 132 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 133 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 134 END DO 135 END DO 129 DO_2D_11_11 130 zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 131 zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 132 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 133 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 134 END_2D 136 135 ! --- 137 136 CALL ice_dyn_adv ( kt ) ! -- advection of ice … … 157 156 158 157 ALLOCATE( zdivu_i(jpi,jpj) ) 159 DO jj = 2, jpjm1 160 DO ji = 2, jpim1 161 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 162 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 163 END DO 164 END DO 158 DO_2D_00_00 159 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 160 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 161 END_2D 165 162 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 166 163 ! output -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv_pra.F90
r12252 r12340 47 47 !! * Substitutions 48 48 # include "vectopt_loop_substitute.h90" 49 # include "do_loop_substitute.h90" 49 50 !!---------------------------------------------------------------------- 50 51 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 102 103 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 103 104 DO jl = 1, jpl 104 DO jj = 2, jpjm1 105 DO ji = fs_2, fs_jpim1 106 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 107 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 108 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 109 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 110 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 111 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 112 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 113 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 114 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 115 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 116 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 117 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 118 END DO 119 END DO 105 DO_2D_00_00 106 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 107 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 108 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 109 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 110 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 111 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 112 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 113 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 114 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 115 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 116 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 117 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 118 END_2D 120 119 END DO 121 120 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) … … 252 251 ! derive open water from ice concentration 253 252 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 254 DO jj = 2, jpjm1 255 DO ji = fs_2, fs_jpim1 256 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 257 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 258 END DO 259 END DO 253 DO_2D_00_00 254 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 255 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 256 END_2D 260 257 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1. ) 261 258 ! … … 309 306 ! 310 307 ! Limitation of moments. 311 DO jj = 2, jpjm1 312 DO ji = 1, jpi 313 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 314 psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 315 ! 316 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 317 zs1max = 1.5 * zslpmax 318 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 319 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 320 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 321 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 322 323 ps0 (ji,jj,jl) = zslpmax 324 psx (ji,jj,jl) = zs1new * rswitch 325 psxx(ji,jj,jl) = zs2new * rswitch 326 psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 327 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 328 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 329 END DO 330 END DO 308 DO_2D_00_11 309 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 310 psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 311 ! 312 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 313 zs1max = 1.5 * zslpmax 314 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 315 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 316 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 317 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 318 319 ps0 (ji,jj,jl) = zslpmax 320 psx (ji,jj,jl) = zs1new * rswitch 321 psxx(ji,jj,jl) = zs2new * rswitch 322 psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 323 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 324 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 325 END_2D 331 326 332 327 ! Calculate fluxes and moments between boxes i<-->i+1 333 DO jj = 2, jpjm1 ! Flux from i to i+1 WHEN u GT 0 334 DO ji = 1, jpi 335 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 336 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 337 zalfq = zalf * zalf 338 zalf1 = 1.0 - zalf 339 zalf1q = zalf1 * zalf1 340 ! 341 zfm (ji,jj) = zalf * psm (ji,jj,jl) 342 zf0 (ji,jj) = zalf * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 343 zfx (ji,jj) = zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 344 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) * zalfq 345 zfy (ji,jj) = zalf * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 346 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 347 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 348 349 ! Readjust moments remaining in the box. 350 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 351 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 352 psx (ji,jj,jl) = zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 353 psxx(ji,jj,jl) = zalf1 * zalf1q * psxx(ji,jj,jl) 354 psy (ji,jj,jl) = psy (ji,jj,jl) - zfy(ji,jj) 355 psyy(ji,jj,jl) = psyy(ji,jj,jl) - zfyy(ji,jj) 356 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 357 END DO 358 END DO 359 360 DO jj = 2, jpjm1 ! Flux from i+1 to i when u LT 0. 361 DO ji = 1, fs_jpim1 362 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 363 zalg (ji,jj) = zalf 364 zalfq = zalf * zalf 365 zalf1 = 1.0 - zalf 366 zalg1 (ji,jj) = zalf1 367 zalf1q = zalf1 * zalf1 368 zalg1q(ji,jj) = zalf1q 369 ! 370 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) 371 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & 372 & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 373 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 374 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq 375 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 376 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) 377 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 378 END DO 379 END DO 380 381 DO jj = 2, jpjm1 ! Readjust moments remaining in the box. 382 DO ji = fs_2, fs_jpim1 383 zbt = zbet(ji-1,jj) 384 zbt1 = 1.0 - zbet(ji-1,jj) 385 ! 386 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 387 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 388 psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 389 psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 390 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 391 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 392 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 393 END DO 394 END DO 328 DO_2D_00_11 329 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 330 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 331 zalfq = zalf * zalf 332 zalf1 = 1.0 - zalf 333 zalf1q = zalf1 * zalf1 334 ! 335 zfm (ji,jj) = zalf * psm (ji,jj,jl) 336 zf0 (ji,jj) = zalf * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 337 zfx (ji,jj) = zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 338 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) * zalfq 339 zfy (ji,jj) = zalf * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 340 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 341 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 342 343 ! Readjust moments remaining in the box. 344 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 345 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 346 psx (ji,jj,jl) = zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 347 psxx(ji,jj,jl) = zalf1 * zalf1q * psxx(ji,jj,jl) 348 psy (ji,jj,jl) = psy (ji,jj,jl) - zfy(ji,jj) 349 psyy(ji,jj,jl) = psyy(ji,jj,jl) - zfyy(ji,jj) 350 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 351 END_2D 352 353 DO_2D_00_10 354 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 355 zalg (ji,jj) = zalf 356 zalfq = zalf * zalf 357 zalf1 = 1.0 - zalf 358 zalg1 (ji,jj) = zalf1 359 zalf1q = zalf1 * zalf1 360 zalg1q(ji,jj) = zalf1q 361 ! 362 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) 363 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & 364 & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 365 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 366 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq 367 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 368 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) 369 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 370 END_2D 371 372 DO_2D_00_00 373 zbt = zbet(ji-1,jj) 374 zbt1 = 1.0 - zbet(ji-1,jj) 375 ! 376 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 377 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 378 psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 379 psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 380 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 381 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 382 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 383 END_2D 395 384 396 385 ! Put the temporary moments into appropriate neighboring boxes. 397 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0. 398 DO ji = fs_2, fs_jpim1 399 zbt = zbet(ji-1,jj) 400 zbt1 = 1.0 - zbet(ji-1,jj) 401 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 402 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 403 zalf1 = 1.0 - zalf 404 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 405 ! 406 ps0 (ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 407 psx (ji,jj,jl) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 408 psxx(ji,jj,jl) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 409 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 410 & + zbt1 * psxx(ji,jj,jl) 411 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl) & 412 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj,jl) ) ) & 413 & + zbt1 * psxy(ji,jj,jl) 414 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 415 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 416 END DO 417 END DO 418 419 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0. 420 DO ji = fs_2, fs_jpim1 421 zbt = zbet(ji,jj) 422 zbt1 = 1.0 - zbet(ji,jj) 423 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 424 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 425 zalf1 = 1.0 - zalf 426 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 427 ! 428 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 429 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 430 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 431 & + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) ) & 432 & + ( zalf1 - zalf ) * ztemp ) ) 433 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 434 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 435 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 436 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 437 END DO 438 END DO 386 DO_2D_00_00 387 zbt = zbet(ji-1,jj) 388 zbt1 = 1.0 - zbet(ji-1,jj) 389 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 390 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 391 zalf1 = 1.0 - zalf 392 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 393 ! 394 ps0 (ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 395 psx (ji,jj,jl) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 396 psxx(ji,jj,jl) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 397 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 398 & + zbt1 * psxx(ji,jj,jl) 399 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl) & 400 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj,jl) ) ) & 401 & + zbt1 * psxy(ji,jj,jl) 402 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 403 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 404 END_2D 405 406 DO_2D_00_00 407 zbt = zbet(ji,jj) 408 zbt1 = 1.0 - zbet(ji,jj) 409 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 410 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 411 zalf1 = 1.0 - zalf 412 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 413 ! 414 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 415 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 416 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 417 & + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) ) & 418 & + ( zalf1 - zalf ) * ztemp ) ) 419 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 420 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 421 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 422 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 423 END_2D 439 424 440 425 END DO … … 478 463 ! 479 464 ! Limitation of moments. 480 DO jj = 1, jpj 481 DO ji = fs_2, fs_jpim1 482 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 483 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 484 ! 485 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 486 zs1max = 1.5 * zslpmax 487 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 488 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 489 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 490 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 491 ! 492 ps0 (ji,jj,jl) = zslpmax 493 psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 494 psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 495 psy (ji,jj,jl) = zs1new * rswitch 496 psyy(ji,jj,jl) = zs2new * rswitch 497 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 498 END DO 499 END DO 465 DO_2D_11_00 466 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 467 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 468 ! 469 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 470 zs1max = 1.5 * zslpmax 471 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 472 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 473 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 474 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 475 ! 476 ps0 (ji,jj,jl) = zslpmax 477 psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 478 psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 479 psy (ji,jj,jl) = zs1new * rswitch 480 psyy(ji,jj,jl) = zs2new * rswitch 481 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 482 END_2D 500 483 501 484 ! Calculate fluxes and moments between boxes j<-->j+1 502 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 503 DO ji = fs_2, fs_jpim1 504 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 505 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 506 zalfq = zalf * zalf 507 zalf1 = 1.0 - zalf 508 zalf1q = zalf1 * zalf1 509 ! 510 zfm (ji,jj) = zalf * psm(ji,jj,jl) 511 zf0 (ji,jj) = zalf * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl) + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 512 zfy (ji,jj) = zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 513 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj,jl) 514 zfx (ji,jj) = zalf * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 515 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 516 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 517 ! 518 ! Readjust moments remaining in the box. 519 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 520 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 521 psy (ji,jj,jl) = zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 522 psyy(ji,jj,jl) = zalf1 * zalf1q * psyy(ji,jj,jl) 523 psx (ji,jj,jl) = psx (ji,jj,jl) - zfx(ji,jj) 524 psxx(ji,jj,jl) = psxx(ji,jj,jl) - zfxx(ji,jj) 525 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 526 END DO 527 END DO 528 ! 529 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 530 DO ji = fs_2, fs_jpim1 531 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 532 zalg (ji,jj) = zalf 533 zalfq = zalf * zalf 534 zalf1 = 1.0 - zalf 535 zalg1 (ji,jj) = zalf1 536 zalf1q = zalf1 * zalf1 537 zalg1q(ji,jj) = zalf1q 538 ! 539 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) 540 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & 541 & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 542 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 543 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq 544 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 545 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) 546 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1,jl) 547 END DO 548 END DO 485 DO_2D_11_00 486 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 487 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 488 zalfq = zalf * zalf 489 zalf1 = 1.0 - zalf 490 zalf1q = zalf1 * zalf1 491 ! 492 zfm (ji,jj) = zalf * psm(ji,jj,jl) 493 zf0 (ji,jj) = zalf * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl) + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 494 zfy (ji,jj) = zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 495 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj,jl) 496 zfx (ji,jj) = zalf * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 497 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 498 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 499 ! 500 ! Readjust moments remaining in the box. 501 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 502 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 503 psy (ji,jj,jl) = zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 504 psyy(ji,jj,jl) = zalf1 * zalf1q * psyy(ji,jj,jl) 505 psx (ji,jj,jl) = psx (ji,jj,jl) - zfx(ji,jj) 506 psxx(ji,jj,jl) = psxx(ji,jj,jl) - zfxx(ji,jj) 507 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 508 END_2D 509 ! 510 DO_2D_10_00 511 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 512 zalg (ji,jj) = zalf 513 zalfq = zalf * zalf 514 zalf1 = 1.0 - zalf 515 zalg1 (ji,jj) = zalf1 516 zalf1q = zalf1 * zalf1 517 zalg1q(ji,jj) = zalf1q 518 ! 519 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) 520 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & 521 & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 522 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 523 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq 524 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 525 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) 526 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1,jl) 527 END_2D 549 528 550 529 ! Readjust moments remaining in the box. 551 DO jj = 2, jpjm1 552 DO ji = fs_2, fs_jpim1 553 zbt = zbet(ji,jj-1) 554 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 555 ! 556 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 557 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 558 psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 559 psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 560 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 561 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 562 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 563 END DO 564 END DO 530 DO_2D_00_00 531 zbt = zbet(ji,jj-1) 532 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 533 ! 534 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 535 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 536 psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 537 psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 538 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 539 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 540 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 541 END_2D 565 542 566 543 ! Put the temporary moments into appropriate neighboring boxes. 567 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 568 DO ji = fs_2, fs_jpim1 569 zbt = zbet(ji,jj-1) 570 zbt1 = 1.0 - zbet(ji,jj-1) 571 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 572 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 573 zalf1 = 1.0 - zalf 574 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 575 ! 576 ps0(ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 577 psy(ji,jj,jl) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) & 578 & + zbt1 * psy(ji,jj,jl) 579 psyy(ji,jj,jl) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl) & 580 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 581 & + zbt1 * psyy(ji,jj,jl) 582 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl) & 583 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) ) & 584 & + zbt1 * psxy(ji,jj,jl) 585 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 586 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 587 END DO 588 END DO 589 590 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 591 DO ji = fs_2, fs_jpim1 592 zbt = zbet(ji,jj) 593 zbt1 = 1.0 - zbet(ji,jj) 594 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 595 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 596 zalf1 = 1.0 - zalf 597 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 598 ! 599 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 600 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 601 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 602 & + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) ) & 603 & + ( zalf1 - zalf ) * ztemp ) ) 604 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 605 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 606 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 607 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 608 END DO 609 END DO 544 DO_2D_00_00 545 zbt = zbet(ji,jj-1) 546 zbt1 = 1.0 - zbet(ji,jj-1) 547 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 548 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 549 zalf1 = 1.0 - zalf 550 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 551 ! 552 ps0(ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 553 psy(ji,jj,jl) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) & 554 & + zbt1 * psy(ji,jj,jl) 555 psyy(ji,jj,jl) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl) & 556 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 557 & + zbt1 * psyy(ji,jj,jl) 558 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl) & 559 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) ) & 560 & + zbt1 * psxy(ji,jj,jl) 561 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 562 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 563 END_2D 564 565 DO_2D_00_00 566 zbt = zbet(ji,jj) 567 zbt1 = 1.0 - zbet(ji,jj) 568 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 569 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 570 zalf1 = 1.0 - zalf 571 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 572 ! 573 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 574 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 575 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 576 & + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) ) & 577 & + ( zalf1 - zalf ) * ztemp ) ) 578 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 579 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 580 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 581 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 582 END_2D 610 583 611 584 END DO … … 646 619 DO jl = 1, jpl 647 620 648 DO jj = 1, jpj 649 DO ji = 1, jpi 650 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 621 DO_2D_11_11 622 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 623 ! 624 ! ! -- check h_ip -- ! 625 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 626 IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 627 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 628 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 629 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 630 ENDIF 631 ENDIF 632 ! 633 ! ! -- check h_i -- ! 634 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 635 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 636 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 637 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 638 ENDIF 639 ! 640 ! ! -- check h_s -- ! 641 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 642 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 643 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 644 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 651 645 ! 652 ! ! -- check h_ip -- ! 653 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 654 IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 655 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 656 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 657 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 658 ENDIF 659 ENDIF 646 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 647 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 660 648 ! 661 ! ! -- check h_i -- ! 662 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 663 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 664 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 665 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 666 ENDIF 667 ! 668 ! ! -- check h_s -- ! 669 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 670 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 671 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 672 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 673 ! 674 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 675 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 676 ! 677 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 678 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 679 ENDIF 680 ! 681 ENDIF 682 END DO 683 END DO 649 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 650 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 651 ENDIF 652 ! 653 ENDIF 654 END_2D 684 655 END DO 685 656 ! … … 714 685 ! -- check snow load -- ! 715 686 DO jl = 1, jpl 716 DO jj = 1, jpj 717 DO ji = 1, jpi 718 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 719 ! 720 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 721 ! 722 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 723 ! put snow excess in the ocean 724 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 725 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 726 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 727 ! correct snow volume and heat content 728 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 729 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 730 ENDIF 731 ! 687 DO_2D_11_11 688 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 689 ! 690 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 691 ! 692 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 693 ! put snow excess in the ocean 694 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 695 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 696 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 697 ! correct snow volume and heat content 698 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 699 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 732 700 ENDIF 733 END DO 734 END DO 701 ! 702 ENDIF 703 END_2D 735 704 END DO 736 705 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv_umx.F90
r12252 r12340 52 52 !! * Substitutions 53 53 # include "vectopt_loop_substitute.h90" 54 # include "do_loop_substitute.h90" 54 55 !!---------------------------------------------------------------------- 55 56 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 107 108 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 108 109 DO jl = 1, jpl 109 DO jj = 2, jpjm1 110 DO ji = fs_2, fs_jpim1 111 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 112 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 113 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 114 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 115 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 116 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 117 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 118 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 119 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 120 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 121 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 122 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 123 END DO 124 END DO 110 DO_2D_00_00 111 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 112 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 113 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 114 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 115 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 116 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 117 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 118 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 119 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 120 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 121 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 122 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 123 END_2D 125 124 END DO 126 125 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) … … 152 151 ! 153 152 ! --- define velocity for advection: u*grad(H) --- ! 154 DO jj = 2, jpjm1 155 DO ji = fs_2, fs_jpim1 156 IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 157 ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj) 158 ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj) 159 ENDIF 160 161 IF ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 162 ELSEIF( pv_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = pv_ice(ji,jj-1) 163 ELSE ; zcv_box(ji,jj) = pv_ice(ji,jj ) 164 ENDIF 165 END DO 166 END DO 153 DO_2D_00_00 154 IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 155 ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj) 156 ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj) 157 ENDIF 158 159 IF ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 160 ELSEIF( pv_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = pv_ice(ji,jj-1) 161 ELSE ; zcv_box(ji,jj) = pv_ice(ji,jj ) 162 ENDIF 163 END_2D 167 164 168 165 !---------------! … … 187 184 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 188 185 DO jl = 1, jpl 189 DO jj = 1, jpjm1 190 DO ji = 1, jpim1 191 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 192 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 193 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 194 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 195 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 196 ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF 197 END DO 198 END DO 186 DO_2D_10_10 187 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 188 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 189 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 190 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 191 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 192 ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF 193 END_2D 199 194 END DO 200 195 ENDIF … … 338 333 !== Open water area ==! 339 334 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 340 DO jj = 2, jpjm1 341 DO ji = fs_2, fs_jpim1 342 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 343 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 344 END DO 345 END DO 335 DO_2D_00_00 336 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 337 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 338 END_2D 346 339 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1. ) 347 340 ! … … 449 442 IF( pamsk == 0._wp ) THEN 450 443 DO jl = 1, jpl 451 DO jj = 1, jpjm1 452 DO ji = 1, fs_jpim1 453 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 454 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) 455 zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 456 ELSE 457 zfu_ho (ji,jj,jl) = 0._wp 458 zfu_ups(ji,jj,jl) = 0._wp 459 ENDIF 460 ! 461 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 462 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) 463 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 464 ELSE 465 zfv_ho (ji,jj,jl) = 0._wp 466 zfv_ups(ji,jj,jl) = 0._wp 467 ENDIF 468 END DO 469 END DO 444 DO_2D_10_10 445 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 446 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) 447 zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 448 ELSE 449 zfu_ho (ji,jj,jl) = 0._wp 450 zfu_ups(ji,jj,jl) = 0._wp 451 ENDIF 452 ! 453 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 454 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) 455 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 456 ELSE 457 zfv_ho (ji,jj,jl) = 0._wp 458 zfv_ups(ji,jj,jl) = 0._wp 459 ENDIF 460 END_2D 470 461 END DO 471 462 … … 473 464 ! thus we calculate the upstream solution and apply a limiter again 474 465 DO jl = 1, jpl 475 DO jj = 2, jpjm1 476 DO ji = fs_2, fs_jpim1 477 ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 478 ! 479 zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 480 END DO 481 END DO 466 DO_2D_00_00 467 ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 468 ! 469 zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 470 END_2D 482 471 END DO 483 472 CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1. ) … … 496 485 IF( PRESENT( pua_ho ) ) THEN 497 486 DO jl = 1, jpl 498 DO jj = 1, jpjm1 499 DO ji = 1, fs_jpim1 500 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 501 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 502 END DO 503 END DO 487 DO_2D_10_10 488 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 489 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 490 END_2D 504 491 END DO 505 492 ENDIF … … 508 495 ! --------------------------------- 509 496 DO jl = 1, jpl 510 DO jj = 2, jpjm1 511 DO ji = fs_2, fs_jpim1 512 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 513 ! 514 ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 515 END DO 516 END DO 497 DO_2D_00_00 498 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 499 ! 500 ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 501 END_2D 517 502 END DO 518 503 CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T', 1. ) … … 544 529 ! 545 530 DO jl = 1, jpl 546 DO jj = 1, jpjm1 547 DO ji = 1, fs_jpim1 531 DO_2D_10_10 532 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 533 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 534 END_2D 535 END DO 536 ! 537 ELSE !** alternate directions **! 538 ! 539 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 540 ! 541 DO jl = 1, jpl !-- flux in x-direction 542 DO_2D_10_10 548 543 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 544 END_2D 545 END DO 546 ! 547 DO jl = 1, jpl !-- first guess of tracer from u-flux 548 DO_2D_00_00 549 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 550 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 551 ! 552 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 553 END_2D 554 END DO 555 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 556 ! 557 DO jl = 1, jpl !-- flux in y-direction 558 DO_2D_10_10 559 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 560 END_2D 561 END DO 562 ! 563 ELSE !== even ice time step: adv_y then adv_x ==! 564 ! 565 DO jl = 1, jpl !-- flux in y-direction 566 DO_2D_10_10 549 567 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 550 END DO 551 END DO 552 END DO 553 ! 554 ELSE !** alternate directions **! 555 ! 556 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 568 END_2D 569 END DO 570 ! 571 DO jl = 1, jpl !-- first guess of tracer from v-flux 572 DO_2D_00_00 573 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 574 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 575 ! 576 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 577 END_2D 578 END DO 579 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 557 580 ! 558 581 DO jl = 1, jpl !-- flux in x-direction 559 DO jj = 1, jpjm1 560 DO ji = 1, fs_jpim1 561 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 562 END DO 563 END DO 564 END DO 565 ! 566 DO jl = 1, jpl !-- first guess of tracer from u-flux 567 DO jj = 2, jpjm1 568 DO ji = fs_2, fs_jpim1 569 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 570 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 571 ! 572 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 573 END DO 574 END DO 575 END DO 576 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 577 ! 578 DO jl = 1, jpl !-- flux in y-direction 579 DO jj = 1, jpjm1 580 DO ji = 1, fs_jpim1 581 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 582 END DO 583 END DO 584 END DO 585 ! 586 ELSE !== even ice time step: adv_y then adv_x ==! 587 ! 588 DO jl = 1, jpl !-- flux in y-direction 589 DO jj = 1, jpjm1 590 DO ji = 1, fs_jpim1 591 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 592 END DO 593 END DO 594 END DO 595 ! 596 DO jl = 1, jpl !-- first guess of tracer from v-flux 597 DO jj = 2, jpjm1 598 DO ji = fs_2, fs_jpim1 599 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 600 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 601 ! 602 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 603 END DO 604 END DO 605 END DO 606 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 607 ! 608 DO jl = 1, jpl !-- flux in x-direction 609 DO jj = 1, jpjm1 610 DO ji = 1, fs_jpim1 611 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 612 END DO 613 END DO 582 DO_2D_10_10 583 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 584 END_2D 614 585 END DO 615 586 ! … … 619 590 ! 620 591 DO jl = 1, jpl !-- after tracer with upstream scheme 621 DO jj = 2, jpjm1 622 DO ji = fs_2, fs_jpim1 623 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) & 624 & + pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) & 625 & + ( pu (ji,jj ) - pu (ji-1,jj ) & 626 & + pv (ji,jj ) - pv (ji ,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 627 ! 628 pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 629 END DO 630 END DO 592 DO_2D_00_00 593 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) & 594 & + pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) & 595 & + ( pu (ji,jj ) - pu (ji-1,jj ) & 596 & + pv (ji,jj ) - pv (ji ,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 597 ! 598 pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 599 END_2D 631 600 END DO 632 601 CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. ) … … 660 629 ! 661 630 DO jl = 1, jpl 662 DO jj = 1, jpjm1 663 DO ji = 1, fs_jpim1 664 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 665 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 666 END DO 667 END DO 631 DO_2D_10_10 632 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 633 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 634 END_2D 668 635 END DO 669 636 ! … … 680 647 ! 681 648 DO jl = 1, jpl !-- flux in x-direction 682 DO jj = 1, jpjm1 683 DO ji = 1, fs_jpim1 684 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 685 END DO 686 END DO 649 DO_2D_10_10 650 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 651 END_2D 687 652 END DO 688 653 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 689 654 690 655 DO jl = 1, jpl !-- first guess of tracer from u-flux 691 DO jj = 2, jpjm1 692 DO ji = fs_2, fs_jpim1 693 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 694 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 695 ! 696 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 697 END DO 698 END DO 656 DO_2D_00_00 657 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 658 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 659 ! 660 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 661 END_2D 699 662 END DO 700 663 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 701 664 702 665 DO jl = 1, jpl !-- flux in y-direction 703 DO jj = 1, jpjm1 704 DO ji = 1, fs_jpim1 705 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 706 END DO 707 END DO 666 DO_2D_10_10 667 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 668 END_2D 708 669 END DO 709 670 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) … … 712 673 ! 713 674 DO jl = 1, jpl !-- flux in y-direction 714 DO jj = 1, jpjm1 715 DO ji = 1, fs_jpim1 716 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 717 END DO 718 END DO 675 DO_2D_10_10 676 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 677 END_2D 719 678 END DO 720 679 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 721 680 ! 722 681 DO jl = 1, jpl !-- first guess of tracer from v-flux 723 DO jj = 2, jpjm1 724 DO ji = fs_2, fs_jpim1 725 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 726 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 727 ! 728 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 729 END DO 730 END DO 682 DO_2D_00_00 683 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 684 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 685 ! 686 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 687 END_2D 731 688 END DO 732 689 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 733 690 ! 734 691 DO jl = 1, jpl !-- flux in x-direction 735 DO jj = 1, jpjm1 736 DO ji = 1, fs_jpim1 737 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 738 END DO 739 END DO 692 DO_2D_10_10 693 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 694 END_2D 740 695 END DO 741 696 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) … … 783 738 ! !-- advective form update in zpt --! 784 739 DO jl = 1, jpl 785 DO jj = 2, jpjm1 786 DO ji = fs_2, fs_jpim1 787 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t (ji,jj) & 788 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & 789 & * pamsk & 790 & ) * pdt ) * tmask(ji,jj,1) 791 END DO 792 END DO 740 DO_2D_00_00 741 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t (ji,jj) & 742 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & 743 & * pamsk & 744 & ) * pdt ) * tmask(ji,jj,1) 745 END_2D 793 746 END DO 794 747 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) … … 812 765 ! !-- advective form update in zpt --! 813 766 DO jl = 1, jpl 814 DO jj = 2, jpjm1 815 DO ji = fs_2, fs_jpim1 816 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t (ji,jj) & 817 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & 818 & * pamsk & 819 & ) * pdt ) * tmask(ji,jj,1) 820 END DO 821 END DO 767 DO_2D_00_00 768 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t (ji,jj) & 769 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & 770 & * pamsk & 771 & ) * pdt ) * tmask(ji,jj,1) 772 END_2D 822 773 END DO 823 774 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) … … 896 847 ! 897 848 DO jl = 1, jpl 898 DO jj = 1, jpjm1 899 DO ji = 1, fs_jpim1 ! vector opt. 900 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 901 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 902 END DO 903 END DO 849 DO_2D_10_10 850 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 851 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 852 END_2D 904 853 END DO 905 854 ! … … 907 856 ! 908 857 DO jl = 1, jpl 909 DO jj = 1, jpjm1 910 DO ji = 1, fs_jpim1 ! vector opt. 911 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 912 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 913 & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 914 END DO 915 END DO 858 DO_2D_10_10 859 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 860 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 861 & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 862 END_2D 916 863 END DO 917 864 ! … … 919 866 ! 920 867 DO jl = 1, jpl 921 DO jj = 1, jpjm1 922 DO ji = 1, fs_jpim1 ! vector opt. 923 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 924 zdx2 = e1u(ji,jj) * e1u(ji,jj) 868 DO_2D_10_10 869 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 870 zdx2 = e1u(ji,jj) * e1u(ji,jj) 925 871 !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj) 926 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 927 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 928 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 929 & - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 930 END DO 931 END DO 872 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 873 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 874 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 875 & - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 876 END_2D 932 877 END DO 933 878 ! … … 935 880 ! 936 881 DO jl = 1, jpl 937 DO jj = 1, jpjm1 938 DO ji = 1, fs_jpim1 ! vector opt. 939 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 940 zdx2 = e1u(ji,jj) * e1u(ji,jj) 882 DO_2D_10_10 883 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 884 zdx2 = e1u(ji,jj) * e1u(ji,jj) 941 885 !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj) 942 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 943 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 944 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 945 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 946 END DO 947 END DO 886 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 887 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 888 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 889 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 890 END_2D 948 891 END DO 949 892 ! … … 951 894 ! 952 895 DO jl = 1, jpl 953 DO jj = 1, jpjm1 954 DO ji = 1, fs_jpim1 ! vector opt. 955 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 956 zdx2 = e1u(ji,jj) * e1u(ji,jj) 896 DO_2D_10_10 897 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 898 zdx2 = e1u(ji,jj) * e1u(ji,jj) 957 899 !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj) 958 zdx4 = zdx2 * zdx2 959 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 960 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 961 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 962 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 963 & + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl) & 964 & - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 965 END DO 966 END DO 900 zdx4 = zdx2 * zdx2 901 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 902 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 903 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 904 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 905 & + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl) & 906 & - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 907 END_2D 967 908 END DO 968 909 ! … … 974 915 IF( ll_neg ) THEN 975 916 DO jl = 1, jpl 976 DO jj = 1, jpjm1 977 DO ji = 1, fs_jpim1 978 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 979 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 980 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 981 ENDIF 982 END DO 983 END DO 917 DO_2D_10_10 918 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 919 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 920 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 921 ENDIF 922 END_2D 984 923 END DO 985 924 ENDIF 986 925 ! !-- High order flux in i-direction --! 987 926 DO jl = 1, jpl 988 DO jj = 1, jpjm1 989 DO ji = 1, fs_jpim1 ! vector opt. 990 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 991 END DO 992 END DO 927 DO_2D_10_10 928 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 929 END_2D 993 930 END DO 994 931 ! … … 1021 958 ! !-- Laplacian in j-direction --! 1022 959 DO jl = 1, jpl 1023 DO jj = 1, jpjm1 ! First derivative (gradient) 1024 DO ji = fs_2, fs_jpim1 1025 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1026 END DO 1027 END DO 1028 DO jj = 2, jpjm1 ! Second derivative (Laplacian) 1029 DO ji = fs_2, fs_jpim1 1030 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1031 END DO 1032 END DO 960 DO_2D_10_00 961 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 962 END_2D 963 DO_2D_00_00 964 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 965 END_2D 1033 966 END DO 1034 967 CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. ) … … 1036 969 ! !-- BiLaplacian in j-direction --! 1037 970 DO jl = 1, jpl 1038 DO jj = 1, jpjm1 ! First derivative 1039 DO ji = fs_2, fs_jpim1 1040 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1041 END DO 1042 END DO 1043 DO jj = 2, jpjm1 ! Second derivative 1044 DO ji = fs_2, fs_jpim1 1045 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1046 END DO 1047 END DO 971 DO_2D_10_00 972 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 973 END_2D 974 DO_2D_00_00 975 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 976 END_2D 1048 977 END DO 1049 978 CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. ) … … 1054 983 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 1055 984 DO jl = 1, jpl 1056 DO jj = 1, jpjm1 1057 DO ji = 1, fs_jpim1 1058 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1059 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1060 END DO 1061 END DO 985 DO_2D_10_10 986 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 987 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 988 END_2D 1062 989 END DO 1063 990 ! 1064 991 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 1065 992 DO jl = 1, jpl 1066 DO jj = 1, jpjm1 1067 DO ji = 1, fs_jpim1 1068 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1069 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1070 & - zcv * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1071 END DO 1072 END DO 993 DO_2D_10_10 994 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 995 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 996 & - zcv * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 997 END_2D 1073 998 END DO 1074 999 ! 1075 1000 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 1076 1001 DO jl = 1, jpl 1077 DO jj = 1, jpjm1 1078 DO ji = 1, fs_jpim1 1079 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1080 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1002 DO_2D_10_10 1003 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1004 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1081 1005 !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj) 1082 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1083 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1084 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1085 & - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1086 END DO 1087 END DO 1006 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1007 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1008 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1009 & - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1010 END_2D 1088 1011 END DO 1089 1012 ! 1090 1013 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 1091 1014 DO jl = 1, jpl 1092 DO jj = 1, jpjm1 1093 DO ji = 1, fs_jpim1 1094 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1095 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1015 DO_2D_10_10 1016 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1017 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1096 1018 !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj) 1097 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1098 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1099 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1100 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1101 END DO 1102 END DO 1019 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1020 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1021 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1022 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1023 END_2D 1103 1024 END DO 1104 1025 ! 1105 1026 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 1106 1027 DO jl = 1, jpl 1107 DO jj = 1, jpjm1 1108 DO ji = 1, fs_jpim1 1109 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1110 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1028 DO_2D_10_10 1029 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1030 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1111 1031 !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj) 1112 zdy4 = zdy2 * zdy2 1113 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1114 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1115 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1116 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 1117 & + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl) & 1118 & - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 1119 END DO 1120 END DO 1032 zdy4 = zdy2 * zdy2 1033 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1034 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1035 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1036 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 1037 & + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl) & 1038 & - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 1039 END_2D 1121 1040 END DO 1122 1041 ! … … 1128 1047 IF( ll_neg ) THEN 1129 1048 DO jl = 1, jpl 1130 DO jj = 1, jpjm1 1131 DO ji = 1, fs_jpim1 1132 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1133 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & 1134 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1135 ENDIF 1136 END DO 1137 END DO 1049 DO_2D_10_10 1050 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1051 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & 1052 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1053 ENDIF 1054 END_2D 1138 1055 END DO 1139 1056 ENDIF 1140 1057 ! !-- High order flux in j-direction --! 1141 1058 DO jl = 1, jpl 1142 DO jj = 1, jpjm1 1143 DO ji = 1, fs_jpim1 ! vector opt. 1144 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1145 END DO 1146 END DO 1059 DO_2D_10_10 1060 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1061 END_2D 1147 1062 END DO 1148 1063 ! … … 1178 1093 ! -------------------------------------------------- 1179 1094 DO jl = 1, jpl 1180 DO jj = 1, jpjm1 1181 DO ji = 1, fs_jpim1 ! vector opt. 1182 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1183 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1184 END DO 1185 END DO 1095 DO_2D_10_10 1096 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1097 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1098 END_2D 1186 1099 END DO 1187 1100 … … 1197 1110 1198 1111 DO jl = 1, jpl 1199 DO jj = 2, jpjm1 1200 DO ji = fs_2, fs_jpim1 1201 zti_ups(ji,jj,jl)= pt_ups(ji+1,jj ,jl) 1202 ztj_ups(ji,jj,jl)= pt_ups(ji ,jj+1,jl) 1203 END DO 1204 END DO 1112 DO_2D_00_00 1113 zti_ups(ji,jj,jl)= pt_ups(ji+1,jj ,jl) 1114 ztj_ups(ji,jj,jl)= pt_ups(ji ,jj+1,jl) 1115 END_2D 1205 1116 END DO 1206 1117 CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. ) 1207 1118 1208 1119 DO jl = 1, jpl 1209 DO jj = 2, jpjm1 1210 DO ji = fs_2, fs_jpim1 1211 IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND. & 1212 & pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 1213 ! 1214 IF( pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND. & 1215 & pfv_ho(ji,jj,jl) * ( ztj_ups(ji ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 1216 pfu_ho(ji,jj,jl)=0._wp 1217 pfv_ho(ji,jj,jl)=0._wp 1218 ENDIF 1219 ! 1220 IF( pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj ,jl) ) <= 0._wp .AND. & 1221 & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji ,jj-1,jl) ) <= 0._wp ) THEN 1222 pfu_ho(ji,jj,jl)=0._wp 1223 pfv_ho(ji,jj,jl)=0._wp 1224 ENDIF 1225 ! 1120 DO_2D_00_00 1121 IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND. & 1122 & pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 1123 ! 1124 IF( pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND. & 1125 & pfv_ho(ji,jj,jl) * ( ztj_ups(ji ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 1126 pfu_ho(ji,jj,jl)=0._wp 1127 pfv_ho(ji,jj,jl)=0._wp 1226 1128 ENDIF 1227 END DO 1228 END DO 1129 ! 1130 IF( pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj ,jl) ) <= 0._wp .AND. & 1131 & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji ,jj-1,jl) ) <= 0._wp ) THEN 1132 pfu_ho(ji,jj,jl)=0._wp 1133 pfv_ho(ji,jj,jl)=0._wp 1134 ENDIF 1135 ! 1136 ENDIF 1137 END_2D 1229 1138 END DO 1230 1139 CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. ) ! lateral boundary cond. … … 1238 1147 DO jl = 1, jpl 1239 1148 1240 DO jj = 1, jpj 1241 DO ji = 1, jpi 1242 IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1243 zbup(ji,jj) = -zbig 1244 zbdo(ji,jj) = zbig 1245 ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN 1246 zbup(ji,jj) = pt_ups(ji,jj,jl) 1247 zbdo(ji,jj) = pt_ups(ji,jj,jl) 1248 ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1249 zbup(ji,jj) = pt(ji,jj,jl) 1250 zbdo(ji,jj) = pt(ji,jj,jl) 1251 ELSE 1252 zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1253 zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1254 ENDIF 1255 END DO 1256 END DO 1257 1258 DO jj = 2, jpjm1 1259 DO ji = fs_2, fs_jpim1 ! vector opt. 1260 ! 1261 zup = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) ) ! search max/min in neighbourhood 1262 zdo = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 1263 ! 1264 zpos = MAX( 0._wp, pfu_ho(ji-1,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji ,jj ,jl) ) & ! positive/negative part of the flux 1265 & + MAX( 0._wp, pfv_ho(ji ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj ,jl) ) 1266 zneg = MAX( 0._wp, pfu_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj ,jl) ) & 1267 & + MAX( 0._wp, pfv_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj-1,jl) ) 1268 ! 1269 zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1270 & ) * ( 1. - pamsk ) 1271 zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1272 & ) * ( 1. - pamsk ) 1273 ! 1274 ! ! up & down beta terms 1275 ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 1276 IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 1277 ELSE ; zbetup(ji,jj,jl) = 0._wp ! zbig 1278 ENDIF 1279 ! 1280 IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 1281 ELSE ; zbetdo(ji,jj,jl) = 0._wp ! zbig 1282 ENDIF 1283 ! 1284 ! if all the points are outside ice cover 1285 IF( zup == -zbig ) zbetup(ji,jj,jl) = 0._wp ! zbig 1286 IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig 1287 ! 1288 END DO 1289 END DO 1149 DO_2D_11_11 1150 IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1151 zbup(ji,jj) = -zbig 1152 zbdo(ji,jj) = zbig 1153 ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN 1154 zbup(ji,jj) = pt_ups(ji,jj,jl) 1155 zbdo(ji,jj) = pt_ups(ji,jj,jl) 1156 ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1157 zbup(ji,jj) = pt(ji,jj,jl) 1158 zbdo(ji,jj) = pt(ji,jj,jl) 1159 ELSE 1160 zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1161 zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1162 ENDIF 1163 END_2D 1164 1165 DO_2D_00_00 1166 ! 1167 zup = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) ) ! search max/min in neighbourhood 1168 zdo = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 1169 ! 1170 zpos = MAX( 0._wp, pfu_ho(ji-1,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji ,jj ,jl) ) & ! positive/negative part of the flux 1171 & + MAX( 0._wp, pfv_ho(ji ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj ,jl) ) 1172 zneg = MAX( 0._wp, pfu_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj ,jl) ) & 1173 & + MAX( 0._wp, pfv_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj-1,jl) ) 1174 ! 1175 zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1176 & ) * ( 1. - pamsk ) 1177 zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1178 & ) * ( 1. - pamsk ) 1179 ! 1180 ! ! up & down beta terms 1181 ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 1182 IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 1183 ELSE ; zbetup(ji,jj,jl) = 0._wp ! zbig 1184 ENDIF 1185 ! 1186 IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 1187 ELSE ; zbetdo(ji,jj,jl) = 0._wp ! zbig 1188 ENDIF 1189 ! 1190 ! if all the points are outside ice cover 1191 IF( zup == -zbig ) zbetup(ji,jj,jl) = 0._wp ! zbig 1192 IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig 1193 ! 1194 END_2D 1290 1195 END DO 1291 1196 CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) … … 1295 1200 ! --------------------------------- 1296 1201 DO jl = 1, jpl 1297 DO jj = 1, jpjm1 1298 DO ji = 1, fs_jpim1 ! vector opt. 1299 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 1300 zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 1301 zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 1302 ! 1303 zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 1304 ! 1305 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl) 1306 ! 1307 END DO 1308 END DO 1309 1310 DO jj = 1, jpjm1 1311 DO ji = 1, fs_jpim1 ! vector opt. 1312 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1313 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 1314 zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 1315 ! 1316 zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 1317 ! 1318 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl) 1319 ! 1320 END DO 1321 END DO 1202 DO_2D_10_10 1203 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 1204 zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 1205 zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 1206 ! 1207 zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 1208 ! 1209 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl) 1210 ! 1211 END_2D 1212 1213 DO_2D_10_10 1214 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1215 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 1216 zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 1217 ! 1218 zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 1219 ! 1220 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl) 1221 ! 1222 END_2D 1322 1223 1323 1224 END DO … … 1344 1245 ! 1345 1246 DO jl = 1, jpl 1346 DO jj = 2, jpjm1 1347 DO ji = fs_2, fs_jpim1 ! vector opt. 1348 zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 1349 END DO 1350 END DO 1247 DO_2D_00_00 1248 zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 1249 END_2D 1351 1250 END DO 1352 1251 CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.) ! lateral boundary cond. 1353 1252 1354 1253 DO jl = 1, jpl 1355 DO jj = 2, jpjm1 1356 DO ji = fs_2, fs_jpim1 ! vector opt. 1357 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1358 1359 Rjm = zslpx(ji-1,jj,jl) 1360 Rj = zslpx(ji ,jj,jl) 1361 Rjp = zslpx(ji+1,jj,jl) 1362 1363 IF( np_limiter == 3 ) THEN 1364 1365 IF( pu(ji,jj) > 0. ) THEN ; Rr = Rjm 1366 ELSE ; Rr = Rjp 1254 DO_2D_00_00 1255 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1256 1257 Rjm = zslpx(ji-1,jj,jl) 1258 Rj = zslpx(ji ,jj,jl) 1259 Rjp = zslpx(ji+1,jj,jl) 1260 1261 IF( np_limiter == 3 ) THEN 1262 1263 IF( pu(ji,jj) > 0. ) THEN ; Rr = Rjm 1264 ELSE ; Rr = Rjp 1265 ENDIF 1266 1267 zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1268 IF( Rj > 0. ) THEN 1269 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)), & 1270 & MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1271 ELSE 1272 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)), & 1273 & MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1274 ENDIF 1275 pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 1276 1277 ELSEIF( np_limiter == 2 ) THEN 1278 IF( Rj /= 0. ) THEN 1279 IF( pu(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1280 ELSE ; Cr = Rjp / Rj 1367 1281 ENDIF 1368 1369 zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1370 IF( Rj > 0. ) THEN 1371 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)), & 1372 & MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1373 ELSE 1374 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)), & 1375 & MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1376 ENDIF 1377 pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 1378 1379 ELSEIF( np_limiter == 2 ) THEN 1380 IF( Rj /= 0. ) THEN 1381 IF( pu(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1382 ELSE ; Cr = Rjp / Rj 1383 ENDIF 1384 ELSE 1385 Cr = 0. 1386 ENDIF 1387 1388 ! -- superbee -- 1389 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1390 ! -- van albada 2 -- 1391 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1392 ! -- sweby (with beta=1) -- 1393 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1394 ! -- van Leer -- 1395 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1396 ! -- ospre -- 1397 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1398 ! -- koren -- 1399 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1400 ! -- charm -- 1401 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1402 !ELSE ; zpsi = 0. 1403 !ENDIF 1404 ! -- van albada 1 -- 1405 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1406 ! -- smart -- 1407 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1408 ! -- umist -- 1409 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1410 1411 ! high order flux corrected by the limiter 1412 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5 1413 1282 ELSE 1283 Cr = 0. 1414 1284 ENDIF 1415 END DO 1416 END DO 1285 1286 ! -- superbee -- 1287 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1288 ! -- van albada 2 -- 1289 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1290 ! -- sweby (with beta=1) -- 1291 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1292 ! -- van Leer -- 1293 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1294 ! -- ospre -- 1295 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1296 ! -- koren -- 1297 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1298 ! -- charm -- 1299 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1300 !ELSE ; zpsi = 0. 1301 !ENDIF 1302 ! -- van albada 1 -- 1303 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1304 ! -- smart -- 1305 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1306 ! -- umist -- 1307 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1308 1309 ! high order flux corrected by the limiter 1310 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5 1311 1312 ENDIF 1313 END_2D 1417 1314 END DO 1418 1315 CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.) ! lateral boundary cond. … … 1439 1336 ! 1440 1337 DO jl = 1, jpl 1441 DO jj = 2, jpjm1 1442 DO ji = fs_2, fs_jpim1 ! vector opt. 1443 zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 1444 END DO 1445 END DO 1338 DO_2D_00_00 1339 zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 1340 END_2D 1446 1341 END DO 1447 1342 CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.) ! lateral boundary cond. 1448 1343 1449 1344 DO jl = 1, jpl 1450 DO jj = 2, jpjm1 1451 DO ji = fs_2, fs_jpim1 ! vector opt. 1452 vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 1453 1454 Rjm = zslpy(ji,jj-1,jl) 1455 Rj = zslpy(ji,jj ,jl) 1456 Rjp = zslpy(ji,jj+1,jl) 1457 1458 IF( np_limiter == 3 ) THEN 1459 1460 IF( pv(ji,jj) > 0. ) THEN ; Rr = Rjm 1461 ELSE ; Rr = Rjp 1345 DO_2D_00_00 1346 vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 1347 1348 Rjm = zslpy(ji,jj-1,jl) 1349 Rj = zslpy(ji,jj ,jl) 1350 Rjp = zslpy(ji,jj+1,jl) 1351 1352 IF( np_limiter == 3 ) THEN 1353 1354 IF( pv(ji,jj) > 0. ) THEN ; Rr = Rjm 1355 ELSE ; Rr = Rjp 1356 ENDIF 1357 1358 zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1359 IF( Rj > 0. ) THEN 1360 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)), & 1361 & MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1362 ELSE 1363 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)), & 1364 & MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1365 ENDIF 1366 pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 1367 1368 ELSEIF( np_limiter == 2 ) THEN 1369 1370 IF( Rj /= 0. ) THEN 1371 IF( pv(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1372 ELSE ; Cr = Rjp / Rj 1462 1373 ENDIF 1463 1464 zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1465 IF( Rj > 0. ) THEN 1466 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)), & 1467 & MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1468 ELSE 1469 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)), & 1470 & MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1471 ENDIF 1472 pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 1473 1474 ELSEIF( np_limiter == 2 ) THEN 1475 1476 IF( Rj /= 0. ) THEN 1477 IF( pv(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1478 ELSE ; Cr = Rjp / Rj 1479 ENDIF 1480 ELSE 1481 Cr = 0. 1482 ENDIF 1483 1484 ! -- superbee -- 1485 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1486 ! -- van albada 2 -- 1487 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1488 ! -- sweby (with beta=1) -- 1489 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1490 ! -- van Leer -- 1491 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1492 ! -- ospre -- 1493 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1494 ! -- koren -- 1495 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1496 ! -- charm -- 1497 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1498 !ELSE ; zpsi = 0. 1499 !ENDIF 1500 ! -- van albada 1 -- 1501 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1502 ! -- smart -- 1503 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1504 ! -- umist -- 1505 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1506 1507 ! high order flux corrected by the limiter 1508 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5 1509 1374 ELSE 1375 Cr = 0. 1510 1376 ENDIF 1511 END DO 1512 END DO 1377 1378 ! -- superbee -- 1379 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1380 ! -- van albada 2 -- 1381 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1382 ! -- sweby (with beta=1) -- 1383 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1384 ! -- van Leer -- 1385 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1386 ! -- ospre -- 1387 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1388 ! -- koren -- 1389 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1390 ! -- charm -- 1391 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1392 !ELSE ; zpsi = 0. 1393 !ENDIF 1394 ! -- van albada 1 -- 1395 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1396 ! -- smart -- 1397 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1398 ! -- umist -- 1399 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1400 1401 ! high order flux corrected by the limiter 1402 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5 1403 1404 ENDIF 1405 END_2D 1513 1406 END DO 1514 1407 CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.) ! lateral boundary cond. … … 1544 1437 DO jl = 1, jpl 1545 1438 1546 DO jj = 1, jpj 1547 DO ji = 1, jpi 1548 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1439 DO_2D_11_11 1440 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1441 ! 1442 ! ! -- check h_ip -- ! 1443 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1444 IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1445 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1446 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 1447 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 1448 ENDIF 1449 ENDIF 1450 ! 1451 ! ! -- check h_i -- ! 1452 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 1453 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 1454 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1455 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 1456 ENDIF 1457 ! 1458 ! ! -- check h_s -- ! 1459 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 1460 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 1461 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1462 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 1549 1463 ! 1550 ! ! -- check h_ip -- ! 1551 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1552 IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1553 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1554 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 1555 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 1556 ENDIF 1557 ENDIF 1464 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 1465 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1558 1466 ! 1559 ! ! -- check h_i -- ! 1560 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 1561 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 1562 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1563 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 1564 ENDIF 1565 ! 1566 ! ! -- check h_s -- ! 1567 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 1568 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 1569 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1570 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 1571 ! 1572 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 1573 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1574 ! 1575 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1576 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1577 ENDIF 1578 ! 1579 ENDIF 1580 END DO 1581 END DO 1467 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1468 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1469 ENDIF 1470 ! 1471 ENDIF 1472 END_2D 1582 1473 END DO 1583 1474 ! … … 1612 1503 ! -- check snow load -- ! 1613 1504 DO jl = 1, jpl 1614 DO jj = 1, jpj 1615 DO ji = 1, jpi 1616 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1617 ! 1618 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 1619 ! 1620 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 1621 ! put snow excess in the ocean 1622 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 1623 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 1624 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1625 ! correct snow volume and heat content 1626 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1627 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 1628 ENDIF 1629 ! 1505 DO_2D_11_11 1506 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1507 ! 1508 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 1509 ! 1510 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 1511 ! put snow excess in the ocean 1512 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 1513 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 1514 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1515 ! correct snow volume and heat content 1516 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1517 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 1630 1518 ENDIF 1631 END DO 1632 END DO 1519 ! 1520 ENDIF 1521 END_2D 1633 1522 END DO 1634 1523 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_rdgrft.F90
r12236 r12340 75 75 REAL(wp) :: rn_fpndrft ! fractional pond loss to the ocean during rafting 76 76 ! 77 !! * Substitutions 78 # include "do_loop_substitute.h90" 77 79 !!---------------------------------------------------------------------- 78 80 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 159 161 npti = 0 ; nptidx(:) = 0 160 162 ipti = 0 ; iptidx(:) = 0 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 IF ( at_i(ji,jj) > epsi10 ) THEN 164 npti = npti + 1 165 nptidx( npti ) = (jj - 1) * jpi + ji 166 ENDIF 167 END DO 168 END DO 163 DO_2D_11_11 164 IF ( at_i(ji,jj) > epsi10 ) THEN 165 npti = npti + 1 166 nptidx( npti ) = (jj - 1) * jpi + ji 167 ENDIF 168 END_2D 169 169 170 170 !-------------------------------------------------------- … … 766 766 ! !--------------------------------------------------! 767 767 CASE( 1 ) !--- Spatial smoothing 768 DO jj = 2, jpjm1 769 DO ji = 2, jpim1 770 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 771 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 772 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & 773 & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 774 & ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 775 ELSE 776 zworka(ji,jj) = 0._wp 777 ENDIF 778 END DO 779 END DO 768 DO_2D_00_00 769 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 770 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 771 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & 772 & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 773 & ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 774 ELSE 775 zworka(ji,jj) = 0._wp 776 ENDIF 777 END_2D 780 778 781 DO jj = 2, jpjm1 782 DO ji = 2, jpim1 783 strength(ji,jj) = zworka(ji,jj) 784 END DO 785 END DO 779 DO_2D_00_00 780 strength(ji,jj) = zworka(ji,jj) 781 END_2D 786 782 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 787 783 ! … … 792 788 ENDIF 793 789 ! 794 DO jj = 2, jpjm1 795 DO ji = 2, jpim1 796 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 797 itframe = 1 ! number of time steps for the running mean 798 IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 799 IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 800 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 801 zstrp2 (ji,jj) = zstrp1 (ji,jj) 802 zstrp1 (ji,jj) = strength(ji,jj) 803 strength(ji,jj) = zp 804 ENDIF 805 END DO 806 END DO 790 DO_2D_00_00 791 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 792 itframe = 1 ! number of time steps for the running mean 793 IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 794 IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 795 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 796 zstrp2 (ji,jj) = zstrp1 (ji,jj) 797 zstrp1 (ji,jj) = strength(ji,jj) 798 strength(ji,jj) = zp 799 ENDIF 800 END_2D 807 801 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 808 802 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_rhg_evp.F90
r12236 r12340 49 49 !! * Substitutions 50 50 # include "vectopt_loop_substitute.h90" 51 # include "do_loop_substitute.h90" 51 52 !!---------------------------------------------------------------------- 52 53 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 180 181 !------------------------------------------------------------------------------! 181 182 ! ocean/land mask 182 DO jj = 1, jpjm1 183 DO ji = 1, jpim1 ! NO vector opt. 184 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 185 END DO 186 END DO 183 DO_2D_10_10 184 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 185 END_2D 187 186 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 188 187 189 188 ! Lateral boundary conditions on velocity (modify zfmask) 190 189 zwf(:,:) = zfmask(:,:) 191 DO jj = 2, jpjm1 192 DO ji = fs_2, fs_jpim1 ! vector opt. 193 IF( zfmask(ji,jj) == 0._wp ) THEN 194 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 195 ENDIF 196 END DO 197 END DO 190 DO_2D_00_00 191 IF( zfmask(ji,jj) == 0._wp ) THEN 192 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 193 ENDIF 194 END_2D 198 195 DO jj = 2, jpjm1 199 196 IF( zfmask(1,jj) == 0._wp ) THEN … … 257 254 zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 258 255 259 DO jj = 2, jpjm1 260 DO ji = fs_2, fs_jpim1 261 262 ! ice fraction at U-V points 263 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 264 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 265 266 ! Ice/snow mass at U-V points 267 zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) ) 268 zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) ) 269 zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) ) 270 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 271 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 272 273 ! Ocean currents at U-V points 274 v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 275 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 276 277 ! Coriolis at T points (m*f) 278 zmf(ji,jj) = zm1 * ff_t(ji,jj) 279 280 ! dt/m at T points (for alpha and beta coefficients) 281 zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) 282 283 ! m/dt 284 zmU_t(ji,jj) = zmassU * z1_dtevp 285 zmV_t(ji,jj) = zmassV * z1_dtevp 286 287 ! Drag ice-atm. 288 ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 289 ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 290 291 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 292 zspgU(ji,jj) = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 293 zspgV(ji,jj) = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 294 295 ! masks 296 zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 297 zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 298 299 ! switches 300 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; zmsk01x(ji,jj) = 0._wp 301 ELSE ; zmsk01x(ji,jj) = 1._wp ; ENDIF 302 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; zmsk01y(ji,jj) = 0._wp 303 ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF 304 305 END DO 306 END DO 256 DO_2D_00_00 257 258 ! ice fraction at U-V points 259 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 260 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 261 262 ! Ice/snow mass at U-V points 263 zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) ) 264 zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) ) 265 zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) ) 266 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 267 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 268 269 ! Ocean currents at U-V points 270 v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 271 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 272 273 ! Coriolis at T points (m*f) 274 zmf(ji,jj) = zm1 * ff_t(ji,jj) 275 276 ! dt/m at T points (for alpha and beta coefficients) 277 zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) 278 279 ! m/dt 280 zmU_t(ji,jj) = zmassU * z1_dtevp 281 zmV_t(ji,jj) = zmassV * z1_dtevp 282 283 ! Drag ice-atm. 284 ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 285 ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 286 287 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 288 zspgU(ji,jj) = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 289 zspgV(ji,jj) = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 290 291 ! masks 292 zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 293 zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 294 295 ! switches 296 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; zmsk01x(ji,jj) = 0._wp 297 ELSE ; zmsk01x(ji,jj) = 1._wp ; ENDIF 298 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; zmsk01y(ji,jj) = 0._wp 299 ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF 300 301 END_2D 307 302 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. ) 308 303 ! … … 310 305 ! 311 306 IF( ln_landfast_L16 ) THEN !-- Lemieux 2016 312 DO jj = 2, jpjm1 313 DO ji = fs_2, fs_jpim1 314 ! ice thickness at U-V points 315 zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 316 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 317 ! ice-bottom stress at U points 318 zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm) 319 ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 320 ! ice-bottom stress at V points 321 zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm) 322 ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 323 ! ice_bottom stress at T points 324 zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj) 325 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 326 END DO 327 END DO 307 DO_2D_00_00 308 ! ice thickness at U-V points 309 zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 310 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 311 ! ice-bottom stress at U points 312 zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm) 313 ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 314 ! ice-bottom stress at V points 315 zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm) 316 ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 317 ! ice_bottom stress at T points 318 zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj) 319 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 320 END_2D 328 321 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 329 322 ! 330 323 ELSE !-- no landfast 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 333 ztaux_base(ji,jj) = 0._wp 334 ztauy_base(ji,jj) = 0._wp 335 END DO 336 END DO 324 DO_2D_00_00 325 ztaux_base(ji,jj) = 0._wp 326 ztauy_base(ji,jj) = 0._wp 327 END_2D 337 328 ENDIF 338 329 … … 354 345 355 346 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 356 DO jj = 1, jpjm1 ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 357 DO ji = 1, jpim1 358 359 ! shear at F points 360 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 361 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 362 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 363 364 END DO 365 END DO 347 DO_2D_10_10 348 349 ! shear at F points 350 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 351 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 352 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 353 354 END_2D 366 355 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 367 356 368 DO jj = 2, jpj ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 369 DO ji = 2, jpi ! no vector loop 370 371 ! shear**2 at T points (doc eq. A16) 372 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 373 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 374 & ) * 0.25_wp * r1_e1e2t(ji,jj) 375 376 ! divergence at T points 377 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 378 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 379 & ) * r1_e1e2t(ji,jj) 380 zdiv2 = zdiv * zdiv 381 382 ! tension at T points 383 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 384 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 385 & ) * r1_e1e2t(ji,jj) 386 zdt2 = zdt * zdt 387 388 ! delta at T points 389 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 390 391 ! P/delta at T points 392 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 393 394 ! alpha & beta for aEVP 395 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 396 ! alpha = beta = sqrt(4*gamma) 397 IF( ln_aEVP ) THEN 398 zalph1 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 399 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 400 zalph2 = zalph1 401 z1_alph2 = z1_alph1 402 ENDIF 403 404 ! stress at T points (zkt/=0 if landfast) 405 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 406 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 407 408 END DO 409 END DO 357 DO_2D_01_01 358 359 ! shear**2 at T points (doc eq. A16) 360 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 361 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 362 & ) * 0.25_wp * r1_e1e2t(ji,jj) 363 364 ! divergence at T points 365 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 366 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 367 & ) * r1_e1e2t(ji,jj) 368 zdiv2 = zdiv * zdiv 369 370 ! tension at T points 371 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 372 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 373 & ) * r1_e1e2t(ji,jj) 374 zdt2 = zdt * zdt 375 376 ! delta at T points 377 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 378 379 ! P/delta at T points 380 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 381 382 ! alpha & beta for aEVP 383 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 384 ! alpha = beta = sqrt(4*gamma) 385 IF( ln_aEVP ) THEN 386 zalph1 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 387 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 388 zalph2 = zalph1 389 z1_alph2 = z1_alph1 390 ENDIF 391 392 ! stress at T points (zkt/=0 if landfast) 393 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 394 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 395 396 END_2D 410 397 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 411 398 412 DO jj = 1, jpjm1 413 DO ji = 1, jpim1 414 415 ! alpha & beta for aEVP 416 IF( ln_aEVP ) THEN 417 zalph2 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 418 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 419 zbeta(ji,jj) = zalph2 420 ENDIF 421 422 ! P/delta at F points 423 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 424 425 ! stress at F points (zkt/=0 if landfast) 426 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 427 428 END DO 429 END DO 399 DO_2D_10_10 400 401 ! alpha & beta for aEVP 402 IF( ln_aEVP ) THEN 403 zalph2 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 404 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 405 zbeta(ji,jj) = zalph2 406 ENDIF 407 408 ! P/delta at F points 409 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 410 411 ! stress at F points (zkt/=0 if landfast) 412 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 413 414 END_2D 430 415 431 416 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 432 DO jj = 2, jpjm1 433 DO ji = fs_2, fs_jpim1 434 ! !--- U points 435 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 436 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 437 & ) * r1_e2u(ji,jj) & 438 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 439 & ) * 2._wp * r1_e1u(ji,jj) & 440 & ) * r1_e1e2u(ji,jj) 441 ! 442 ! !--- V points 443 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 444 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 445 & ) * r1_e1v(ji,jj) & 446 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 447 & ) * 2._wp * r1_e2v(ji,jj) & 448 & ) * r1_e1e2v(ji,jj) 449 ! 450 ! !--- ice currents at U-V point 451 v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 452 u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 453 ! 454 END DO 455 END DO 417 DO_2D_00_00 418 ! !--- U points 419 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 420 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 421 & ) * r1_e2u(ji,jj) & 422 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 423 & ) * 2._wp * r1_e1u(ji,jj) & 424 & ) * r1_e1e2u(ji,jj) 425 ! 426 ! !--- V points 427 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 428 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 429 & ) * r1_e1v(ji,jj) & 430 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 431 & ) * 2._wp * r1_e2v(ji,jj) & 432 & ) * r1_e1e2v(ji,jj) 433 ! 434 ! !--- ice currents at U-V point 435 v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 436 u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 437 ! 438 END_2D 456 439 ! 457 440 ! --- Computation of ice velocity --- ! … … 460 443 IF( MOD(jter,2) == 0 ) THEN ! even iterations 461 444 ! 462 DO jj = 2, jpjm1 463 DO ji = fs_2, fs_jpim1 464 ! !--- tau_io/(v_oce - v_ice) 465 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 466 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 467 ! !--- Ocean-to-Ice stress 468 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 469 ! 470 ! !--- tau_bottom/v_ice 471 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 472 zTauB = ztauy_base(ji,jj) / zvel 473 ! !--- OceanBottom-to-Ice stress 474 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 475 ! 476 ! !--- Coriolis at V-points (energy conserving formulation) 477 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 478 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 479 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 480 ! 481 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 482 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 483 ! 484 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 485 ! 1 = sliding friction : TauB < RHS 486 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 487 ! 488 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 489 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 490 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 491 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 492 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 493 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 494 & ) * zmsk00y(ji,jj) 495 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 496 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 497 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 498 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 499 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 500 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 501 & ) * zmsk00y(ji,jj) 502 ENDIF 503 END DO 504 END DO 445 DO_2D_00_00 446 ! !--- tau_io/(v_oce - v_ice) 447 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 448 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 449 ! !--- Ocean-to-Ice stress 450 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 451 ! 452 ! !--- tau_bottom/v_ice 453 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 454 zTauB = ztauy_base(ji,jj) / zvel 455 ! !--- OceanBottom-to-Ice stress 456 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 457 ! 458 ! !--- Coriolis at V-points (energy conserving formulation) 459 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 460 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 461 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 462 ! 463 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 464 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 465 ! 466 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 467 ! 1 = sliding friction : TauB < RHS 468 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 469 ! 470 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 471 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 472 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 473 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 474 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 475 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 476 & ) * zmsk00y(ji,jj) 477 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 478 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 479 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 480 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 481 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 482 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 483 & ) * zmsk00y(ji,jj) 484 ENDIF 485 END_2D 505 486 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 506 487 ! … … 511 492 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 512 493 ! 513 DO jj = 2, jpjm1 514 DO ji = fs_2, fs_jpim1 515 ! !--- tau_io/(u_oce - u_ice) 516 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 517 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 518 ! !--- Ocean-to-Ice stress 519 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 520 ! 521 ! !--- tau_bottom/u_ice 522 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 523 zTauB = ztaux_base(ji,jj) / zvel 524 ! !--- OceanBottom-to-Ice stress 525 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 526 ! 527 ! !--- Coriolis at U-points (energy conserving formulation) 528 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 529 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 530 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 531 ! 532 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 533 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 534 ! 535 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 536 ! 1 = sliding friction : TauB < RHS 537 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 538 ! 539 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 540 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 541 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 542 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 543 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 544 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 545 & ) * zmsk00x(ji,jj) 546 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 547 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 548 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 549 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 550 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 551 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 552 & ) * zmsk00x(ji,jj) 553 ENDIF 554 END DO 555 END DO 494 DO_2D_00_00 495 ! !--- tau_io/(u_oce - u_ice) 496 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 497 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 498 ! !--- Ocean-to-Ice stress 499 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 500 ! 501 ! !--- tau_bottom/u_ice 502 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 503 zTauB = ztaux_base(ji,jj) / zvel 504 ! !--- OceanBottom-to-Ice stress 505 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 506 ! 507 ! !--- Coriolis at U-points (energy conserving formulation) 508 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 509 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 510 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 511 ! 512 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 513 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 514 ! 515 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 516 ! 1 = sliding friction : TauB < RHS 517 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 518 ! 519 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 520 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 521 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 522 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 523 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 524 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 525 & ) * zmsk00x(ji,jj) 526 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 527 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 528 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 529 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 530 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 531 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 532 & ) * zmsk00x(ji,jj) 533 ENDIF 534 END_2D 556 535 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 557 536 ! … … 564 543 ELSE ! odd iterations 565 544 ! 566 DO jj = 2, jpjm1 567 DO ji = fs_2, fs_jpim1 568 ! !--- tau_io/(u_oce - u_ice) 569 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 570 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 571 ! !--- Ocean-to-Ice stress 572 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 573 ! 574 ! !--- tau_bottom/u_ice 575 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 576 zTauB = ztaux_base(ji,jj) / zvel 577 ! !--- OceanBottom-to-Ice stress 578 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 579 ! 580 ! !--- Coriolis at U-points (energy conserving formulation) 581 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 582 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 583 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 584 ! 585 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 586 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 587 ! 588 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 589 ! 1 = sliding friction : TauB < RHS 590 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 591 ! 592 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 593 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 594 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 595 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 596 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 597 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 598 & ) * zmsk00x(ji,jj) 599 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 600 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 601 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 602 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 603 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 604 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 605 & ) * zmsk00x(ji,jj) 606 ENDIF 607 END DO 608 END DO 545 DO_2D_00_00 546 ! !--- tau_io/(u_oce - u_ice) 547 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 548 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 549 ! !--- Ocean-to-Ice stress 550 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 551 ! 552 ! !--- tau_bottom/u_ice 553 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 554 zTauB = ztaux_base(ji,jj) / zvel 555 ! !--- OceanBottom-to-Ice stress 556 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 557 ! 558 ! !--- Coriolis at U-points (energy conserving formulation) 559 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 560 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 561 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 562 ! 563 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 564 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 565 ! 566 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 567 ! 1 = sliding friction : TauB < RHS 568 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 569 ! 570 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 571 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 572 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 573 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 574 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 575 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 576 & ) * zmsk00x(ji,jj) 577 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 578 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 579 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 580 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 581 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 582 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 583 & ) * zmsk00x(ji,jj) 584 ENDIF 585 END_2D 609 586 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 610 587 ! … … 615 592 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 616 593 ! 617 DO jj = 2, jpjm1 618 DO ji = fs_2, fs_jpim1 619 ! !--- tau_io/(v_oce - v_ice) 620 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 621 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 622 ! !--- Ocean-to-Ice stress 623 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 624 ! 625 ! !--- tau_bottom/v_ice 626 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 627 zTauB = ztauy_base(ji,jj) / zvel 628 ! !--- OceanBottom-to-Ice stress 629 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 630 ! 631 ! !--- Coriolis at v-points (energy conserving formulation) 632 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 633 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 634 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 635 ! 636 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 637 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 638 ! 639 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 640 ! 1 = sliding friction : TauB < RHS 641 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 642 ! 643 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 644 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 645 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 646 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 647 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 648 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 649 & ) * zmsk00y(ji,jj) 650 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 651 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 652 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 653 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 654 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 655 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 656 & ) * zmsk00y(ji,jj) 657 ENDIF 658 END DO 659 END DO 594 DO_2D_00_00 595 ! !--- tau_io/(v_oce - v_ice) 596 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 597 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 598 ! !--- Ocean-to-Ice stress 599 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 600 ! 601 ! !--- tau_bottom/v_ice 602 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 603 zTauB = ztauy_base(ji,jj) / zvel 604 ! !--- OceanBottom-to-Ice stress 605 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 606 ! 607 ! !--- Coriolis at v-points (energy conserving formulation) 608 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 609 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 610 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 611 ! 612 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 613 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 614 ! 615 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 616 ! 1 = sliding friction : TauB < RHS 617 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 618 ! 619 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 620 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 621 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 622 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 623 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 624 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 625 & ) * zmsk00y(ji,jj) 626 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 627 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 628 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 629 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 630 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 631 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 632 & ) * zmsk00y(ji,jj) 633 ENDIF 634 END_2D 660 635 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 661 636 ! … … 683 658 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 684 659 !------------------------------------------------------------------------------! 685 DO jj = 1, jpjm1 686 DO ji = 1, jpim1 687 688 ! shear at F points 689 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 690 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 691 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 692 693 END DO 694 END DO 660 DO_2D_10_10 661 662 ! shear at F points 663 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 664 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 665 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 666 667 END_2D 695 668 696 DO jj = 2, jpjm1 697 DO ji = 2, jpim1 ! no vector loop 698 699 ! tension**2 at T points 700 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 701 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 702 & ) * r1_e1e2t(ji,jj) 703 zdt2 = zdt * zdt 704 705 ! shear**2 at T points (doc eq. A16) 706 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 707 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 708 & ) * 0.25_wp * r1_e1e2t(ji,jj) 709 710 ! shear at T points 711 pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 712 713 ! divergence at T points 714 pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 715 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 716 & ) * r1_e1e2t(ji,jj) 717 718 ! delta at T points 719 zdelta = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 720 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 721 pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 722 723 END DO 724 END DO 669 DO_2D_00_00 670 671 ! tension**2 at T points 672 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 673 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 674 & ) * r1_e1e2t(ji,jj) 675 zdt2 = zdt * zdt 676 677 ! shear**2 at T points (doc eq. A16) 678 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 679 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 680 & ) * 0.25_wp * r1_e1e2t(ji,jj) 681 682 ! shear at T points 683 pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 684 685 ! divergence at T points 686 pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 687 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 688 & ) * r1_e1e2t(ji,jj) 689 690 ! delta at T points 691 zdelta = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 692 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 693 pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 694 695 END_2D 725 696 CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 726 697 … … 735 706 ! 5) diagnostics 736 707 !------------------------------------------------------------------------------! 737 DO jj = 1, jpj 738 DO ji = 1, jpi 739 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 740 END DO 741 END DO 708 DO_2D_11_11 709 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 710 END_2D 742 711 743 712 ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! … … 766 735 ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 767 736 ! 768 DO jj = 2, jpjm1 769 DO ji = 2, jpim1 770 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 771 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 772 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 773 774 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 775 776 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 737 DO_2D_00_00 738 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 739 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 740 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 741 742 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 743 744 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 777 745 778 746 !! zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) … … 780 748 !! zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress 781 749 !! ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11)) 782 zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) ) ! compressive stress, see Bouillon et al. 2015 783 zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear ) ! shear stress 784 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 785 END DO 786 END DO 750 zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) ) ! compressive stress, see Bouillon et al. 2015 751 zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear ) ! shear stress 752 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 753 END_2D 787 754 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 788 755 ! … … 819 786 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 820 787 ! 821 DO jj = 2, jpjm1 822 DO ji = 2, jpim1 823 ! 2D ice mass, snow mass, area transport arrays (X, Y) 824 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 825 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 826 827 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 828 zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) ! '' Y- '' 829 830 zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 831 zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) ! '' Y- '' 832 833 zdiag_xatrp(ji,jj) = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) ) ! area transport, X-component 834 zdiag_yatrp(ji,jj) = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) ) ! '' Y- '' 835 836 END DO 837 END DO 788 DO_2D_00_00 789 ! 2D ice mass, snow mass, area transport arrays (X, Y) 790 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 791 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 792 793 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 794 zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) ! '' Y- '' 795 796 zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 797 zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) ! '' Y- '' 798 799 zdiag_xatrp(ji,jj) = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) ) ! area transport, X-component 800 zdiag_yatrp(ji,jj) = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) ) ! '' Y- '' 801 802 END_2D 838 803 839 804 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/iceistate.F90
r11960 r12340 61 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 62 62 ! 63 !! * Substitutions 64 # include "do_loop_substitute.h90" 63 65 !!---------------------------------------------------------------------- 64 66 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 269 271 ! select ice covered grid points 270 272 npti = 0 ; nptidx(:) = 0 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 274 npti = npti + 1 275 nptidx(npti) = (jj - 1) * jpi + ji 276 ENDIF 277 END DO 278 END DO 273 DO_2D_11_11 274 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 275 npti = npti + 1 276 nptidx(npti) = (jj - 1) * jpi + ji 277 ENDIF 278 END_2D 279 279 280 280 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) … … 321 321 CALL ice_var_salprof ! for sz_i 322 322 DO jl = 1, jpl 323 DO jj = 1, jpj 324 DO ji = 1, jpi 325 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 326 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 327 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 328 END DO 329 END DO 323 DO_2D_11_11 324 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 325 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 326 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 327 END_2D 330 328 END DO 331 329 ! 332 330 DO jl = 1, jpl 333 DO jk = 1, nlay_s 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 337 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 338 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 339 END DO 340 END DO 341 END DO 331 DO_3D_11_11( 1, nlay_s ) 332 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 333 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 334 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 335 END_3D 342 336 END DO 343 337 ! 344 338 DO jl = 1, jpl 345 DO jk = 1, nlay_i 346 DO jj = 1, jpj 347 DO ji = 1, jpi 348 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 349 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 350 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 351 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 352 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 353 & - rcp * ( ztmelts - rt0 ) ) 354 END DO 355 END DO 356 END DO 339 DO_3D_11_11( 1, nlay_i ) 340 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 341 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 342 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 343 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 344 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 345 & - rcp * ( ztmelts - rt0 ) ) 346 END_3D 357 347 END DO 358 348 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/iceitd.F90
r11960 r12340 48 48 REAL(wp), DIMENSION(0:100) :: rn_catbnd ! ice categories bounds 49 49 ! 50 !! * Substitutions 51 # include "do_loop_substitute.h90" 50 52 !!---------------------------------------------------------------------- 51 53 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 96 98 ! 97 99 npti = 0 ; nptidx(:) = 0 98 DO jj = 1, jpj 99 DO ji = 1, jpi 100 IF ( at_i(ji,jj) > epsi10 ) THEN 101 npti = npti + 1 102 nptidx( npti ) = (jj - 1) * jpi + ji 103 ENDIF 104 END DO 105 END DO 100 DO_2D_11_11 101 IF ( at_i(ji,jj) > epsi10 ) THEN 102 npti = npti + 1 103 nptidx( npti ) = (jj - 1) * jpi + ji 104 ENDIF 105 END_2D 106 106 107 107 !----------------------------------------------------------------------------------------------- … … 597 597 ! !--------------------------------------- 598 598 npti = 0 ; nptidx(:) = 0 599 DO jj = 1, jpj 600 DO ji = 1, jpi 601 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 602 npti = npti + 1 603 nptidx( npti ) = (jj - 1) * jpi + ji 604 ENDIF 605 END DO 606 END DO 599 DO_2D_11_11 600 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 601 npti = npti + 1 602 nptidx( npti ) = (jj - 1) * jpi + ji 603 ENDIF 604 END_2D 607 605 ! 608 606 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) … … 638 636 ! !----------------------------------------- 639 637 npti = 0 ; nptidx(:) = 0 640 DO jj = 1, jpj 641 DO ji = 1, jpi 642 IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 643 npti = npti + 1 644 nptidx( npti ) = (jj - 1) * jpi + ji 645 ENDIF 646 END DO 647 END DO 638 DO_2D_11_11 639 IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 640 npti = npti + 1 641 nptidx( npti ) = (jj - 1) * jpi + ji 642 ENDIF 643 END_2D 648 644 ! 649 645 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icesbc.F90
r12182 r12340 38 38 !! * Substitutions 39 39 # include "vectopt_loop_substitute.h90" 40 # include "do_loop_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 42 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 82 83 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 83 84 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 84 DO jj = 2, jpjm1 85 DO ji = 2, jpim1 86 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 87 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 88 END DO 89 END DO 85 DO_2D_00_00 86 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 87 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 88 END_2D 90 89 CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 91 90 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icethd.F90
r12236 r12340 54 54 !! * Substitutions 55 55 # include "vectopt_loop_substitute.h90" 56 # include "do_loop_substitute.h90" 56 57 !!---------------------------------------------------------------------- 57 58 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 109 110 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 110 111 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 111 DO jj = 2, jpjm1 112 DO ji = fs_2, fs_jpim1 113 zfric(ji,jj) = rn_cio * ( 0.5_wp * & 114 & ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 115 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 116 END DO 117 END DO 112 DO_2D_00_00 113 zfric(ji,jj) = rn_cio * ( 0.5_wp * & 114 & ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 115 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 116 END_2D 118 117 ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean 119 DO jj = 2, jpjm1 120 DO ji = fs_2, fs_jpim1 121 zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * & 122 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 123 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 124 END DO 125 END DO 118 DO_2D_00_00 119 zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * & 120 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 121 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 122 END_2D 126 123 ENDIF 127 124 CALL lbc_lnk( 'icethd', zfric, 'T', 1. ) … … 130 127 ! Partial computation of forcing for the thermodynamic sea ice model 131 128 !--------------------------------------------------------------------! 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 135 ! 136 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 137 ! ! practically no "direct lateral ablation" 138 ! 139 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 140 ! ! temperature and turbulent mixing (McPhee, 1992) 141 ! 142 ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 143 zqld = tmask(ji,jj,1) * rdt_ice * & 144 & ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + & 145 & ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 146 147 ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 148 zqfr = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 149 zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0 150 151 ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 152 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 153 qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 154 155 qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 156 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 157 ! the freezing point, so that we do not have SST < T_freeze 158 ! This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 159 160 !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 161 qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 162 163 ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 164 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 165 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 166 fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 167 qlead(ji,jj) = 0._wp 168 ELSE 169 fhld (ji,jj) = 0._wp 170 ENDIF 171 ! 172 ! Net heat flux on top of the ice-ocean [W.m-2] 173 ! --------------------------------------------- 174 qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 175 END DO 176 END DO 129 DO_2D_11_11 130 rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 131 ! 132 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 133 ! ! practically no "direct lateral ablation" 134 ! 135 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 136 ! ! temperature and turbulent mixing (McPhee, 1992) 137 ! 138 ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 139 zqld = tmask(ji,jj,1) * rdt_ice * & 140 & ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + & 141 & ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 142 143 ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 144 zqfr = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 145 zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0 146 147 ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 148 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 149 qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 150 151 qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 152 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 153 ! the freezing point, so that we do not have SST < T_freeze 154 ! This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 155 156 !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 157 qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 158 159 ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 160 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 161 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 162 fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 163 qlead(ji,jj) = 0._wp 164 ELSE 165 fhld (ji,jj) = 0._wp 166 ENDIF 167 ! 168 ! Net heat flux on top of the ice-ocean [W.m-2] 169 ! --------------------------------------------- 170 qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 171 END_2D 177 172 178 173 ! In case we bypass open-water ice formation … … 202 197 ! select ice covered grid points 203 198 npti = 0 ; nptidx(:) = 0 204 DO jj = 1, jpj 205 DO ji = 1, jpi 206 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 207 npti = npti + 1 208 nptidx(npti) = (jj - 1) * jpi + ji 209 ENDIF 210 END DO 211 END DO 199 DO_2D_11_11 200 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 201 npti = npti + 1 202 nptidx(npti) = (jj - 1) * jpi + ji 203 ENDIF 204 END_2D 212 205 213 206 IF( npti > 0 ) THEN ! If there is no ice, do nothing. -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icethd_do.F90
r11960 r12340 44 44 REAL(wp) :: rn_Cfraz ! squeezing coefficient for collection of bottom frazil ice 45 45 46 !! * Substitutions 47 # include "do_loop_substitute.h90" 46 48 !!---------------------------------------------------------------------- 47 49 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 143 145 zgamafr = 0.03 144 146 ! 145 DO jj = 2, jpjm1 146 DO ji = 2, jpim1 147 IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 148 ! -- Wind stress -- ! 149 ztaux = ( utau_ice(ji-1,jj ) * umask(ji-1,jj ,1) & 150 & + utau_ice(ji ,jj ) * umask(ji ,jj ,1) ) * 0.5_wp