Changeset 13540 for NEMO/branches/2020/r12377_ticket2386/src/ICE/iceitd.F90
- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/ICE/iceitd.F90
r12377 r13540 47 47 LOGICAL :: ln_cat_usr ! ice categories are defined by rn_catbnd 48 48 REAL(wp), DIMENSION(0:100) :: rn_catbnd ! ice categories bounds 49 REAL(wp) :: rn_himax ! maximum ice thickness allowed 49 50 ! 50 51 !! * Substitutions … … 98 99 ! 99 100 npti = 0 ; nptidx(:) = 0 100 DO_2D _11_11101 DO_2D( 1, 1, 1, 1 ) 101 102 IF ( at_i(ji,jj) > epsi10 ) THEN 102 103 npti = npti + 1 … … 148 149 ! Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 149 150 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 151 # if defined key_single 152 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi06 ) ) nptidx(ji) = 0 153 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi06 ) ) nptidx(ji) = 0 154 # else 150 155 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi10 ) ) nptidx(ji) = 0 151 156 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) ) nptidx(ji) = 0 157 # endif 152 158 ! 153 159 ! 2) Hn-1 < Hn* < Hn+1 … … 170 176 ! h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 171 177 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 178 # if defined key_single 179 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi06 ) ) nptidx(ji) = 0 180 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi06 ) ) nptidx(ji) = 0 181 # else 172 182 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) ) nptidx(ji) = 0 173 183 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) ) nptidx(ji) = 0 184 # endif 174 185 END DO 175 186 ! … … 304 315 IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 305 316 a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 306 IF( ln_pnd_ H12) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin317 IF( ln_pnd_LEV ) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 307 318 h_i_1d(ji) = rn_himin 308 319 ENDIF … … 410 421 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 411 422 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 423 CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 412 424 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 413 425 DO jl = 1, jpl … … 474 486 zaTsfn(ji,jl2) = zaTsfn(ji,jl2) + ztrans 475 487 ! 476 IF ( ln_pnd_ H12) THEN488 IF ( ln_pnd_LEV ) THEN 477 489 ztrans = a_ip_2d(ji,jl1) * zworka(ji) ! Pond fraction 478 490 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans … … 482 494 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 483 495 v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 496 ! 497 IF ( ln_pnd_lids ) THEN ! Pond lid volume 498 ztrans = v_il_2d(ji,jl1) * zworka(ji) 499 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 500 v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 501 ENDIF 484 502 ENDIF 485 503 ! … … 526 544 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 527 545 ! because of truncation error ( i.e. 1. - 1. /= 0 ) 528 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 )546 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, v_il_2d, ze_s_2d, ze_i_2d ) 529 547 530 548 ! at_i must be <= rn_amax … … 538 556 ! 4) Update ice thickness and temperature 539 557 !------------------------------------------------------------------------------- 558 # if defined key_single 559 WHERE( a_i_2d(1:npti,:) >= epsi06 ) 560 # else 540 561 WHERE( a_i_2d(1:npti,:) >= epsi20 ) 562 # endif 541 563 h_i_2d (1:npti,:) = v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 542 564 t_su_2d(1:npti,:) = zaTsfn(1:npti,:) / a_i_2d(1:npti,:) … … 554 576 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 555 577 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 578 CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 556 579 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 557 580 DO jl = 1, jpl … … 597 620 ! !--------------------------------------- 598 621 npti = 0 ; nptidx(:) = 0 599 DO_2D _11_11622 DO_2D( 1, 1, 1, 1 ) 600 623 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 601 624 npti = npti + 1 … … 636 659 ! !----------------------------------------- 637 660 npti = 0 ; nptidx(:) = 0 638 DO_2D _11_11661 DO_2D( 1, 1, 1, 1 ) 639 662 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 663 npti = npti + 1 … … 679 702 REAL(wp) :: zhmax, znum, zden, zalpha ! - - 680 703 ! 681 NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin 704 NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin, rn_himax 682 705 !!------------------------------------------------------------------ 683 706 ! … … 696 719 WRITE(numout,*) ' mean ice thickness in the domain rn_himean = ', rn_himean 697 720 WRITE(numout,*) ' Ice categories are defined by rn_catbnd ln_cat_usr = ', ln_cat_usr 698 WRITE(numout,*) ' minimum ice thickness rn_himin = ', rn_himin 721 WRITE(numout,*) ' minimum ice thickness allowed rn_himin = ', rn_himin 722 WRITE(numout,*) ' maximum ice thickness allowed rn_himax = ', rn_himax 699 723 ENDIF 700 724 ! … … 733 757 END DO 734 758 ! 735 hi_max(jpl) = 99._wp! set to a big value to ensure that all ice is thinner than hi_max(jpl)759 hi_max(jpl) = rn_himax ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 736 760 ! 737 761 IF(lwp) WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.