Changeset 10994 for NEMO/trunk/src/ICE/iceitd.F90
- Timestamp:
- 2019-05-17T15:08:34+02:00 (5 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/iceitd.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/iceitd.F90
r10069 r10994 21 21 USE ice1D ! sea-ice: thermodynamic variables 22 22 USE ice ! sea-ice: variables 23 USE icevar ! sea-ice: operations 23 24 USE icectl ! sea-ice: conservation tests 24 25 USE icetab ! sea-ice: convert 1D<=>2D … … 91 92 ! 1) Identify grid cells with ice 92 93 !----------------------------------------------------------------------------------------------- 94 at_i(:,:) = SUM( a_i, dim=3 ) 95 ! 93 96 npti = 0 ; nptidx(:) = 0 94 97 DO jj = 1, jpj … … 249 252 ! --- g(h) for each thickness category --- ! 250 253 CALL itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti) , a_i_1d(1:npti) , & ! in 251 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR(1:npti,jl) ) ! out254 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR (1:npti,jl) ) ! out 252 255 ! 253 256 END DO … … 389 392 REAL(wp), DIMENSION(:,:), INTENT(in) :: pdvice ! ice volume transferred across boundary 390 393 ! 391 INTEGER :: ji, j j, jl, jk! dummy loop indices392 INTEGER :: ii, ij, jl2, jl1! local integers394 INTEGER :: ji, jl, jk ! dummy loop indices 395 INTEGER :: jl2, jl1 ! local integers 393 396 REAL(wp) :: ztrans ! ice/snow transferred 394 REAL(wp), DIMENSION(jpij) :: zworka, zworkv ! workspace 395 REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - 397 REAL(wp), DIMENSION(jpij) :: zworka, zworkv ! workspace 398 REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - 399 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_2d 400 REAL(wp), DIMENSION(jpij,nlay_s,jpl) :: ze_s_2d 396 401 !!------------------------------------------------------------------ 397 402 … … 405 410 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 406 411 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 412 DO jl = 1, jpl 413 DO jk = 1, nlay_s 414 CALL tab_2d_1d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) ) 415 END DO 416 DO jk = 1, nlay_i 417 CALL tab_2d_1d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 418 END DO 419 END DO 420 ! to correct roundoff errors on a_i 421 CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d ) 407 422 408 423 !---------------------------------------------------------------------------------------------- … … 435 450 ELSE ; zworka(ji) = 0._wp 436 451 ENDIF 437 !438 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20)439 ! because of truncation error ( i.e. 1. - 1. /= 0 )440 ! I do not think it should be a concern since small areas and volumes are erased (in ice_var_zapsmall.F90)441 452 ! 442 453 a_i_2d(ji,jl1) = a_i_2d(ji,jl1) - pdaice(ji,jl) ! Ice areas … … 476 487 ! 477 488 DO jk = 1, nlay_s !--- Snow heat content 478 !479 489 DO ji = 1, npti 480 ii = MOD( nptidx(ji) - 1, jpi ) + 1481 ij = ( nptidx(ji) - 1 ) / jpi + 1482 490 ! 483 491 jl1 = kdonor(ji,jl) … … 487 495 ELSE ; jl2 = jl 488 496 ENDIF 489 ! 490 ztrans = e_s(ii,ij,jk,jl1) * zworkv(ji) 491 e_s(ii,ij,jk,jl1) = e_s(ii,ij,jk,jl1) - ztrans 492 e_s(ii,ij,jk,jl2) = e_s(ii,ij,jk,jl2) + ztrans 497 ztrans = ze_s_2d(ji,jk,jl1) * zworkv(ji) 498 ze_s_2d(ji,jk,jl1) = ze_s_2d(ji,jk,jl1) - ztrans 499 ze_s_2d(ji,jk,jl2) = ze_s_2d(ji,jk,jl2) + ztrans 493 500 ENDIF 494 501 END DO … … 497 504 DO jk = 1, nlay_i !--- Ice heat content 498 505 DO ji = 1, npti 499 ii = MOD( nptidx(ji) - 1, jpi ) + 1500 ij = ( nptidx(ji) - 1 ) / jpi + 1501 506 ! 502 507 jl1 = kdonor(ji,jl) … … 506 511 ELSE ; jl2 = jl 507 512 ENDIF 508 ! 509 ztrans = e_i(ii,ij,jk,jl1) * zworkv(ji) 510 e_i(ii,ij,jk,jl1) = e_i(ii,ij,jk,jl1) - ztrans 511 e_i(ii,ij,jk,jl2) = e_i(ii,ij,jk,jl2) + ztrans 513 ztrans = ze_i_2d(ji,jk,jl1) * zworkv(ji) 514 ze_i_2d(ji,jk,jl1) = ze_i_2d(ji,jk,jl1) - ztrans 515 ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + ztrans 512 516 ENDIF 513 517 END DO … … 515 519 ! 516 520 END DO ! boundaries, 1 to jpl-1 521 522 !------------------- 523 ! 3) roundoff errors 524 !------------------- 525 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 526 ! because of truncation error ( i.e. 1. - 1. /= 0 ) 527 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d ) 528 529 ! at_i must be <= rn_amax 530 zworka(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 ) 531 DO jl = 1, jpl 532 WHERE( zworka(1:npti) > rn_amax_1d(1:npti) ) & 533 & a_i_2d(1:npti,jl) = a_i_2d(1:npti,jl) * rn_amax_1d(1:npti) / zworka(1:npti) 534 END DO 517 535 518 536 !------------------------------------------------------------------------------- 519 ! 3) Update ice thickness and temperature537 ! 4) Update ice thickness and temperature 520 538 !------------------------------------------------------------------------------- 521 539 WHERE( a_i_2d(1:npti,:) >= epsi20 ) … … 536 554 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 537 555 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 556 DO jl = 1, jpl 557 DO jk = 1, nlay_s 558 CALL tab_1d_2d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) ) 559 END DO 560 DO jk = 1, nlay_i 561 CALL tab_1d_2d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 562 END DO 563 END DO 538 564 ! 539 565 END SUBROUTINE itd_shiftice … … 558 584 ! 559 585 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 586 ! 587 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 560 588 ! 561 589 jdonor(:,:) = 0 … … 635 663 END DO 636 664 ! 665 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 666 ! 637 667 END SUBROUTINE ice_itd_reb 638 668
Note: See TracChangeset
for help on using the changeset viewer.
