- Timestamp:
- 2019-09-18T16:11:52+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/ICE/iceitd.F90
r10069 r11564 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 … … 87 88 88 89 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 90 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 89 91 90 92 !----------------------------------------------------------------------------------------------- 91 93 ! 1) Identify grid cells with ice 92 94 !----------------------------------------------------------------------------------------------- 95 at_i(:,:) = SUM( a_i, dim=3 ) 96 ! 93 97 npti = 0 ; nptidx(:) = 0 94 98 DO jj = 1, jpj … … 249 253 ! --- g(h) for each thickness category --- ! 250 254 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) ) ! out255 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR (1:npti,jl) ) ! out 252 256 ! 253 257 END DO … … 313 317 ! 314 318 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 319 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 315 320 ! 316 321 END SUBROUTINE ice_itd_rem … … 389 394 REAL(wp), DIMENSION(:,:), INTENT(in) :: pdvice ! ice volume transferred across boundary 390 395 ! 391 INTEGER :: ji, j j, jl, jk! dummy loop indices392 INTEGER :: ii, ij, jl2, jl1! local integers396 INTEGER :: ji, jl, jk ! dummy loop indices 397 INTEGER :: jl2, jl1 ! local integers 393 398 REAL(wp) :: ztrans ! ice/snow transferred 394 REAL(wp), DIMENSION(jpij) :: zworka, zworkv ! workspace 395 REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - 399 REAL(wp), DIMENSION(jpij) :: zworka, zworkv ! workspace 400 REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - 401 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_2d 402 REAL(wp), DIMENSION(jpij,nlay_s,jpl) :: ze_s_2d 396 403 !!------------------------------------------------------------------ 397 404 … … 405 412 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 406 413 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 414 DO jl = 1, jpl 415 DO jk = 1, nlay_s 416 CALL tab_2d_1d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) ) 417 END DO 418 DO jk = 1, nlay_i 419 CALL tab_2d_1d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 420 END DO 421 END DO 422 ! to correct roundoff errors on a_i 423 CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d ) 407 424 408 425 !---------------------------------------------------------------------------------------------- … … 435 452 ELSE ; zworka(ji) = 0._wp 436 453 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 454 ! 442 455 a_i_2d(ji,jl1) = a_i_2d(ji,jl1) - pdaice(ji,jl) ! Ice areas … … 476 489 ! 477 490 DO jk = 1, nlay_s !--- Snow heat content 478 !479 491 DO ji = 1, npti 480 ii = MOD( nptidx(ji) - 1, jpi ) + 1481 ij = ( nptidx(ji) - 1 ) / jpi + 1482 492 ! 483 493 jl1 = kdonor(ji,jl) … … 487 497 ELSE ; jl2 = jl 488 498 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 499 ztrans = ze_s_2d(ji,jk,jl1) * zworkv(ji) 500 ze_s_2d(ji,jk,jl1) = ze_s_2d(ji,jk,jl1) - ztrans 501 ze_s_2d(ji,jk,jl2) = ze_s_2d(ji,jk,jl2) + ztrans 493 502 ENDIF 494 503 END DO … … 497 506 DO jk = 1, nlay_i !--- Ice heat content 498 507 DO ji = 1, npti 499 ii = MOD( nptidx(ji) - 1, jpi ) + 1500 ij = ( nptidx(ji) - 1 ) / jpi + 1501 508 ! 502 509 jl1 = kdonor(ji,jl) … … 506 513 ELSE ; jl2 = jl 507 514 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 515 ztrans = ze_i_2d(ji,jk,jl1) * zworkv(ji) 516 ze_i_2d(ji,jk,jl1) = ze_i_2d(ji,jk,jl1) - ztrans 517 ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + ztrans 512 518 ENDIF 513 519 END DO … … 515 521 ! 516 522 END DO ! boundaries, 1 to jpl-1 523 524 !------------------- 525 ! 3) roundoff errors 526 !------------------- 527 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 528 ! because of truncation error ( i.e. 1. - 1. /= 0 ) 529 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 ) 530 531 ! at_i must be <= rn_amax 532 zworka(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 ) 533 DO jl = 1, jpl 534 WHERE( zworka(1:npti) > rn_amax_1d(1:npti) ) & 535 & a_i_2d(1:npti,jl) = a_i_2d(1:npti,jl) * rn_amax_1d(1:npti) / zworka(1:npti) 536 END DO 517 537 518 538 !------------------------------------------------------------------------------- 519 ! 3) Update ice thickness and temperature539 ! 4) Update ice thickness and temperature 520 540 !------------------------------------------------------------------------------- 521 541 WHERE( a_i_2d(1:npti,:) >= epsi20 ) … … 536 556 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 537 557 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 558 DO jl = 1, jpl 559 DO jk = 1, nlay_s 560 CALL tab_1d_2d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) ) 561 END DO 562 DO jk = 1, nlay_i 563 CALL tab_1d_2d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 564 END DO 565 END DO 538 566 ! 539 567 END SUBROUTINE itd_shiftice … … 558 586 ! 559 587 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 588 ! 589 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 590 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 560 591 ! 561 592 jdonor(:,:) = 0 … … 635 666 END DO 636 667 ! 668 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 669 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 670 ! 637 671 END SUBROUTINE ice_itd_reb 638 672 … … 655 689 REWIND( numnam_ice_ref ) ! Namelist namitd in reference namelist : Parameters for ice 656 690 READ ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 657 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' , lwp)691 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' ) 658 692 REWIND( numnam_ice_cfg ) ! Namelist namitd in configuration namelist : Parameters for ice 659 693 READ ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 660 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' , lwp)694 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 661 695 IF(lwm) WRITE( numoni, namitd ) 662 696 !
Note: See TracChangeset
for help on using the changeset viewer.
