Changeset 4921 for branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
- Timestamp:
- 2014-11-28T14:59:01+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4333 r4921 6 6 !! History : - ! (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 7 7 !! 3.0 ! 2005-12 (M. Vancoppenolle) adaptation to LIM-3 8 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age and types8 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age 9 9 !! - ! 2007-04 (M. Vancoppenolle) Mass conservation checked 10 10 !!---------------------------------------------------------------------- … … 35 35 USE lib_fortran ! to use key_nosignedzero 36 36 USE timing ! Timing 37 USE limcons ! conservation tests 37 38 38 39 IMPLICIT NONE … … 65 66 INTEGER, INTENT(in) :: kt ! time step index 66 67 ! 67 INTEGER :: j l, ja, jm, jbnd1, jbnd2 ! ice typesdummy loop index68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)69 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)68 INTEGER :: ji, jj, jk, jl ! dummy loop index 69 ! 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 70 71 !!------------------------------------------------------------------ 71 72 IF( nn_timing == 1 ) CALL timing_start('limitd_th') 72 73 73 ! ------------------------------- 74 !- check conservation (C Rousset) 75 IF (ln_limdiahsb) THEN 76 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 77 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 78 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 79 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 80 ENDIF 81 !- check conservation (C Rousset) 82 ! ------------------------------- 74 ! conservation test 75 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 83 76 84 77 IF( kt == nit000 .AND. lwp ) THEN … … 93 86 ! Given thermodynamic growth rates, transport ice between 94 87 ! thickness categories. 95 DO jm = 1, jpm 96 jbnd1 = ice_cat_bounds(jm,1) 97 jbnd2 = ice_cat_bounds(jm,2) 98 IF( ice_ncat_types(jm) > 1 ) CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 99 END DO 88 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 100 89 ! 101 90 CALL lim_var_glo2eqv ! only for info … … 105 94 ! 3) Add frazil ice growing in leads. 106 95 !------------------------------------------------------------------------------| 107 108 96 CALL lim_thd_lac 109 97 CALL lim_var_glo2eqv ! only for info 110 111 IF(ln_ctl) THEN ! Control print98 99 IF(ln_ctl) THEN ! Control print 112 100 CALL prt_ctl_info(' ') 113 101 CALL prt_ctl_info(' - Cell values : ') … … 131 119 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 132 120 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 133 DO j a= 1, nlay_i121 DO jk = 1, nlay_i 134 122 CALL prt_ctl_info(' ') 135 CALL prt_ctl_info(' - Layer : ', ivar1=j a)123 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 136 124 CALL prt_ctl_info(' ~~~~~~~') 137 CALL prt_ctl(tab2d_1=t_i(:,:,j a,jl) , clinfo1= ' lim_itd_th : t_i : ')138 CALL prt_ctl(tab2d_1=e_i(:,:,j a,jl) , clinfo1= ' lim_itd_th : e_i : ')125 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 126 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 139 127 END DO 140 128 END DO 141 129 ENDIF 142 130 ! 143 ! ------------------------------- 144 !- check conservation (C Rousset) 145 IF( ln_limdiahsb ) THEN 146 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 147 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 148 149 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 150 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 151 152 zchk_vmin = glob_min(v_i) 153 zchk_amax = glob_max(SUM(a_i,dim=3)) 154 zchk_amin = glob_min(a_i) 155 156 IF(lwp) THEN 157 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_th) = ',(zchk_v_i * rday) 158 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 159 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_th) = ',(zchk_vmin * 1.e-3) 160 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_th) = ',zchk_amax 161 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limitd_th) = ',zchk_amin 162 ENDIF 163 ENDIF 164 !- check conservation (C Rousset) 165 ! ------------------------------- 131 ! conservation test 132 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 166 133 ! 167 134 IF( nn_timing == 1 ) CALL timing_stop('limitd_th') … … 169 136 ! 170 137 171 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp,kt )138 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 172 139 !!------------------------------------------------------------------ 173 140 !! *** ROUTINE lim_itd_th_rem *** … … 182 149 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 183 150 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 184 INTEGER , INTENT (in) :: ntyp ! Number of the type used185 151 INTEGER , INTENT (in) :: kt ! Ocean time step 186 152 ! … … 200 166 REAL(wp), POINTER, DIMENSION(:,:,:) :: hL ! left boundary for the ITD for each thickness 201 167 REAL(wp), POINTER, DIMENSION(:,:,:) :: hR ! left boundary for the ITD for each thickness 202 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_ o! old ice thickness168 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_b ! old ice thickness 203 169 REAL(wp), POINTER, DIMENSION(:,:,:) :: dummy_es 204 170 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! local increment of ice area and volume … … 218 184 CALL wrk_alloc( jpi,jpj, zremap_flag ) ! integer 219 185 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) ! integer 220 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_ o, dummy_es )186 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 221 187 CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice ) 222 188 CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) … … 247 213 WRITE(numout,*) ' klbnd : ', klbnd 248 214 WRITE(numout,*) ' kubnd : ', kubnd 249 WRITE(numout,*) ' ntyp : ', ntyp250 215 ENDIF 251 216 … … 256 221 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 257 222 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb 258 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes259 zht_i_ o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb260 IF( a_i(ji,jj,jl) > epsi 06 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)223 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 224 zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * zindb 225 IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) 261 226 END DO 262 227 END DO … … 302 267 ij = nind_j(ji) 303 268 ! 304 IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &305 ( zht_i_o(ii,ij,jl+1) .GT. epsi10 )) THEN269 zhbnew(ii,ij,jl) = hi_max(jl) 270 IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 306 271 !interpolate between adjacent category growth rates 307 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / & 308 ( zht_i_o (ii,ij,jl+1) - zht_i_o (ii,ij,jl) ) 309 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 310 zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 311 ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 272 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 273 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 274 ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 312 275 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 313 ELSEIF ( zht_i_o(ii,ij,jl+1).gt.epsi10) THEN276 ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 314 277 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 315 ELSE316 zhbnew(ii,ij,jl) = hi_max(jl)317 278 ENDIF 318 279 END DO … … 320 281 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 321 282 DO ji = 1, nbrem 322 ! jl, ji323 283 ii = nind_i(ji) 324 284 ij = nind_j(ji) 325 ! jl, ji 326 IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. & 327 ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 328 ) THEN 285 IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 329 286 zremap_flag(ii,ij) = 0 330 ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 331 ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 332 ) THEN 287 ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 333 288 zremap_flag(ii,ij) = 0 334 289 ENDIF 335 290 336 291 !- 4.3 Check that each zhbnew does not exceed maximal values hi_max 337 ! jl, ji 338 IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 339 zremap_flag(ii,ij) = 0 340 ENDIF 341 ! jl, ji 342 IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 343 zremap_flag(ii,ij) = 0 344 ENDIF 345 ! jl, ji 346 END DO !ji 347 ! ji 292 IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 293 IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 294 END DO 295 348 296 END DO !jl 349 297 … … 354 302 DO jj = 1, jpj 355 303 DO ji = 1, jpi 356 IF 304 IF( zremap_flag(ji,jj) == 1 ) THEN 357 305 nbrem = nbrem + 1 358 306 nind_i(nbrem) = ji 359 307 nind_j(nbrem) = jj 360 308 ENDIF 361 END DO !ji362 END DO !jj309 END DO 310 END DO 363 311 364 312 !----------------------------------------------------------------------------------------------- … … 367 315 DO jj = 1, jpj 368 316 DO ji = 1, jpi 369 zhb0(ji,jj) = hi_max _typ(0,ntyp) ! 0eme370 zhb1(ji,jj) = hi_max _typ(1,ntyp) ! 1er317 zhb0(ji,jj) = hi_max(0) ! 0eme 318 zhb1(ji,jj) = hi_max(1) ! 1er 371 319 372 320 zhbnew(ji,jj,klbnd-1) = 0._wp … … 380 328 ENDIF 381 329 382 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) 330 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 383 331 384 332 END DO !jj … … 389 337 !----------------------------------------------------------------------------------------------- 390 338 !- 7.1 g(h) for category 1 at start of time step 391 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_ o(:,:,klbnd), &339 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), & 392 340 & g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 393 341 & hR(:,:,klbnd), zremap_flag ) … … 414 362 ! Constrain new thickness <= ht_i 415 363 zdamax = a_i(ii,ij,klbnd) * & 416 (1.0 - ht_i(ii,ij,klbnd)/zht_i_ o(ii,ij,klbnd)) ! zdamax > 0364 (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0 417 365 !ice area lost due to melting of thin ice 418 366 zda0 = MIN(zda0, zdamax) … … 428 376 ELSE ! if ice accretion 429 377 ! ji, a_i > epsi10; zdh0 > 0 430 IF ( ntyp .EQ. 1 )zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))378 zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 431 379 ! zhbnew was 0, and is shifted to the right to account for thin ice 432 380 ! growth in openwater (F0 = f1) 433 IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0434 ! in other types there is435 ! no open water growth (F0 = 0)436 381 ENDIF ! zdh0 437 382 … … 444 389 DO jl = klbnd, kubnd 445 390 CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 446 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), & 447 zremap_flag) 391 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 448 392 END DO 449 393 … … 493 437 nd = zdonor(ii,ij,jl) 494 438 zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 495 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 496 zdaice(ii,ij,jl)*hL(ii,ij,nd) 439 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 497 440 498 441 END DO ! ji … … 511 454 ii = nind_i(ji) 512 455 ij = nind_j(ji) 513 IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim )) THEN456 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 514 457 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 515 458 ht_i(ii,ij,1) = hiclim 516 v_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless517 459 ENDIF 518 460 END DO !ji … … 542 484 CALL wrk_dealloc( jpi,jpj, zremap_flag ) ! integer 543 485 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) ! integer 544 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_ o, dummy_es )486 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 545 487 CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice ) 546 488 CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) … … 799 741 !-------------- 800 742 801 zdvsnow 743 zdvsnow = v_s(ii,ij,jl1) * zworka(ii,ij) 802 744 v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 803 745 v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow … … 807 749 !-------------------- 808 750 809 zdesnow 751 zdesnow = e_s(ii,ij,1,jl1) * zworka(ii,ij) 810 752 e_s(ii,ij,1,jl1) = e_s(ii,ij,1,jl1) - zdesnow 811 753 e_s(ii,ij,1,jl2) = e_s(ii,ij,1,jl2) + zdesnow … … 815 757 !-------------- 816 758 817 zdo_aice 759 zdo_aice = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 818 760 oa_i(ii,ij,jl1) = oa_i(ii,ij,jl1) - zdo_aice 819 761 oa_i(ii,ij,jl2) = oa_i(ii,ij,jl2) + zdo_aice … … 823 765 !-------------- 824 766 825 zdsm_vice 767 zdsm_vice = smv_i(ii,ij,jl1) * zworka(ii,ij) 826 768 smv_i(ii,ij,jl1) = smv_i(ii,ij,jl1) - zdsm_vice 827 769 smv_i(ii,ij,jl2) = smv_i(ii,ij,jl2) + zdsm_vice … … 831 773 !--------------------- 832 774 833 zdaTsf 775 zdaTsf = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 834 776 zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf 835 777 zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf … … 888 830 889 831 890 SUBROUTINE lim_itd_th_reb( klbnd, kubnd , ntyp)832 SUBROUTINE lim_itd_th_reb( klbnd, kubnd ) 891 833 !!------------------------------------------------------------------ 892 834 !! *** ROUTINE lim_itd_th_reb *** … … 898 840 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 899 841 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 900 INTEGER , INTENT (in) :: ntyp ! number of the ice type involved in the rebinning process901 842 ! 902 843 INTEGER :: ji,jj, jl ! dummy loop indices … … 910 851 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 911 852 !!------------------------------------------------------------------ 853 !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 912 854 913 855 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger … … 937 879 938 880 !------------------------------------------------------------------------------ 939 ! 2) Make sure thickness of cat klbnd is at least hi_max _typ(klbnd)881 ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd) 940 882 !------------------------------------------------------------------------------ 941 883 DO jj = 1, jpj 942 884 DO ji = 1, jpi 943 885 IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 944 IF( ht_i(ji,jj,klbnd) <= hi_max _typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN945 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max _typ(0,ntyp)946 ht_i(ji,jj,klbnd) = hi_max _typ(0,ntyp)886 IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN 887 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max(0) 888 ht_i(ji,jj,klbnd) = hi_max(0) 947 889 ENDIF 948 890 ENDIF … … 1015 957 1016 958 !clem-change 959 DO jj = 1, jpj 960 DO ji = 1, jpi 961 IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 962 ! 963 zshiftflag = 1 964 zdonor(ji,jj,jl) = jl + 1 965 zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 966 zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 967 ENDIF 968 END DO ! ji 969 END DO ! jj 970 971 IF(lk_mpp) CALL mpp_max( zshiftflag ) 972 973 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 974 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 975 ! Reset shift parameters 976 zdonor(:,:,jl) = 0 977 zdaice(:,:,jl) = 0._wp 978 zdvice(:,:,jl) = 0._wp 979 ENDIF 980 !clem-change 981 982 ! ! clem-change begin: why not doing that? 1017 983 ! DO jj = 1, jpj 1018 984 ! DO ji = 1, jpi 1019 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 1020 ! ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1021 ! ! 1022 ! zshiftflag = 1 1023 ! zdonor(ji,jj,jl) = jl + 1 1024 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1025 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 985 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 986 ! ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 987 ! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 1026 988 ! ENDIF 1027 989 ! END DO ! ji 1028 990 ! END DO ! jj 1029 !1030 ! IF(lk_mpp) CALL mpp_max( zshiftflag )1031 !1032 ! IF( zshiftflag == 1 ) THEN ! Shift ice between categories1033 ! CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )1034 ! ! Reset shift parameters1035 ! zdonor(:,:,jl) = 01036 ! zdaice(:,:,jl) = 0._wp1037 ! zdvice(:,:,jl) = 0._wp1038 ! ENDIF1039 !clem-change1040 1041 ! clem-change begin: why not doing that?1042 DO jj = 1, jpj1043 DO ji = 1, jpi1044 IF( a_i(ji,jj,jl+1) > epsi10 .AND. &1045 ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN1046 ht_i(ji,jj,jl+1) = hi_max(jl) + epsi101047 a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)1048 ENDIF1049 END DO ! ji1050 END DO ! jj1051 991 ! clem-change end 1052 992
Note: See TracChangeset
for help on using the changeset viewer.
