- Timestamp:
- 2017-09-27T12:09:10+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90
r8564 r8565 60 60 ! 61 61 INTEGER :: ji, jj, jl, jcat ! dummy loop index 62 INTEGER :: nidx2! local integer62 INTEGER :: ipti ! local integer 63 63 REAL(wp) :: zx1, zwk1, zdh0, zetamin, zdamax ! local scalars 64 64 REAL(wp) :: zx2, zwk2, zda0, zetamax ! - - … … 66 66 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 67 67 68 INTEGER , DIMENSION(jpij) :: i dxice2! compute remapping or not68 INTEGER , DIMENSION(jpij) :: iptidx ! compute remapping or not 69 69 INTEGER , DIMENSION(jpij,jpl-1) :: jdonor ! donor category index 70 70 REAL(wp), DIMENSION(jpij,jpl) :: zdhice ! ice thickness increment … … 83 83 ! 1) Identify grid cells with ice 84 84 !----------------------------------------------------------------------------------------------- 85 n idx = 0 ; idxice(:) = 085 npti = 0 ; nptidx(:) = 0 86 86 DO jj = 1, jpj 87 87 DO ji = 1, jpi 88 88 IF ( at_i(ji,jj) > epsi10 ) THEN 89 n idx = nidx+ 190 idxice( nidx) = (jj - 1) * jpi + ji89 npti = npti + 1 90 nptidx( npti ) = (jj - 1) * jpi + ji 91 91 ENDIF 92 92 END DO … … 96 96 ! 2) Compute new category boundaries 97 97 !----------------------------------------------------------------------------------------------- 98 IF( n idx> 0 ) THEN98 IF( npti > 0 ) THEN 99 99 100 100 zdhice(:,:) = 0._wp 101 101 zhbnew(:,:) = 0._wp 102 102 103 CALL tab_3d_2d( n idx, idxice(1:nidx), h_i_2d (1:nidx,1:jpl), h_i )104 CALL tab_3d_2d( n idx, idxice(1:nidx), h_ib_2d(1:nidx,1:jpl), h_i_b )105 CALL tab_3d_2d( n idx, idxice(1:nidx), a_i_2d (1:nidx,1:jpl), a_i )106 CALL tab_3d_2d( n idx, idxice(1:nidx), a_ib_2d (1:nidx,1:jpl), a_i_b )103 CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i ) 104 CALL tab_3d_2d( npti, nptidx(1:npti), h_ib_2d(1:npti,1:jpl), h_i_b ) 105 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 106 CALL tab_3d_2d( npti, nptidx(1:npti), a_ib_2d (1:npti,1:jpl), a_i_b ) 107 107 108 108 DO jl = 1, jpl 109 109 ! Compute thickness change in each ice category 110 DO ji = 1, n idx110 DO ji = 1, npti 111 111 zdhice(ji,jl) = h_i_2d(ji,jl) - h_ib_2d(ji,jl) 112 112 END DO … … 116 116 DO jl = 1, jpl - 1 117 117 ! 118 DO ji = 1, n idx118 DO ji = 1, npti 119 119 ! 120 120 ! --- New boundary: Hn* = Hn + Fn*dt --- ! … … 136 136 ! Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 137 137 ! in ice_itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 138 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi10 ) ) idxice(ji) = 0139 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) ) idxice(ji) = 0138 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi10 ) ) nptidx(ji) = 0 139 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) ) nptidx(ji) = 0 140 140 141 141 ! 2) Hn-1 < Hn* < Hn+1 142 IF( zhbnew(ji,jl) < hi_max(jl-1) ) idxice(ji) = 0143 IF( zhbnew(ji,jl) > hi_max(jl+1) ) idxice(ji) = 0142 IF( zhbnew(ji,jl) < hi_max(jl-1) ) nptidx(ji) = 0 143 IF( zhbnew(ji,jl) > hi_max(jl+1) ) nptidx(ji) = 0 144 144 145 145 END DO … … 147 147 ! 148 148 ! --- New boundaries for category jpl --- ! 149 DO ji = 1, n idx149 DO ji = 1, npti 150 150 IF( a_i_2d(ji,jpl) > epsi10 ) THEN 151 151 zhbnew(ji,jpl) = MAX( hi_max(jpl-1), 3._wp * h_i_2d(ji,jpl) - 2._wp * zhbnew(ji,jpl-1) ) … … 158 158 ! h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 159 159 ! in ice_itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 160 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) ) idxice(ji) = 0161 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) ) idxice(ji) = 0160 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) ) nptidx(ji) = 0 161 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) ) nptidx(ji) = 0 162 162 END DO 163 163 ! … … 165 165 ! 3) Identify cells where remapping 166 166 !----------------------------------------------------------------------------------------------- 167 nidx2 = 0 ; idxice2(:) = 0168 DO ji = 1, n idx169 IF( idxice(ji) /= 0 ) THEN170 nidx2 = nidx2+ 1171 i dxice2(nidx2) = idxice(ji)172 zhbnew( nidx2,:) = zhbnew(ji,:) ! adjust zhbnew to new indices167 ipti = 0 ; iptidx(:) = 0 168 DO ji = 1, npti 169 IF( nptidx(ji) /= 0 ) THEN 170 ipti = ipti + 1 171 iptidx(ipti) = nptidx(ji) 172 zhbnew(ipti,:) = zhbnew(ji,:) ! adjust zhbnew to new indices 173 173 ENDIF 174 174 END DO 175 idxice(:) = idxice2(:)176 n idx = nidx2175 nptidx(:) = iptidx(:) 176 npti = ipti 177 177 ! 178 178 ENDIF … … 181 181 ! 4) Compute g(h) 182 182 !----------------------------------------------------------------------------------------------- 183 IF( n idx> 0 ) THEN183 IF( npti > 0 ) THEN 184 184 ! 185 185 zhb0(:) = hi_max(0) ; zhb1(:) = hi_max(1) … … 189 189 DO jl = 1, jpl 190 190 ! 191 CALL tab_2d_1d( n idx, idxice(1:nidx), h_ib_1d(1:nidx), h_i_b(:,:,jl) )192 CALL tab_2d_1d( n idx, idxice(1:nidx), h_i_1d (1:nidx), h_i(:,:,jl) )193 CALL tab_2d_1d( n idx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl) )194 CALL tab_2d_1d( n idx, idxice(1:nidx), v_i_1d (1:nidx), v_i(:,:,jl) )191 CALL tab_2d_1d( npti, nptidx(1:npti), h_ib_1d(1:npti), h_i_b(:,:,jl) ) 192 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,jl) ) 193 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i(:,:,jl) ) 194 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i(:,:,jl) ) 195 195 ! 196 196 IF( jl == 1 ) THEN 197 197 ! 198 198 ! --- g(h) for category 1 --- ! 199 CALL ice_itd_glinear( zhb0(1:n idx) , zhb1(1:nidx) , h_ib_1d(1:nidx) , a_i_1d(1:nidx) , & ! in200 & g0 (1:n idx,1), g1 (1:nidx,1), hL (1:nidx,1), hR (1:nidx,1) ) ! out199 CALL ice_itd_glinear( zhb0(1:npti) , zhb1(1:npti) , h_ib_1d(1:npti) , a_i_1d(1:npti) , & ! in 200 & g0 (1:npti,1), g1 (1:npti,1), hL (1:npti,1), hR (1:npti,1) ) ! out 201 201 ! 202 202 ! Area lost due to melting of thin ice 203 DO ji = 1, n idx203 DO ji = 1, npti 204 204 ! 205 205 IF( a_i_1d(ji) > epsi10 ) THEN … … 233 233 END DO 234 234 ! 235 CALL tab_1d_2d( n idx, idxice(1:nidx), h_i_1d (1:nidx), h_i(:,:,jl) )236 CALL tab_1d_2d( n idx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl) )237 CALL tab_1d_2d( n idx, idxice(1:nidx), v_i_1d (1:nidx), v_i(:,:,jl) )235 CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,jl) ) 236 CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i(:,:,jl) ) 237 CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i(:,:,jl) ) 238 238 ! 239 239 ENDIF ! jl=1 240 240 ! 241 241 ! --- g(h) for each thickness category --- ! 242 CALL ice_itd_glinear( zhbnew(1:n idx,jl-1), zhbnew(1:nidx,jl), h_i_1d(1:nidx) , a_i_1d(1:nidx) , & ! in243 & g0 (1:n idx,jl ), g1 (1:nidx,jl), hL (1:nidx,jl), hR (1:nidx,jl) ) ! out242 CALL ice_itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti) , a_i_1d(1:npti) , & ! in 243 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR (1:npti,jl) ) ! out 244 244 ! 245 245 END DO … … 250 250 DO jl = 1, jpl - 1 251 251 ! 252 DO ji = 1, n idx252 DO ji = 1, npti 253 253 ! 254 254 ! left and right integration limits in eta space … … 281 281 ! 6) Shift ice between categories 282 282 !---------------------------------------------------------------------------------------------- 283 CALL ice_itd_shiftice ( jdonor(1:n idx,:), zdaice(1:nidx,:), zdvice(1:nidx,:) )283 CALL ice_itd_shiftice ( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) 284 284 285 285 !---------------------------------------------------------------------------------------------- 286 286 ! 7) Make sure h_i >= minimum ice thickness hi_min 287 287 !---------------------------------------------------------------------------------------------- 288 CALL tab_2d_1d( n idx, idxice(1:nidx), h_i_1d (1:nidx), h_i(:,:,1) )289 CALL tab_2d_1d( n idx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,1) )290 CALL tab_2d_1d( n idx, idxice(1:nidx), a_ip_1d (1:nidx), a_ip(:,:,1) )288 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,1) ) 289 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i(:,:,1) ) 290 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,1) ) 291 291 292 DO ji = 1, n idx292 DO ji = 1, npti 293 293 IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 294 294 a_i_1d (ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin … … 302 302 END DO 303 303 ! 304 CALL tab_1d_2d( n idx, idxice(1:nidx), h_i_1d (1:nidx), h_i(:,:,1) )305 CALL tab_1d_2d( n idx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,1) )306 CALL tab_1d_2d( n idx, idxice(1:nidx), a_ip_1d (1:nidx), a_ip(:,:,1) )304 CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,1) ) 305 CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i(:,:,1) ) 306 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,1) ) 307 307 ! 308 308 ENDIF … … 338 338 z2_3 = 2._wp / 3._wp 339 339 ! 340 DO ji = 1, n idx340 DO ji = 1, npti 341 341 ! 342 342 IF( paice(ji) > epsi10 .AND. phice(ji) > 0._wp ) THEN … … 392 392 !!------------------------------------------------------------------ 393 393 394 CALL tab_3d_2d( n idx, idxice(1:nidx), h_i_2d (1:nidx,1:jpl), h_i )395 CALL tab_3d_2d( n idx, idxice(1:nidx), a_i_2d (1:nidx,1:jpl), a_i )396 CALL tab_3d_2d( n idx, idxice(1:nidx), v_i_2d (1:nidx,1:jpl), v_i )397 CALL tab_3d_2d( n idx, idxice(1:nidx), v_s_2d (1:nidx,1:jpl), v_s )398 CALL tab_3d_2d( n idx, idxice(1:nidx), oa_i_2d(1:nidx,1:jpl), oa_i )399 CALL tab_3d_2d( n idx, idxice(1:nidx), sv_i_2d(1:nidx,1:jpl), sv_i )400 CALL tab_3d_2d( n idx, idxice(1:nidx), a_ip_2d(1:nidx,1:jpl), a_ip )401 CALL tab_3d_2d( n idx, idxice(1:nidx), v_ip_2d(1:nidx,1:jpl), v_ip )402 CALL tab_3d_2d( n idx, idxice(1:nidx), t_su_2d(1:nidx,1:jpl), t_su )394 CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i ) 395 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 396 CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i ) 397 CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,1:jpl), v_s ) 398 CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,1:jpl), oa_i ) 399 CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i ) 400 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 401 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 402 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 403 403 404 404 !---------------------------------------------------------------------------------------------- … … 406 406 !---------------------------------------------------------------------------------------------- 407 407 DO jl = 1, jpl 408 DO ji = 1, n idx408 DO ji = 1, npti 409 409 zaTsfn(ji,jl) = a_i_2d(ji,jl) * t_su_2d(ji,jl) 410 410 END DO … … 415 415 !------------------------------------------------------------------------------- 416 416 DO jl = 1, jpl - 1 417 DO ji = 1, n idx417 DO ji = 1, npti 418 418 ! 419 419 jl1 = kdonor(ji,jl) … … 475 475 DO jk = 1, nlay_s !--- Snow heat content 476 476 ! 477 DO ji = 1, n idx478 ii = MOD( idxice(ji) - 1, jpi ) + 1479 ij = ( idxice(ji) - 1 ) / jpi + 1477 DO ji = 1, npti 478 ii = MOD( nptidx(ji) - 1, jpi ) + 1 479 ij = ( nptidx(ji) - 1 ) / jpi + 1 480 480 ! 481 481 jl1 = kdonor(ji,jl) … … 494 494 495 495 DO jk = 1, nlay_i !--- Ice heat content 496 DO ji = 1, n idx497 ii = MOD( idxice(ji) - 1, jpi ) + 1498 ij = ( idxice(ji) - 1 ) / jpi + 1496 DO ji = 1, npti 497 ii = MOD( nptidx(ji) - 1, jpi ) + 1 498 ij = ( nptidx(ji) - 1 ) / jpi + 1 499 499 ! 500 500 jl1 = kdonor(ji,jl) … … 517 517 ! 3) Update ice thickness and temperature 518 518 !------------------------------------------------------------------------------- 519 WHERE( a_i_2d(1:n idx,:) >= epsi20 )520 h_i_2d(1:n idx,:) = v_i_2d(1:nidx,:) / a_i_2d(1:nidx,:)521 t_su_2d(1:n idx,:) = zaTsfn(1:nidx,:) / a_i_2d(1:nidx,:)519 WHERE( a_i_2d(1:npti,:) >= epsi20 ) 520 h_i_2d(1:npti,:) = v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 521 t_su_2d(1:npti,:) = zaTsfn(1:npti,:) / a_i_2d(1:npti,:) 522 522 ELSEWHERE 523 h_i_2d(1:n idx,:) = 0._wp524 t_su_2d(1:n idx,:) = rt0523 h_i_2d(1:npti,:) = 0._wp 524 t_su_2d(1:npti,:) = rt0 525 525 END WHERE 526 526 ! 527 CALL tab_2d_3d( n idx, idxice(1:nidx), h_i_2d (1:nidx,1:jpl), h_i )528 CALL tab_2d_3d( n idx, idxice(1:nidx), a_i_2d (1:nidx,1:jpl), a_i )529 CALL tab_2d_3d( n idx, idxice(1:nidx), v_i_2d (1:nidx,1:jpl), v_i )530 CALL tab_2d_3d( n idx, idxice(1:nidx), v_s_2d (1:nidx,1:jpl), v_s )531 CALL tab_2d_3d( n idx, idxice(1:nidx), oa_i_2d(1:nidx,1:jpl), oa_i )532 CALL tab_2d_3d( n idx, idxice(1:nidx), sv_i_2d(1:nidx,1:jpl), sv_i )533 CALL tab_2d_3d( n idx, idxice(1:nidx), a_ip_2d(1:nidx,1:jpl), a_ip )534 CALL tab_2d_3d( n idx, idxice(1:nidx), v_ip_2d(1:nidx,1:jpl), v_ip )535 CALL tab_2d_3d( n idx, idxice(1:nidx), t_su_2d(1:nidx,1:jpl), t_su )527 CALL tab_2d_3d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i ) 528 CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 529 CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i ) 530 CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,1:jpl), v_s ) 531 CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,1:jpl), oa_i ) 532 CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i ) 533 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 534 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 535 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 536 536 ! 537 537 END SUBROUTINE ice_itd_shiftice … … 564 564 DO jl = 1, jpl-1 ! identify thicknesses that are too big 565 565 ! !--------------------------------------- 566 n idx = 0 ; idxice(:) = 0566 npti = 0 ; nptidx(:) = 0 567 567 DO jj = 1, jpj 568 568 DO ji = 1, jpi 569 569 IF( a_i(ji,jj,jl) > epsi10 .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 570 n idx = nidx+ 1571 idxice( nidx) = (jj - 1) * jpi + ji570 npti = npti + 1 571 nptidx( npti ) = (jj - 1) * jpi + ji 572 572 ENDIF 573 573 END DO 574 574 END DO 575 575 ! 576 !!clem CALL tab_2d_1d( n idx, idxice(1:nidx), h_i_1d (1:nidx), h_i(:,:,jl) )577 CALL tab_2d_1d( n idx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl) )578 CALL tab_2d_1d( n idx, idxice(1:nidx), v_i_1d (1:nidx), v_i(:,:,jl) )579 ! 580 DO ji = 1, n idx576 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,jl) ) 577 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i(:,:,jl) ) 578 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i(:,:,jl) ) 579 ! 580 DO ji = 1, npti 581 581 jdonor(ji,jl) = jl 582 582 ! how much of a_i you send in cat sup is somewhat arbitrary … … 592 592 END DO 593 593 ! 594 IF( n idx> 0 ) THEN595 CALL ice_itd_shiftice( jdonor(1:n idx,:), zdaice(1:nidx,:), zdvice(1:nidx,:) ) ! Shift jl=>jl+1594 IF( npti > 0 ) THEN 595 CALL ice_itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) ! Shift jl=>jl+1 596 596 ! Reset shift parameters 597 jdonor(1:n idx,jl) = 0598 zdaice(1:n idx,jl) = 0._wp599 zdvice(1:n idx,jl) = 0._wp597 jdonor(1:npti,jl) = 0 598 zdaice(1:npti,jl) = 0._wp 599 zdvice(1:npti,jl) = 0._wp 600 600 ENDIF 601 601 ! … … 605 605 DO jl = jpl-1, 1, -1 ! Identify thicknesses that are too small 606 606 ! !----------------------------------------- 607 n idx = 0 ; idxice(:) = 0607 npti = 0 ; nptidx(:) = 0 608 608 DO jj = 1, jpj 609 609 DO ji = 1, jpi 610 610 IF( a_i(ji,jj,jl+1) > epsi10 .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 611 n idx = nidx+ 1612 idxice( nidx) = (jj - 1) * jpi + ji611 npti = npti + 1 612 nptidx( npti ) = (jj - 1) * jpi + ji 613 613 ENDIF 614 614 END DO 615 615 END DO 616 616 ! 617 CALL tab_2d_1d( n idx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl+1) ) ! jl+1 is ok618 CALL tab_2d_1d( n idx, idxice(1:nidx), v_i_1d (1:nidx), v_i(:,:,jl+1) ) ! jl+1 is ok619 DO ji = 1, n idx617 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok 618 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i(:,:,jl+1) ) ! jl+1 is ok 619 DO ji = 1, npti 620 620 jdonor(ji,jl) = jl + 1 621 621 zdaice(ji,jl) = a_i_1d(ji) … … 623 623 END DO 624 624 ! 625 IF( n idx> 0 ) THEN626 CALL ice_itd_shiftice( jdonor(1:n idx,:), zdaice(1:nidx,:), zdvice(1:nidx,:) ) ! Shift jl+1=>jl625 IF( npti > 0 ) THEN 626 CALL ice_itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) ! Shift jl+1=>jl 627 627 ! Reset shift parameters 628 jdonor(1:n idx,jl) = 0629 zdaice(1:n idx,jl) = 0._wp630 zdvice(1:n idx,jl) = 0._wp628 jdonor(1:npti,jl) = 0 629 zdaice(1:npti,jl) = 0._wp 630 zdvice(1:npti,jl) = 0._wp 631 631 ENDIF 632 632 !
Note: See TracChangeset
for help on using the changeset viewer.
