- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/iceitd.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- 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 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/ICE/iceitd.F90
r10994 r13463 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) … … 88 90 89 91 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 92 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 90 93 91 94 !----------------------------------------------------------------------------------------------- … … 95 98 ! 96 99 npti = 0 ; nptidx(:) = 0 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 IF ( at_i(ji,jj) > epsi10 ) THEN 100 npti = npti + 1 101 nptidx( npti ) = (jj - 1) * jpi + ji 102 ENDIF 103 END DO 104 END DO 100 DO_2D( 1, 1, 1, 1 ) 101 IF ( at_i(ji,jj) > epsi10 ) THEN 102 npti = npti + 1 103 nptidx( npti ) = (jj - 1) * jpi + ji 104 ENDIF 105 END_2D 105 106 106 107 !----------------------------------------------------------------------------------------------- … … 147 148 ! Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 148 149 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 150 # if defined key_single 151 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi06 ) ) nptidx(ji) = 0 152 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi06 ) ) nptidx(ji) = 0 153 # else 149 154 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi10 ) ) nptidx(ji) = 0 150 155 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) ) nptidx(ji) = 0 156 # endif 151 157 ! 152 158 ! 2) Hn-1 < Hn* < Hn+1 … … 169 175 ! h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 170 176 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 177 # if defined key_single 178 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi06 ) ) nptidx(ji) = 0 179 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi06 ) ) nptidx(ji) = 0 180 # else 171 181 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) ) nptidx(ji) = 0 172 182 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) ) nptidx(ji) = 0 183 # endif 173 184 END DO 174 185 ! … … 210 221 CALL itd_glinear( zhb0(1:npti) , zhb1(1:npti) , h_ib_1d(1:npti) , a_i_1d(1:npti) , & ! in 211 222 & g0 (1:npti,1), g1 (1:npti,1), hL (1:npti,1), hR (1:npti,1) ) ! out 212 223 ! 213 224 ! Area lost due to melting of thin ice 214 225 DO ji = 1, npti … … 217 228 ! 218 229 zdh0 = h_i_1d(ji) - h_ib_1d(ji) 219 IF( zdh0 < 0.0 ) THEN ! remove area from category 1230 IF( zdh0 < 0.0 ) THEN ! remove area from category 1 220 231 zdh0 = MIN( -zdh0, hi_max(1) ) 221 232 !Integrate g(1) from 0 to dh0 to estimate area melted … … 225 236 zx1 = zetamax 226 237 zx2 = 0.5 * zetamax * zetamax 227 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 238 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 ! ice area removed 228 239 zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 229 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting 230 ! of thin ice (zdamax > 0) 240 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting of thin ice (zdamax > 0) 231 241 ! Remove area, conserving volume 232 242 h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 ) … … 316 326 ! 317 327 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 328 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 318 329 ! 319 330 END SUBROUTINE ice_itd_rem … … 347 358 DO ji = 1, npti 348 359 ! 349 IF( paice(ji) > epsi10 .AND. phice(ji) > 0._wp) THEN360 IF( paice(ji) > epsi10 .AND. phice(ji) > epsi10 ) THEN 350 361 ! 351 362 ! Initialize hL and hR … … 537 548 ! 4) Update ice thickness and temperature 538 549 !------------------------------------------------------------------------------- 550 # if defined key_single 551 WHERE( a_i_2d(1:npti,:) >= epsi06 ) 552 # else 539 553 WHERE( a_i_2d(1:npti,:) >= epsi20 ) 554 # endif 540 555 h_i_2d (1:npti,:) = v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 541 556 t_su_2d(1:npti,:) = zaTsfn(1:npti,:) / a_i_2d(1:npti,:) … … 586 601 ! 587 602 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 603 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 588 604 ! 589 605 jdonor(:,:) = 0 … … 595 611 ! !--------------------------------------- 596 612 npti = 0 ; nptidx(:) = 0 597 DO jj = 1, jpj 598 DO ji = 1, jpi 599 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 600 npti = npti + 1 601 nptidx( npti ) = (jj - 1) * jpi + ji 602 ENDIF 603 END DO 604 END DO 613 DO_2D( 1, 1, 1, 1 ) 614 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 615 npti = npti + 1 616 nptidx( npti ) = (jj - 1) * jpi + ji 617 ENDIF 618 END_2D 605 619 ! 606 620 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) … … 636 650 ! !----------------------------------------- 637 651 npti = 0 ; nptidx(:) = 0 638 DO jj = 1, jpj 639 DO ji = 1, jpi 640 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 641 npti = npti + 1 642 nptidx( npti ) = (jj - 1) * jpi + ji 643 ENDIF 644 END DO 645 END DO 652 DO_2D( 1, 1, 1, 1 ) 653 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 654 npti = npti + 1 655 nptidx( npti ) = (jj - 1) * jpi + ji 656 ENDIF 657 END_2D 646 658 ! 647 659 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok … … 664 676 ! 665 677 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 678 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 666 679 ! 667 680 END SUBROUTINE ice_itd_reb … … 683 696 !!------------------------------------------------------------------ 684 697 ! 685 REWIND( numnam_ice_ref ) ! Namelist namitd in reference namelist : Parameters for ice686 698 READ ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 687 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 688 REWIND( numnam_ice_cfg ) ! Namelist namitd in configuration namelist : Parameters for ice 699 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' ) 689 700 READ ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 690 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' , lwp)701 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 691 702 IF(lwm) WRITE( numoni, namitd ) 692 703 !
Note: See TracChangeset
for help on using the changeset viewer.
