Changeset 13469 for NEMO/branches/2020/temporary_r4_trunk/src/ICE
- Timestamp:
- 2020-09-15T12:49:18+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/temporary_r4_trunk/src/ICE
- Files:
-
- 16 edited
-
icealb.F90 (modified) (1 diff)
-
icecor.F90 (modified) (2 diffs)
-
icectl.F90 (modified) (6 diffs)
-
icedyn.F90 (modified) (2 diffs)
-
icedyn_adv_pra.F90 (modified) (7 diffs)
-
icedyn_adv_umx.F90 (modified) (34 diffs)
-
icedyn_rdgrft.F90 (modified) (3 diffs)
-
icedyn_rhg_evp.F90 (modified) (14 diffs)
-
iceistate.F90 (modified) (2 diffs)
-
iceitd.F90 (modified) (3 diffs)
-
icesbc.F90 (modified) (1 diff)
-
icestp.F90 (modified) (1 diff)
-
icethd.F90 (modified) (3 diffs)
-
iceupdate.F90 (modified) (3 diffs)
-
icevar.F90 (modified) (4 diffs)
-
icewri.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90
r13466 r13469 122 122 ! 123 123 DO jl = 1, jpl 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 ! 127 !---------------------------------------------! 128 !--- Specific snow, ice and pond fractions ---! 129 !---------------------------------------------! 130 zafrac_snw = za_s_fra(ji,jj,jl) 131 IF( ld_pnd_alb ) THEN 132 zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 133 ELSE 134 zafrac_pnd = 0._wp 135 ENDIF 136 zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 137 ! 138 !---------------! 139 !--- Albedos ---! 140 !---------------! 141 ! !--- Bare ice albedo (for hi > 150cm) 142 IF( ld_pnd_alb ) THEN 143 zalb_ice = rn_alb_idry 144 ELSE 145 IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN ; zalb_ice = rn_alb_imlt 146 ELSE ; zalb_ice = rn_alb_idry ; ENDIF 147 ENDIF 148 ! !--- Bare ice albedo (for hi < 150cm) 149 IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN ! 5cm < hi < 150cm 150 zalb_ice = zalb_ice + ( 0.18 - zalb_ice ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 151 ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN ! 0cm < hi < 5cm 152 zalb_ice = rn_alb_oce + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 153 ENDIF 154 ! 155 ! !--- Snow-covered ice albedo (freezing, melting cases) 156 IF( pt_su(ji,jj,jl) < rt0 ) THEN 157 zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 158 ELSE 159 zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 ) 160 ENDIF 161 ! !--- Ponded ice albedo 162 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 163 ! 164 ! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 165 zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 166 ! 167 zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os & 168 & + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 169 ! 170 ! albedo depends on cloud fraction because of non-linear spectral effects 171 palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 172 173 END DO 174 END DO 124 DO_2D_11_11 125 ! 126 !---------------------------------------------! 127 !--- Specific snow, ice and pond fractions ---! 128 !---------------------------------------------! 129 zafrac_snw = za_s_fra(ji,jj,jl) 130 IF( ld_pnd_alb ) THEN 131 zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 132 ELSE 133 zafrac_pnd = 0._wp 134 ENDIF 135 zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 136 ! 137 !---------------! 138 !--- Albedos ---! 139 !---------------! 140 ! !--- Bare ice albedo (for hi > 150cm) 141 IF( ld_pnd_alb ) THEN 142 zalb_ice = rn_alb_idry 143 ELSE 144 IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN ; zalb_ice = rn_alb_imlt 145 ELSE ; zalb_ice = rn_alb_idry ; ENDIF 146 ENDIF 147 ! !--- Bare ice albedo (for hi < 150cm) 148 IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN ! 5cm < hi < 150cm 149 zalb_ice = zalb_ice + ( 0.18 - zalb_ice ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 150 ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN ! 0cm < hi < 5cm 151 zalb_ice = rn_alb_oce + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 152 ENDIF 153 ! 154 ! !--- Snow-covered ice albedo (freezing, melting cases) 155 IF( pt_su(ji,jj,jl) < rt0 ) THEN 156 zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 157 ELSE 158 zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 ) 159 ENDIF 160 ! !--- Ponded ice albedo 161 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 162 ! 163 ! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 164 zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 165 ! 166 zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os & 167 & + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 168 ! 169 ! albedo depends on cloud fraction because of non-linear spectral effects 170 palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 171 172 END_2D 175 173 END DO 176 174 ! -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90
r13466 r13469 92 92 zzc = rhoi * r1_rdtice 93 93 DO jl = 1, jpl 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 zsal = sv_i(ji,jj,jl) 97 sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) ) 98 sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux 99 END DO 100 END DO 94 DO_2D_11_11 95 zsal = sv_i(ji,jj,jl) 96 sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) ) 97 sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux 98 END_2D 101 99 END DO 102 100 ENDIF … … 107 105 ! !----------------------------------------------------- 108 106 IF( kn == 2 ) THEN ! Ice drift case: Corrections to avoid wrong values ! 109 DO jj = 2, jpjm1 !----------------------------------------------------- 110 DO ji = 2, jpim1 111 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 112 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side 113 IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 114 IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj ) = 0._wp ! upper side 115 IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 116 ENDIF 117 END DO 118 END DO 107 DO_2D_00_00 108 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 109 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side 110 IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 111 IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj ) = 0._wp ! upper side 112 IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 113 ENDIF 114 END_2D 119 115 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 120 116 ENDIF -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90
r13466 r13469 366 366 cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 367 367 DO jl = 1, jpl 368 DO jj = 1, jpj 369 DO ji = 1, jpi 370 IF( v_i(ji,jj,jl) > epsi10 ) THEN 371 IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 372 WRITE(numout,*) ' ALERTE : Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 373 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 374 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 375 ENDIF 368 DO_2D_11_11 369 IF( v_i(ji,jj,jl) > epsi10 ) THEN 370 IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 371 WRITE(numout,*) ' ALERTE : Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 372 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 373 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 376 374 ENDIF 377 END DO378 END DO375 ENDIF 376 END_2D 379 377 END DO 380 378 … … 383 381 cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 384 382 DO jl = 1, jpl 385 DO jj = 1, jpj 386 DO ji = 1, jpi 387 IF( v_i(ji,jj,jl) > epsi10 ) THEN 388 IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 389 WRITE(numout,*) ' ALERTE : Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 390 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 391 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 392 ENDIF 383 DO_2D_11_11 384 IF( v_i(ji,jj,jl) > epsi10 ) THEN 385 IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 386 WRITE(numout,*) ' ALERTE : Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 387 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 388 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 393 389 ENDIF 394 END DO395 END DO390 ENDIF 391 END_2D 396 392 END DO 397 393 … … 400 396 cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 401 397 DO jl = 1, jpl 402 DO jk = 1, nlay_i 403 DO jj = 1, jpj 404 DO ji = 1, jpi 405 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 406 IF( t_i(ji,jj,jk,jl) < -50.+rt0 .AND. v_i(ji,jj,jl) > epsi10 ) THEN 407 WRITE(numout,*) ' ALERTE : Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 408 WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 409 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 410 ENDIF 411 END DO 412 END DO 413 END DO 398 DO_3D_11_11( 1, nlay_i ) 399 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 400 IF( t_i(ji,jj,jk,jl) < -50.+rt0 .AND. v_i(ji,jj,jl) > epsi10 ) THEN 401 WRITE(numout,*) ' ALERTE : Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 402 WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 403 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 404 ENDIF 405 END_3D 414 406 END DO 415 407 … … 418 410 cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 419 411 DO jl = 1, jpl 420 DO jk = 1, nlay_i 421 DO jj = 1, jpj 422 DO ji = 1, jpi 423 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 424 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > epsi10 ) THEN 425 WRITE(numout,*) ' ALERTE : Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 426 WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 427 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 428 ENDIF 429 END DO 430 END DO 431 END DO 412 DO_3D_11_11( 1, nlay_i ) 413 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 414 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > epsi10 ) THEN 415 WRITE(numout,*) ' ALERTE : Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 416 WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 417 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 418 ENDIF 419 END_3D 432 420 END DO 433 421 … … 436 424 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 437 425 jl = jpl 438 DO jj = 1, jpj 439 DO ji = 1, jpi 440 IF( h_i(ji,jj,jl) > 50._wp ) THEN 441 WRITE(numout,*) ' ALERTE : Very thick ice ',h_i(ji,jj,jl) 442 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 443 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 444 ENDIF 445 END DO 446 END DO 426 DO_2D_11_11 427 IF( h_i(ji,jj,jl) > 50._wp ) THEN 428 WRITE(numout,*) ' ALERTE : Very thick ice ',h_i(ji,jj,jl) 429 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 430 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 431 ENDIF 432 END_2D 447 433 448 434 ! Alerte if very thin ice … … 450 436 cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 451 437 jl = 1 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 IF( h_i(ji,jj,jl) < rn_himin ) THEN 455 WRITE(numout,*) ' ALERTE : Very thin ice ',h_i(ji,jj,jl) 456 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 457 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 458 ENDIF 459 END DO 460 END DO 438 DO_2D_11_11 439 IF( h_i(ji,jj,jl) < rn_himin ) THEN 440 WRITE(numout,*) ' ALERTE : Very thin ice ',h_i(ji,jj,jl) 441 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 442 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 443 ENDIF 444 END_2D 461 445 462 446 ! Alert if very fast ice 463 447 ialert_id = ialert_id + 1 ! reference number of this alert 464 448 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 465 DO jj = 1, jpj 466 DO ji = 1, jpi 467 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 468 WRITE(numout,*) ' ALERTE : Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 469 WRITE(numout,*) ' at i,j = ',ji,jj 470 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 471 ENDIF 472 END DO 473 END DO 449 DO_2D_11_11 450 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 451 WRITE(numout,*) ' ALERTE : Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 452 WRITE(numout,*) ' at i,j = ',ji,jj 453 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 454 ENDIF 455 END_2D 474 456 475 457 ! Alert if there is ice on continents 476 458 ialert_id = ialert_id + 1 ! reference number of this alert 477 459 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 478 DO jj = 1, jpj 479 DO ji = 1, jpi 480 IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 481 WRITE(numout,*) ' ALERTE : Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 482 WRITE(numout,*) ' at i,j = ',ji,jj 483 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 484 ENDIF 485 END DO 486 END DO 460 DO_2D_11_11 461 IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 462 WRITE(numout,*) ' ALERTE : Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 463 WRITE(numout,*) ' at i,j = ',ji,jj 464 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 465 ENDIF 466 END_2D 487 467 488 468 ! Alert if incompatible ice concentration and volume 489 469 ialert_id = ialert_id + 1 ! reference number of this alert 490 470 cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 491 DO jj = 1, jpj 492 DO ji = 1, jpi 493 IF( ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. & 494 & ( vt_i(ji,jj) > 0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 495 WRITE(numout,*) ' ALERTE : Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 496 WRITE(numout,*) ' at i,j = ',ji,jj 497 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 498 ENDIF 499 END DO 500 END DO 471 DO_2D_11_11 472 IF( ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. & 473 & ( vt_i(ji,jj) > 0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 474 WRITE(numout,*) ' ALERTE : Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 475 WRITE(numout,*) ' at i,j = ',ji,jj 476 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 477 ENDIF 478 END_2D 501 479 502 480 ! sum of the alerts on all processors -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90
r13466 r13469 127 127 ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 128 128 ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 132 zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 133 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 134 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 135 END DO 136 END DO 129 DO_2D_11_11 130 zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 131 zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 132 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 133 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 134 END_2D 137 135 ! --- 138 136 CALL ice_dyn_adv ( kt ) ! -- advection of ice … … 158 156 159 157 ALLOCATE( zdivu_i(jpi,jpj) ) 160 DO jj = 2, jpjm1 161 DO ji = 2, jpim1 162 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 163 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 164 END DO 165 END DO 158 DO_2D_00_00 159 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 160 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 161 END_2D 166 162 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 167 163 ! output -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90
r13466 r13469 110 110 END WHERE 111 111 DO jl = 1, jpl 112 DO jj = 2, jpjm1 113 DO ji = fs_2, fs_jpim1 114 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 115 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 116 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 117 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 118 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 119 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 120 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 121 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 122 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 123 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 124 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 125 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 126 zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj ,jl), zs_i (ji ,jj+1,jl), & 127 & zs_i (ji-1,jj ,jl), zs_i (ji ,jj-1,jl), & 128 & zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 129 & zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 130 END DO 131 END DO 112 DO_2D_00_00 113 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 114 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 115 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 116 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 117 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 118 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 119 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 120 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 121 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 122 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 123 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 124 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 125 zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj ,jl), zs_i (ji ,jj+1,jl), & 126 & zs_i (ji-1,jj ,jl), zs_i (ji ,jj-1,jl), & 127 & zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 128 & zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 129 END_2D 132 130 END DO 133 131 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. ) … … 145 143 END DO 146 144 DO jl = 1, jpl 147 DO jk = 1, nlay_i 148 DO jj = 2, jpjm1 149 DO ji = fs_2, fs_jpim1 150 zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj ,jk,jl), ze_i(ji ,jj+1,jk,jl), & 151 & ze_i(ji-1,jj ,jk,jl), ze_i(ji ,jj-1,jk,jl), & 152 & ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 153 & ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 154 END DO 155 END DO 156 END DO 145 DO_3D_00_00( 1, nlay_i ) 146 zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj ,jk,jl), ze_i(ji ,jj+1,jk,jl), & 147 & ze_i(ji-1,jj ,jk,jl), ze_i(ji ,jj-1,jk,jl), & 148 & ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 149 & ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 150 END_3D 157 151 END DO 158 152 DO jl = 1, jpl 159 DO jk = 1, nlay_s 160 DO jj = 2, jpjm1 161 DO ji = fs_2, fs_jpim1 162 zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj ,jk,jl), ze_s(ji ,jj+1,jk,jl), & 163 & ze_s(ji-1,jj ,jk,jl), ze_s(ji ,jj-1,jk,jl), & 164 & ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 165 & ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 166 END DO 167 END DO 168 END DO 153 DO_3D_00_00( 1, nlay_s ) 154 zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj ,jk,jl), ze_s(ji ,jj+1,jk,jl), & 155 & ze_s(ji-1,jj ,jk,jl), ze_s(ji ,jj-1,jk,jl), & 156 & ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 157 & ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 158 END_3D 169 159 END DO 170 160 CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) … … 317 307 ! derive open water from ice concentration 318 308 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 319 DO jj = 2, jpjm1 320 DO ji = fs_2, fs_jpim1 321 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 322 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 323 END DO 324 END DO 309 DO_2D_00_00 310 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 311 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 312 END_2D 325 313 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1. ) 326 314 ! … … 375 363 ! 376 364 ! Limitation of moments. 377 DO jj = 2, jpjm1 378 DO ji = 1, jpi 379 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 380 psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 381 ! 382 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 383 zs1max = 1.5 * zslpmax 384 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 385 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 386 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 387 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 388 389 ps0 (ji,jj,jl) = zslpmax 390 psx (ji,jj,jl) = zs1new * rswitch 391 psxx(ji,jj,jl) = zs2new * rswitch 392 psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 393 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 394 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 395 END DO 396 END DO 365 DO_2D_00_11 366 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 367 psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 368 ! 369 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 370 zs1max = 1.5 * zslpmax 371 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 372 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 373 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 374 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 375 376 ps0 (ji,jj,jl) = zslpmax 377 psx (ji,jj,jl) = zs1new * rswitch 378 psxx(ji,jj,jl) = zs2new * rswitch 379 psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 380 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 381 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 382 END_2D 397 383 398 384 ! Calculate fluxes and moments between boxes i<-->i+1 399 DO jj = 2, jpjm1 ! Flux from i to i+1 WHEN u GT 0 400 DO ji = 1, jpi 401 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 402 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 403 zalfq = zalf * zalf 404 zalf1 = 1.0 - zalf 405 zalf1q = zalf1 * zalf1 406 ! 407 zfm (ji,jj) = zalf * psm (ji,jj,jl) 408 zf0 (ji,jj) = zalf * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 409 zfx (ji,jj) = zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 410 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) * zalfq 411 zfy (ji,jj) = zalf * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 412 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 413 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 414 415 ! Readjust moments remaining in the box. 416 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 417 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 418 psx (ji,jj,jl) = zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 419 psxx(ji,jj,jl) = zalf1 * zalf1q * psxx(ji,jj,jl) 420 psy (ji,jj,jl) = psy (ji,jj,jl) - zfy(ji,jj) 421 psyy(ji,jj,jl) = psyy(ji,jj,jl) - zfyy(ji,jj) 422 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 423 END DO 424 END DO 425 426 DO jj = 2, jpjm1 ! Flux from i+1 to i when u LT 0. 427 DO ji = 1, fs_jpim1 428 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 429 zalg (ji,jj) = zalf 430 zalfq = zalf * zalf 431 zalf1 = 1.0 - zalf 432 zalg1 (ji,jj) = zalf1 433 zalf1q = zalf1 * zalf1 434 zalg1q(ji,jj) = zalf1q 435 ! 436 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) 437 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & 438 & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 439 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 440 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq 441 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 442 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) 443 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 444 END DO 445 END DO 446 447 DO jj = 2, jpjm1 ! Readjust moments remaining in the box. 448 DO ji = fs_2, fs_jpim1 449 zbt = zbet(ji-1,jj) 450 zbt1 = 1.0 - zbet(ji-1,jj) 451 ! 452 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 453 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 454 psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 455 psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 456 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 457 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 458 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 459 END DO 460 END DO 385 DO_2D_00_11 386 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 387 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 388 zalfq = zalf * zalf 389 zalf1 = 1.0 - zalf 390 zalf1q = zalf1 * zalf1 391 ! 392 zfm (ji,jj) = zalf * psm (ji,jj,jl) 393 zf0 (ji,jj) = zalf * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 394 zfx (ji,jj) = zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 395 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) * zalfq 396 zfy (ji,jj) = zalf * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 397 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 398 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 399 400 ! Readjust moments remaining in the box. 401 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 402 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 403 psx (ji,jj,jl) = zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 404 psxx(ji,jj,jl) = zalf1 * zalf1q * psxx(ji,jj,jl) 405 psy (ji,jj,jl) = psy (ji,jj,jl) - zfy(ji,jj) 406 psyy(ji,jj,jl) = psyy(ji,jj,jl) - zfyy(ji,jj) 407 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 408 END_2D 409 410 DO_2D_00_10 411 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 412 zalg (ji,jj) = zalf 413 zalfq = zalf * zalf 414 zalf1 = 1.0 - zalf 415 zalg1 (ji,jj) = zalf1 416 zalf1q = zalf1 * zalf1 417 zalg1q(ji,jj) = zalf1q 418 ! 419 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) 420 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & 421 & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 422 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 423 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq 424 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 425 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) 426 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 427 END_2D 428 429 DO_2D_00_00 430 zbt = zbet(ji-1,jj) 431 zbt1 = 1.0 - zbet(ji-1,jj) 432 ! 433 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 434 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 435 psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 436 psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 437 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 438 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 439 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 440 END_2D 461 441 462 442 ! Put the temporary moments into appropriate neighboring boxes. 463 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0. 464 DO ji = fs_2, fs_jpim1 465 zbt = zbet(ji-1,jj) 466 zbt1 = 1.0 - zbet(ji-1,jj) 467 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 468 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 469 zalf1 = 1.0 - zalf 470 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 471 ! 472 ps0 (ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 473 psx (ji,jj,jl) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 474 psxx(ji,jj,jl) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 475 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 476 & + zbt1 * psxx(ji,jj,jl) 477 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl) & 478 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj,jl) ) ) & 479 & + zbt1 * psxy(ji,jj,jl) 480 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 481 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 482 END DO 483 END DO 484 485 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0. 486 DO ji = fs_2, fs_jpim1 487 zbt = zbet(ji,jj) 488 zbt1 = 1.0 - zbet(ji,jj) 489 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 490 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 491 zalf1 = 1.0 - zalf 492 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 493 ! 494 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 495 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 496 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 497 & + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) ) & 498 & + ( zalf1 - zalf ) * ztemp ) ) 499 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 500 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 501 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 502 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 503 END DO 504 END DO 443 DO_2D_00_00 444 zbt = zbet(ji-1,jj) 445 zbt1 = 1.0 - zbet(ji-1,jj) 446 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 447 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 448 zalf1 = 1.0 - zalf 449 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 450 ! 451 ps0 (ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 452 psx (ji,jj,jl) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 453 psxx(ji,jj,jl) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 454 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 455 & + zbt1 * psxx(ji,jj,jl) 456 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl) & 457 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj,jl) ) ) & 458 & + zbt1 * psxy(ji,jj,jl) 459 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 460 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 461 END_2D 462 463 DO_2D_00_00 464 zbt = zbet(ji,jj) 465 zbt1 = 1.0 - zbet(ji,jj) 466 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 467 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 468 zalf1 = 1.0 - zalf 469 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 470 ! 471 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 472 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 473 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 474 & + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) ) & 475 & + ( zalf1 - zalf ) * ztemp ) ) 476 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 477 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 478 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 479 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 480 END_2D 505 481 506 482 END DO … … 544 520 ! 545 521 ! Limitation of moments. 546 DO jj = 1, jpj 547 DO ji = fs_2, fs_jpim1 548 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 549 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 550 ! 551 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 552 zs1max = 1.5 * zslpmax 553 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 554 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 555 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 556 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 557 ! 558 ps0 (ji,jj,jl) = zslpmax 559 psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 560 psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 561 psy (ji,jj,jl) = zs1new * rswitch 562 psyy(ji,jj,jl) = zs2new * rswitch 563 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 564 END DO 565 END DO 522 DO_2D_11_00 523 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 524 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 525 ! 526 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 527 zs1max = 1.5 * zslpmax 528 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 529 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 530 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 531 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 532 ! 533 ps0 (ji,jj,jl) = zslpmax 534 psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 535 psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 536 psy (ji,jj,jl) = zs1new * rswitch 537 psyy(ji,jj,jl) = zs2new * rswitch 538 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 539 END_2D 566 540 567 541 ! Calculate fluxes and moments between boxes j<-->j+1 568 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 569 DO ji = fs_2, fs_jpim1 570 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 571 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 572 zalfq = zalf * zalf 573 zalf1 = 1.0 - zalf 574 zalf1q = zalf1 * zalf1 575 ! 576 zfm (ji,jj) = zalf * psm(ji,jj,jl) 577 zf0 (ji,jj) = zalf * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl) + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 578 zfy (ji,jj) = zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 579 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj,jl) 580 zfx (ji,jj) = zalf * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 581 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 582 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 583 ! 584 ! Readjust moments remaining in the box. 585 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 586 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 587 psy (ji,jj,jl) = zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 588 psyy(ji,jj,jl) = zalf1 * zalf1q * psyy(ji,jj,jl) 589 psx (ji,jj,jl) = psx (ji,jj,jl) - zfx(ji,jj) 590 psxx(ji,jj,jl) = psxx(ji,jj,jl) - zfxx(ji,jj) 591 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 592 END DO 593 END DO 594 ! 595 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 596 DO ji = fs_2, fs_jpim1 597 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 598 zalg (ji,jj) = zalf 599 zalfq = zalf * zalf 600 zalf1 = 1.0 - zalf 601 zalg1 (ji,jj) = zalf1 602 zalf1q = zalf1 * zalf1 603 zalg1q(ji,jj) = zalf1q 604 ! 605 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) 606 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & 607 & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 608 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 609 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq 610 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 611 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) 612 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1,jl) 613 END DO 614 END DO 542 DO_2D_11_00 543 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 544 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 545 zalfq = zalf * zalf 546 zalf1 = 1.0 - zalf 547 zalf1q = zalf1 * zalf1 548 ! 549 zfm (ji,jj) = zalf * psm(ji,jj,jl) 550 zf0 (ji,jj) = zalf * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl) + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 551 zfy (ji,jj) = zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 552 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj,jl) 553 zfx (ji,jj) = zalf * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 554 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 555 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 556 ! 557 ! Readjust moments remaining in the box. 558 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 559 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 560 psy (ji,jj,jl) = zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 561 psyy(ji,jj,jl) = zalf1 * zalf1q * psyy(ji,jj,jl) 562 psx (ji,jj,jl) = psx (ji,jj,jl) - zfx(ji,jj) 563 psxx(ji,jj,jl) = psxx(ji,jj,jl) - zfxx(ji,jj) 564 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 565 END_2D 566 ! 567 DO_2D_10_00 568 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 569 zalg (ji,jj) = zalf 570 zalfq = zalf * zalf 571 zalf1 = 1.0 - zalf 572 zalg1 (ji,jj) = zalf1 573 zalf1q = zalf1 * zalf1 574 zalg1q(ji,jj) = zalf1q 575 ! 576 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) 577 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & 578 & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 579 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 580 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq 581 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 582 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) 583 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1,jl) 584 END_2D 615 585 616 586 ! Readjust moments remaining in the box. 617 DO jj = 2, jpjm1 618 DO ji = fs_2, fs_jpim1 619 zbt = zbet(ji,jj-1) 620 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 621 ! 622 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 623 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 624 psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 625 psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 626 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 627 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 628 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 629 END DO 630 END DO 587 DO_2D_00_00 588 zbt = zbet(ji,jj-1) 589 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 590 ! 591 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 592 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 593 psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 594 psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 595 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 596 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 597 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 598 END_2D 631 599 632 600 ! Put the temporary moments into appropriate neighboring boxes. 633 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 634 DO ji = fs_2, fs_jpim1 635 zbt = zbet(ji,jj-1) 636 zbt1 = 1.0 - zbet(ji,jj-1) 637 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 638 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 639 zalf1 = 1.0 - zalf 640 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 641 ! 642 ps0(ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 643 psy(ji,jj,jl) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) & 644 & + zbt1 * psy(ji,jj,jl) 645 psyy(ji,jj,jl) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl) & 646 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 647 & + zbt1 * psyy(ji,jj,jl) 648 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl) & 649 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) ) & 650 & + zbt1 * psxy(ji,jj,jl) 651 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 652 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 653 END DO 654 END DO 655 656 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 657 DO ji = fs_2, fs_jpim1 658 zbt = zbet(ji,jj) 659 zbt1 = 1.0 - zbet(ji,jj) 660 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 661 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 662 zalf1 = 1.0 - zalf 663 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 664 ! 665 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 666 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 667 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 668 & + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) ) & 669 & + ( zalf1 - zalf ) * ztemp ) ) 670 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 671 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 672 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 673 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 674 END DO 675 END DO 601 DO_2D_00_00 602 zbt = zbet(ji,jj-1) 603 zbt1 = 1.0 - zbet(ji,jj-1) 604 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 605 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 606 zalf1 = 1.0 - zalf 607 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 608 ! 609 ps0(ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 610 psy(ji,jj,jl) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) & 611 & + zbt1 * psy(ji,jj,jl) 612 psyy(ji,jj,jl) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl) & 613 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 614 & + zbt1 * psyy(ji,jj,jl) 615 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl) & 616 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) ) & 617 & + zbt1 * psxy(ji,jj,jl) 618 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 619 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 620 END_2D 621 622 DO_2D_00_00 623 zbt = zbet(ji,jj) 624 zbt1 = 1.0 - zbet(ji,jj) 625 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 626 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 627 zalf1 = 1.0 - zalf 628 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 629 ! 630 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 631 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 632 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 633 & + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) ) & 634 & + ( zalf1 - zalf ) * ztemp ) ) 635 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 636 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 637 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 638 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 639 END_2D 676 640 677 641 END DO … … 715 679 ! 716 680 DO jl = 1, jpl 717 DO jj = 1, jpj 718 DO ji = 1, jpi 719 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 681 DO_2D_11_11 682 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 683 ! 684 ! ! -- check h_ip -- ! 685 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 686 IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 687 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 688 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 689 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 690 ENDIF 691 ENDIF 692 ! 693 ! ! -- check h_i -- ! 694 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 695 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 696 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 697 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 698 ENDIF 699 ! 700 ! ! -- check h_s -- ! 701 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 702 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 703 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 704 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 720 705 ! 721 ! ! -- check h_ip -- ! 722 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 723 IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 724 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 725 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 726 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 727 ENDIF 728 ENDIF 706 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 707 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 729 708 ! 730 ! ! -- check h_i -- ! 731 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 732 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 733 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 734 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 735 ENDIF 736 ! 737 ! ! -- check h_s -- ! 738 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 739 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 740 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 741 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 742 ! 743 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 744 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 745 ! 746 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 747 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 748 ENDIF 749 ! 750 ! ! -- check s_i -- ! 751 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 752 zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 753 IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 754 zfra = psi_max(ji,jj,jl) / zsi 755 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 756 psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 757 ENDIF 758 ! 759 ENDIF 760 END DO 761 END DO 709 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 710 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 711 ENDIF 712 ! 713 ! ! -- check s_i -- ! 714 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 715 zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 716 IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 717 zfra = psi_max(ji,jj,jl) / zsi 718 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 719 psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 720 ENDIF 721 ! 722 ENDIF 723 END_2D 762 724 END DO 763 725 ! 764 726 ! ! -- check e_i/v_i -- ! 765 727 DO jl = 1, jpl 766 DO jk = 1, nlay_i 767 DO jj = 1, jpj 768 DO ji = 1, jpi 769 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 770 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 771 zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 772 IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 773 zfra = pei_max(ji,jj,jk,jl) / zei 774 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 775 pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 776 ENDIF 777 ENDIF 778 END DO 779 END DO 780 END DO 728 DO_3D_11_11( 1, nlay_i ) 729 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 730 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 731 zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 732 IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 733 zfra = pei_max(ji,jj,jk,jl) / zei 734 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 735 pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 736 ENDIF 737 ENDIF 738 END_3D 781 739 END DO 782 740 ! ! -- check e_s/v_s -- ! 783 741 DO jl = 1, jpl 784 DO jk = 1, nlay_s 785 DO jj = 1, jpj 786 DO ji = 1, jpi 787 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 788 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 789 zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 790 IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 791 zfra = pes_max(ji,jj,jk,jl) / zes 792 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 793 pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 794 ENDIF 795 ENDIF 796 END DO 797 END DO 798 END DO 742 DO_3D_11_11( 1, nlay_s ) 743 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 744 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 745 zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 746 IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 747 zfra = pes_max(ji,jj,jk,jl) / zes 748 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 749 pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 750 ENDIF 751 ENDIF 752 END_3D 799 753 END DO 800 754 ! … … 829 783 ! -- check snow load -- ! 830 784 DO jl = 1, jpl 831 DO jj = 1, jpj 832 DO ji = 1, jpi 833 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 834 ! 835 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 836 ! 837 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 838 ! put snow excess in the ocean 839 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 840 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 841 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 842 ! correct snow volume and heat content 843 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 844 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 845 ENDIF 846 ! 847 ENDIF 848 END DO 849 END DO 785 DO_2D_11_11 786 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 787 ! 788 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 789 ! 790 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 791 ! put snow excess in the ocean 792 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 793 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 794 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 795 ! correct snow volume and heat content 796 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 797 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 798 ENDIF 799 ! 800 ENDIF 801 END_2D 850 802 END DO 851 803 ! -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90
r13466 r13469 114 114 END WHERE 115 115 DO jl = 1, jpl 116 DO jj = 2, jpjm1 117 DO ji = fs_2, fs_jpim1 118 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 119 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 120 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 121 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 122 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 123 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 124 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 125 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 126 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 127 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 128 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 129 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 130 zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj ,jl), zs_i (ji ,jj+1,jl), & 131 & zs_i (ji-1,jj ,jl), zs_i (ji ,jj-1,jl), & 132 & zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 133 & zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 134 END DO 135 END DO 116 DO_2D_00_00 117 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 118 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 119 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 120 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 121 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 122 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 123 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 124 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 125 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 126 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 127 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 128 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 129 zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj ,jl), zs_i (ji ,jj+1,jl), & 130 & zs_i (ji-1,jj ,jl), zs_i (ji ,jj-1,jl), & 131 & zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 132 & zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 133 END_2D 136 134 END DO 137 135 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. ) … … 149 147 END DO 150 148 DO jl = 1, jpl 151 DO jk = 1, nlay_i 152 DO jj = 2, jpjm1 153 DO ji = fs_2, fs_jpim1 154 zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj ,jk,jl), ze_i(ji ,jj+1,jk,jl), & 155 & ze_i(ji-1,jj ,jk,jl), ze_i(ji ,jj-1,jk,jl), & 156 & ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 157 & ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 158 END DO 159 END DO 160 END DO 161 END DO 162 DO jl = 1, jpl 163 DO jk = 1, nlay_s 164 DO jj = 2, jpjm1 165 DO ji = fs_2, fs_jpim1 166 zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj ,jk,jl), ze_s(ji ,jj+1,jk,jl), & 167 & ze_s(ji-1,jj ,jk,jl), ze_s(ji ,jj-1,jk,jl), & 168 & ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 169 & ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 170 END DO 171 END DO 172 END DO 149 DO_3D_00_00( 1, nlay_i ) 150 zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj ,jk,jl), ze_i(ji ,jj+1,jk,jl), & 151 & ze_i(ji-1,jj ,jk,jl), ze_i(ji ,jj-1,jk,jl), & 152 & ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 153 & ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 154 END_3D 155 END DO 156 DO jl = 1, jpl 157 DO_3D_00_00( 1, nlay_s ) 158 zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj ,jk,jl), ze_s(ji ,jj+1,jk,jl), & 159 & ze_s(ji-1,jj ,jk,jl), ze_s(ji ,jj-1,jk,jl), & 160 & ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 161 & ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 162 END_3D 173 163 END DO 174 164 CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) … … 201 191 ! 202 192 ! --- define velocity for advection: u*grad(H) --- ! 203 DO jj = 2, jpjm1 204 DO ji = fs_2, fs_jpim1 205 IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 206 ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj) 207 ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj) 208 ENDIF 209 210 IF ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 211 ELSEIF( pv_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = pv_ice(ji,jj-1) 212 ELSE ; zcv_box(ji,jj) = pv_ice(ji,jj ) 213 ENDIF 214 END DO 215 END DO 193 DO_2D_00_00 194 IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 195 ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj) 196 ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj) 197 ENDIF 198 199 IF ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 200 ELSEIF( pv_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = pv_ice(ji,jj-1) 201 ELSE ; zcv_box(ji,jj) = pv_ice(ji,jj ) 202 ENDIF 203 END_2D 216 204 217 205 !---------------! … … 236 224 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 237 225 DO jl = 1, jpl 238 DO jj = 1, jpjm1 239 DO ji = 1, jpim1 240 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 241 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 242 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 243 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 244 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 245 ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF 246 END DO 247 END DO 226 DO_2D_10_10 227 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 228 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 229 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 230 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 231 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 232 ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF 233 END_2D 248 234 END DO 249 235 ENDIF … … 394 380 !== Open water area ==! 395 381 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 396 DO jj = 2, jpjm1 397 DO ji = fs_2, fs_jpim1 398 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 399 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 400 END DO 401 END DO 382 DO_2D_00_00 383 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 384 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 385 END_2D 402 386 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1. ) 403 387 ! … … 506 490 IF( pamsk == 0._wp ) THEN 507 491 DO jl = 1, jpl 508 DO jj = 1, jpjm1 509 DO ji = 1, fs_jpim1 510 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 511 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) 512 zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 513 ELSE 514 zfu_ho (ji,jj,jl) = 0._wp 515 zfu_ups(ji,jj,jl) = 0._wp 516 ENDIF 517 ! 518 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 519 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) 520 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 521 ELSE 522 zfv_ho (ji,jj,jl) = 0._wp 523 zfv_ups(ji,jj,jl) = 0._wp 524 ENDIF 525 END DO 526 END DO 492 DO_2D_10_10 493 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 494 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) 495 zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 496 ELSE 497 zfu_ho (ji,jj,jl) = 0._wp 498 zfu_ups(ji,jj,jl) = 0._wp 499 ENDIF 500 ! 501 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 502 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) 503 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 504 ELSE 505 zfv_ho (ji,jj,jl) = 0._wp 506 zfv_ups(ji,jj,jl) = 0._wp 507 ENDIF 508 END_2D 527 509 END DO 528 510 … … 530 512 ! thus we calculate the upstream solution and apply a limiter again 531 513 DO jl = 1, jpl 532 DO jj = 2, jpjm1 533 DO ji = fs_2, fs_jpim1 534 ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 535 ! 536 zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 537 END DO 538 END DO 514 DO_2D_00_00 515 ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 516 ! 517 zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 518 END_2D 539 519 END DO 540 520 CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1. ) … … 553 533 IF( PRESENT( pua_ho ) ) THEN 554 534 DO jl = 1, jpl 555 DO jj = 1, jpjm1 556 DO ji = 1, fs_jpim1 557 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 558 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 559 END DO 560 END DO 535 DO_2D_10_10 536 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 537 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 538 END_2D 561 539 END DO 562 540 ENDIF … … 565 543 ! --------------------------------- 566 544 DO jl = 1, jpl 567 DO jj = 2, jpjm1 568 DO ji = fs_2, fs_jpim1 569 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 570 ! 571 ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 572 END DO 573 END DO 545 DO_2D_00_00 546 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 547 ! 548 ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 549 END_2D 574 550 END DO 575 551 CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T', 1. ) … … 601 577 ! 602 578 DO jl = 1, jpl 603 DO jj = 1, jpjm1 604 DO ji = 1, fs_jpim1 579 DO_2D_10_10 580 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 581 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 582 END_2D 583 END DO 584 ! 585 ELSE !** alternate directions **! 586 ! 587 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 588 ! 589 DO jl = 1, jpl !-- flux in x-direction 590 DO_2D_10_10 605 591 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 592 END_2D 593 END DO 594 ! 595 DO jl = 1, jpl !-- first guess of tracer from u-flux 596 DO_2D_00_00 597 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 598 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 599 ! 600 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 601 END_2D 602 END DO 603 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 604 ! 605 DO jl = 1, jpl !-- flux in y-direction 606 DO_2D_10_10 607 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 608 END_2D 609 END DO 610 ! 611 ELSE !== even ice time step: adv_y then adv_x ==! 612 ! 613 DO jl = 1, jpl !-- flux in y-direction 614 DO_2D_10_10 606 615 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 607 END DO 608 END DO 609 END DO 610 ! 611 ELSE !** alternate directions **! 612 ! 613 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 616 END_2D 617 END DO 618 ! 619 DO jl = 1, jpl !-- first guess of tracer from v-flux 620 DO_2D_00_00 621 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 622 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 623 ! 624 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 625 END_2D 626 END DO 627 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 614 628 ! 615 629 DO jl = 1, jpl !-- flux in x-direction 616 DO jj = 1, jpjm1 617 DO ji = 1, fs_jpim1 618 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 619 END DO 620 END DO 621 END DO 622 ! 623 DO jl = 1, jpl !-- first guess of tracer from u-flux 624 DO jj = 2, jpjm1 625 DO ji = fs_2, fs_jpim1 626 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 627 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 628 ! 629 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 630 END DO 631 END DO 632 END DO 633 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 634 ! 635 DO jl = 1, jpl !-- flux in y-direction 636 DO jj = 1, jpjm1 637 DO ji = 1, fs_jpim1 638 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 639 END DO 640 END DO 641 END DO 642 ! 643 ELSE !== even ice time step: adv_y then adv_x ==! 644 ! 645 DO jl = 1, jpl !-- flux in y-direction 646 DO jj = 1, jpjm1 647 DO ji = 1, fs_jpim1 648 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 649 END DO 650 END DO 651 END DO 652 ! 653 DO jl = 1, jpl !-- first guess of tracer from v-flux 654 DO jj = 2, jpjm1 655 DO ji = fs_2, fs_jpim1 656 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 657 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 658 ! 659 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 660 END DO 661 END DO 662 END DO 663 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 664 ! 665 DO jl = 1, jpl !-- flux in x-direction 666 DO jj = 1, jpjm1 667 DO ji = 1, fs_jpim1 668 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 669 END DO 670 END DO 630 DO_2D_10_10 631 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 632 END_2D 671 633 END DO 672 634 ! … … 676 638 ! 677 639 DO jl = 1, jpl !-- after tracer with upstream scheme 678 DO jj = 2, jpjm1 679 DO ji = fs_2, fs_jpim1 680 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) & 681 & + pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) & 682 & + ( pu (ji,jj ) - pu (ji-1,jj ) & 683 & + pv (ji,jj ) - pv (ji ,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 684 ! 685 pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 686 END DO 687 END DO 640 DO_2D_00_00 641 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) & 642 & + pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) & 643 & + ( pu (ji,jj ) - pu (ji-1,jj ) & 644 & + pv (ji,jj ) - pv (ji ,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 645 ! 646 pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 647 END_2D 688 648 END DO 689 649 CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. ) … … 717 677 ! 718 678 DO jl = 1, jpl 719 DO jj = 1, jpjm1 720 DO ji = 1, fs_jpim1 721 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 722 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 723 END DO 724 END DO 679 DO_2D_10_10 680 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 681 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 682 END_2D 725 683 END DO 726 684 ! … … 737 695 ! 738 696 DO jl = 1, jpl !-- flux in x-direction 739 DO jj = 1, jpjm1 740 DO ji = 1, fs_jpim1 741 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 742 END DO 743 END DO 697 DO_2D_10_10 698 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 699 END_2D 744 700 END DO 745 701 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 746 702 747 703 DO jl = 1, jpl !-- first guess of tracer from u-flux 748 DO jj = 2, jpjm1 749 DO ji = fs_2, fs_jpim1 750 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 751 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 752 ! 753 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 754 END DO 755 END DO 704 DO_2D_00_00 705 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 706 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) 707 ! 708 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 709 END_2D 756 710 END DO 757 711 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 758 712 759 713 DO jl = 1, jpl !-- flux in y-direction 760 DO jj = 1, jpjm1 761 DO ji = 1, fs_jpim1 762 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 763 END DO 764 END DO 714 DO_2D_10_10 715 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 716 END_2D 765 717 END DO 766 718 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) … … 769 721 ! 770 722 DO jl = 1, jpl !-- flux in y-direction 771 DO jj = 1, jpjm1 772 DO ji = 1, fs_jpim1 773 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 774 END DO 775 END DO 723 DO_2D_10_10 724 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 725 END_2D 776 726 END DO 777 727 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 778 728 ! 779 729 DO jl = 1, jpl !-- first guess of tracer from v-flux 780 DO jj = 2, jpjm1 781 DO ji = fs_2, fs_jpim1 782 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 783 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 784 ! 785 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 786 END DO 787 END DO 730 DO_2D_00_00 731 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 732 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) 733 ! 734 zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 735 END_2D 788 736 END DO 789 737 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 790 738 ! 791 739 DO jl = 1, jpl !-- flux in x-direction 792 DO jj = 1, jpjm1 793 DO ji = 1, fs_jpim1 794 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 795 END DO 796 END DO 740 DO_2D_10_10 741 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 742 END_2D 797 743 END DO 798 744 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) … … 840 786 ! !-- advective form update in zpt --! 841 787 DO jl = 1, jpl 842 DO jj = 2, jpjm1 843 DO ji = fs_2, fs_jpim1 844 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t (ji,jj) & 845 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & 846 & * pamsk & 847 & ) * pdt ) * tmask(ji,jj,1) 848 END DO 849 END DO 788 DO_2D_00_00 789 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t (ji,jj) & 790 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & 791 & * pamsk & 792 & ) * pdt ) * tmask(ji,jj,1) 793 END_2D 850 794 END DO 851 795 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) … … 869 813 ! !-- advective form update in zpt --! 870 814 DO jl = 1, jpl 871 DO jj = 2, jpjm1 872 DO ji = fs_2, fs_jpim1 873 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t (ji,jj) & 874 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & 875 & * pamsk & 876 & ) * pdt ) * tmask(ji,jj,1) 877 END DO 878 END DO 815 DO_2D_00_00 816 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t (ji,jj) & 817 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & 818 & * pamsk & 819 & ) * pdt ) * tmask(ji,jj,1) 820 END_2D 879 821 END DO 880 822 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) … … 953 895 ! 954 896 DO jl = 1, jpl 955 DO jj = 1, jpjm1 956 DO ji = 1, fs_jpim1 ! vector opt. 957 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 958 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 959 END DO 960 END DO 897 DO_2D_10_10 898 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 899 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 900 END_2D 961 901 END DO 962 902 ! … … 964 904 ! 965 905 DO jl = 1, jpl 966 DO jj = 1, jpjm1 967 DO ji = 1, fs_jpim1 ! vector opt. 968 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 969 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 970 & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 971 END DO 972 END DO 906 DO_2D_10_10 907 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 908 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 909 & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 910 END_2D 973 911 END DO 974 912 ! … … 976 914 ! 977 915 DO jl = 1, jpl 978 DO jj = 1, jpjm1 979 DO ji = 1, fs_jpim1 ! vector opt. 980 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 981 zdx2 = e1u(ji,jj) * e1u(ji,jj) 916 DO_2D_10_10 917 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 918 zdx2 = e1u(ji,jj) * e1u(ji,jj) 982 919 !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj) 983 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 984 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 985 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 986 & - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 987 END DO 988 END DO 920 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 921 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 922 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 923 & - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 924 END_2D 989 925 END DO 990 926 ! … … 992 928 ! 993 929 DO jl = 1, jpl 994 DO jj = 1, jpjm1 995 DO ji = 1, fs_jpim1 ! vector opt. 996 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 997 zdx2 = e1u(ji,jj) * e1u(ji,jj) 930 DO_2D_10_10 931 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 932 zdx2 = e1u(ji,jj) * e1u(ji,jj) 998 933 !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj) 999 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 1000 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 1001 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 1002 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 1003 END DO 1004 END DO 934 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 935 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 936 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 937 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 938 END_2D 1005 939 END DO 1006 940 ! … … 1008 942 ! 1009 943 DO jl = 1, jpl 1010 DO jj = 1, jpjm1 1011 DO ji = 1, fs_jpim1 ! vector opt. 1012 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 1013 zdx2 = e1u(ji,jj) * e1u(ji,jj) 944 DO_2D_10_10 945 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 946 zdx2 = e1u(ji,jj) * e1u(ji,jj) 1014 947 !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj) 1015 zdx4 = zdx2 * zdx2 1016 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 1017 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 1018 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 1019 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 1020 & + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl) & 1021 & - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 1022 END DO 1023 END DO 948 zdx4 = zdx2 * zdx2 949 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) & 950 & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) & 951 & + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) & 952 & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 953 & + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl) & 954 & - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 955 END_2D 1024 956 END DO 1025 957 ! … … 1031 963 IF( ll_neg ) THEN 1032 964 DO jl = 1, jpl 1033 DO jj = 1, jpjm1 1034 DO ji = 1, fs_jpim1 1035 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1036 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 1037 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 1038 ENDIF 1039 END DO 1040 END DO 965 DO_2D_10_10 966 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 967 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 968 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 969 ENDIF 970 END_2D 1041 971 END DO 1042 972 ENDIF 1043 973 ! !-- High order flux in i-direction --! 1044 974 DO jl = 1, jpl 1045 DO jj = 1, jpjm1 1046 DO ji = 1, fs_jpim1 ! vector opt. 1047 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 1048 END DO 1049 END DO 975 DO_2D_10_10 976 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 977 END_2D 1050 978 END DO 1051 979 ! … … 1078 1006 ! !-- Laplacian in j-direction --! 1079 1007 DO jl = 1, jpl 1080 DO jj = 1, jpjm1 ! First derivative (gradient) 1081 DO ji = fs_2, fs_jpim1 1082 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1083 END DO 1084 END DO 1085 DO jj = 2, jpjm1 ! Second derivative (Laplacian) 1086 DO ji = fs_2, fs_jpim1 1087 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1088 END DO 1089 END DO 1008 DO_2D_10_00 1009 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1010 END_2D 1011 DO_2D_00_00 1012 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1013 END_2D 1090 1014 END DO 1091 1015 CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. ) … … 1093 1017 ! !-- BiLaplacian in j-direction --! 1094 1018 DO jl = 1, jpl 1095 DO jj = 1, jpjm1 ! First derivative 1096 DO ji = fs_2, fs_jpim1 1097 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1098 END DO 1099 END DO 1100 DO jj = 2, jpjm1 ! Second derivative 1101 DO ji = fs_2, fs_jpim1 1102 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1103 END DO 1104 END DO 1019 DO_2D_10_00 1020 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1021 END_2D 1022 DO_2D_00_00 1023 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1024 END_2D 1105 1025 END DO 1106 1026 CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. ) … … 1111 1031 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 1112 1032 DO jl = 1, jpl 1113 DO jj = 1, jpjm1 1114 DO ji = 1, fs_jpim1 1115 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1116 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1117 END DO 1118 END DO 1033 DO_2D_10_10 1034 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1035 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1036 END_2D 1119 1037 END DO 1120 1038 ! 1121 1039 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 1122 1040 DO jl = 1, jpl 1123 DO jj = 1, jpjm1 1124 DO ji = 1, fs_jpim1 1125 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1126 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1127 & - zcv * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1128 END DO 1129 END DO 1041 DO_2D_10_10 1042 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1043 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1044 & - zcv * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1045 END_2D 1130 1046 END DO 1131 1047 ! 1132 1048 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 1133 1049 DO jl = 1, jpl 1134 DO jj = 1, jpjm1 1135 DO ji = 1, fs_jpim1 1136 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1137 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1050 DO_2D_10_10 1051 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1052 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1138 1053 !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj) 1139 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1140 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1141 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1142 & - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1143 END DO 1144 END DO 1054 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1055 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1056 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1057 & - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1058 END_2D 1145 1059 END DO 1146 1060 ! 1147 1061 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 1148 1062 DO jl = 1, jpl 1149 DO jj = 1, jpjm1 1150 DO ji = 1, fs_jpim1 1151 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1152 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1063 DO_2D_10_10 1064 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1065 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1153 1066 !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj) 1154 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1155 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1156 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1157 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1158 END DO 1159 END DO 1067 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1068 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1069 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1070 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 1071 END_2D 1160 1072 END DO 1161 1073 ! 1162 1074 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 1163 1075 DO jl = 1, jpl 1164 DO jj = 1, jpjm1 1165 DO ji = 1, fs_jpim1 1166 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1167 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1076 DO_2D_10_10 1077 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1078 zdy2 = e2v(ji,jj) * e2v(ji,jj) 1168 1079 !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj) 1169 zdy4 = zdy2 * zdy2 1170 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1171 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1172 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1173 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 1174 & + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl) & 1175 & - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 1176 END DO 1177 END DO 1080 zdy4 = zdy2 * zdy2 1081 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) & 1082 & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) & 1083 & + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) & 1084 & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 1085 & + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl) & 1086 & - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 1087 END_2D 1178 1088 END DO 1179 1089 ! … … 1185 1095 IF( ll_neg ) THEN 1186 1096 DO jl = 1, jpl 1187 DO jj = 1, jpjm1 1188 DO ji = 1, fs_jpim1 1189 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1190 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & 1191 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1192 ENDIF 1193 END DO 1194 END DO 1097 DO_2D_10_10 1098 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1099 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & 1100 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 1101 ENDIF 1102 END_2D 1195 1103 END DO 1196 1104 ENDIF 1197 1105 ! !-- High order flux in j-direction --! 1198 1106 DO jl = 1, jpl 1199 DO jj = 1, jpjm1 1200 DO ji = 1, fs_jpim1 ! vector opt. 1201 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1202 END DO 1203 END DO 1107 DO_2D_10_10 1108 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1109 END_2D 1204 1110 END DO 1205 1111 ! … … 1235 1141 ! -------------------------------------------------- 1236 1142 DO jl = 1, jpl 1237 DO jj = 1, jpjm1 1238 DO ji = 1, fs_jpim1 ! vector opt. 1239 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1240 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1241 END DO 1242 END DO 1143 DO_2D_10_10 1144 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1145 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1146 END_2D 1243 1147 END DO 1244 1148 … … 1254 1158 1255 1159 DO jl = 1, jpl 1256 DO jj = 2, jpjm1 1257 DO ji = fs_2, fs_jpim1 1258 zti_ups(ji,jj,jl)= pt_ups(ji+1,jj ,jl) 1259 ztj_ups(ji,jj,jl)= pt_ups(ji ,jj+1,jl) 1260 END DO 1261 END DO 1160 DO_2D_00_00 1161 zti_ups(ji,jj,jl)= pt_ups(ji+1,jj ,jl) 1162 ztj_ups(ji,jj,jl)= pt_ups(ji ,jj+1,jl) 1163 END_2D 1262 1164 END DO 1263 1165 CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. ) 1264 1166 1265 1167 DO jl = 1, jpl 1266 DO jj = 2, jpjm1 1267 DO ji = fs_2, fs_jpim1 1268 IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND. & 1269 & pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 1270 ! 1271 IF( pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND. & 1272 & pfv_ho(ji,jj,jl) * ( ztj_ups(ji ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 1273 pfu_ho(ji,jj,jl)=0._wp 1274 pfv_ho(ji,jj,jl)=0._wp 1275 ENDIF 1276 ! 1277 IF( pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj ,jl) ) <= 0._wp .AND. & 1278 & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji ,jj-1,jl) ) <= 0._wp ) THEN 1279 pfu_ho(ji,jj,jl)=0._wp 1280 pfv_ho(ji,jj,jl)=0._wp 1281 ENDIF 1282 ! 1168 DO_2D_00_00 1169 IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND. & 1170 & pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 1171 ! 1172 IF( pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND. & 1173 & pfv_ho(ji,jj,jl) * ( ztj_ups(ji ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 1174 pfu_ho(ji,jj,jl)=0._wp 1175 pfv_ho(ji,jj,jl)=0._wp 1283 1176 ENDIF 1284 END DO 1285 END DO 1177 ! 1178 IF( pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj ,jl) ) <= 0._wp .AND. & 1179 & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji ,jj-1,jl) ) <= 0._wp ) THEN 1180 pfu_ho(ji,jj,jl)=0._wp 1181 pfv_ho(ji,jj,jl)=0._wp 1182 ENDIF 1183 ! 1184 ENDIF 1185 END_2D 1286 1186 END DO 1287 1187 CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. ) ! lateral boundary cond. … … 1295 1195 DO jl = 1, jpl 1296 1196 1297 DO jj = 1, jpj 1298 DO ji = 1, jpi 1299 IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1300 zbup(ji,jj) = -zbig 1301 zbdo(ji,jj) = zbig 1302 ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN 1303 zbup(ji,jj) = pt_ups(ji,jj,jl) 1304 zbdo(ji,jj) = pt_ups(ji,jj,jl) 1305 ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1306 zbup(ji,jj) = pt(ji,jj,jl) 1307 zbdo(ji,jj) = pt(ji,jj,jl) 1308 ELSE 1309 zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1310 zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1311 ENDIF 1312 END DO 1313 END DO 1314 1315 DO jj = 2, jpjm1 1316 DO ji = fs_2, fs_jpim1 ! vector opt. 1317 ! 1318 zup = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) ) ! search max/min in neighbourhood 1319 zdo = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 1320 ! 1321 zpos = MAX( 0._wp, pfu_ho(ji-1,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji ,jj ,jl) ) & ! positive/negative part of the flux 1322 & + MAX( 0._wp, pfv_ho(ji ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj ,jl) ) 1323 zneg = MAX( 0._wp, pfu_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj ,jl) ) & 1324 & + MAX( 0._wp, pfv_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj-1,jl) ) 1325 ! 1326 zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1327 & ) * ( 1. - pamsk ) 1328 zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1329 & ) * ( 1. - pamsk ) 1330 ! 1331 ! ! up & down beta terms 1332 ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 1333 IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 1334 ELSE ; zbetup(ji,jj,jl) = 0._wp ! zbig 1335 ENDIF 1336 ! 1337 IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 1338 ELSE ; zbetdo(ji,jj,jl) = 0._wp ! zbig 1339 ENDIF 1340 ! 1341 ! if all the points are outside ice cover 1342 IF( zup == -zbig ) zbetup(ji,jj,jl) = 0._wp ! zbig 1343 IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig 1344 ! 1345 END DO 1346 END DO 1197 DO_2D_11_11 1198 IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1199 zbup(ji,jj) = -zbig 1200 zbdo(ji,jj) = zbig 1201 ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN 1202 zbup(ji,jj) = pt_ups(ji,jj,jl) 1203 zbdo(ji,jj) = pt_ups(ji,jj,jl) 1204 ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1205 zbup(ji,jj) = pt(ji,jj,jl) 1206 zbdo(ji,jj) = pt(ji,jj,jl) 1207 ELSE 1208 zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1209 zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 1210 ENDIF 1211 END_2D 1212 1213 DO_2D_00_00 1214 ! 1215 zup = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) ) ! search max/min in neighbourhood 1216 zdo = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 1217 ! 1218 zpos = MAX( 0._wp, pfu_ho(ji-1,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji ,jj ,jl) ) & ! positive/negative part of the flux 1219 & + MAX( 0._wp, pfv_ho(ji ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj ,jl) ) 1220 zneg = MAX( 0._wp, pfu_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj ,jl) ) & 1221 & + MAX( 0._wp, pfv_ho(ji ,jj ,jl) ) - MIN( 0._wp, pfv_ho(ji ,jj-1,jl) ) 1222 ! 1223 zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1224 & ) * ( 1. - pamsk ) 1225 zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1226 & ) * ( 1. - pamsk ) 1227 ! 1228 ! ! up & down beta terms 1229 ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 1230 IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 1231 ELSE ; zbetup(ji,jj,jl) = 0._wp ! zbig 1232 ENDIF 1233 ! 1234 IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 1235 ELSE ; zbetdo(ji,jj,jl) = 0._wp ! zbig 1236 ENDIF 1237 ! 1238 ! if all the points are outside ice cover 1239 IF( zup == -zbig ) zbetup(ji,jj,jl) = 0._wp ! zbig 1240 IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig 1241 ! 1242 END_2D 1347 1243 END DO 1348 1244 CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) … … 1352 1248 ! --------------------------------- 1353 1249 DO jl = 1, jpl 1354 DO jj = 1, jpjm1 1355 DO ji = 1, fs_jpim1 ! vector opt. 1356 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 1357 zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 1358 zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 1359 ! 1360 zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 1361 ! 1362 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl) 1363 ! 1364 END DO 1365 END DO 1366 1367 DO jj = 1, jpjm1 1368 DO ji = 1, fs_jpim1 ! vector opt. 1369 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1370 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 1371 zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 1372 ! 1373 zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 1374 ! 1375 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl) 1376 ! 1377 END DO 1378 END DO 1250 DO_2D_10_10 1251 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 1252 zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 1253 zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 1254 ! 1255 zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 1256 ! 1257 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl) 1258 ! 1259 END_2D 1260 1261 DO_2D_10_10 1262 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1263 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 1264 zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 1265 ! 1266 zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 1267 ! 1268 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl) 1269 ! 1270 END_2D 1379 1271 1380 1272 END DO … … 1401 1293 ! 1402 1294 DO jl = 1, jpl 1403 DO jj = 2, jpjm1 1404 DO ji = fs_2, fs_jpim1 ! vector opt. 1405 zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 1406 END DO 1407 END DO 1295 DO_2D_00_00 1296 zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 1297 END_2D 1408 1298 END DO 1409 1299 CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.) ! lateral boundary cond. 1410 1300 1411 1301 DO jl = 1, jpl 1412 DO jj = 2, jpjm1 1413 DO ji = fs_2, fs_jpim1 ! vector opt. 1414 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1415 1416 Rjm = zslpx(ji-1,jj,jl) 1417 Rj = zslpx(ji ,jj,jl) 1418 Rjp = zslpx(ji+1,jj,jl) 1419 1420 IF( np_limiter == 3 ) THEN 1421 1422 IF( pu(ji,jj) > 0. ) THEN ; Rr = Rjm 1423 ELSE ; Rr = Rjp 1302 DO_2D_00_00 1303 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1304 1305 Rjm = zslpx(ji-1,jj,jl) 1306 Rj = zslpx(ji ,jj,jl) 1307 Rjp = zslpx(ji+1,jj,jl) 1308 1309 IF( np_limiter == 3 ) THEN 1310 1311 IF( pu(ji,jj) > 0. ) THEN ; Rr = Rjm 1312 ELSE ; Rr = Rjp 1313 ENDIF 1314 1315 zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1316 IF( Rj > 0. ) THEN 1317 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)), & 1318 & MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1319 ELSE 1320 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)), & 1321 & MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1322 ENDIF 1323 pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 1324 1325 ELSEIF( np_limiter == 2 ) THEN 1326 IF( Rj /= 0. ) THEN 1327 IF( pu(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1328 ELSE ; Cr = Rjp / Rj 1424 1329 ENDIF 1425 1426 zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1427 IF( Rj > 0. ) THEN 1428 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)), & 1429 & MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1430 ELSE 1431 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)), & 1432 & MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 1433 ENDIF 1434 pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 1435 1436 ELSEIF( np_limiter == 2 ) THEN 1437 IF( Rj /= 0. ) THEN 1438 IF( pu(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1439 ELSE ; Cr = Rjp / Rj 1440 ENDIF 1441 ELSE 1442 Cr = 0. 1443 ENDIF 1444 1445 ! -- superbee -- 1446 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1447 ! -- van albada 2 -- 1448 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1449 ! -- sweby (with beta=1) -- 1450 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1451 ! -- van Leer -- 1452 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1453 ! -- ospre -- 1454 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1455 ! -- koren -- 1456 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1457 ! -- charm -- 1458 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1459 !ELSE ; zpsi = 0. 1460 !ENDIF 1461 ! -- van albada 1 -- 1462 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1463 ! -- smart -- 1464 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1465 ! -- umist -- 1466 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1467 1468 ! high order flux corrected by the limiter 1469 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5 1470 1330 ELSE 1331 Cr = 0. 1471 1332 ENDIF 1472 END DO 1473 END DO 1333 1334 ! -- superbee -- 1335 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1336 ! -- van albada 2 -- 1337 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1338 ! -- sweby (with beta=1) -- 1339 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1340 ! -- van Leer -- 1341 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1342 ! -- ospre -- 1343 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1344 ! -- koren -- 1345 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1346 ! -- charm -- 1347 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1348 !ELSE ; zpsi = 0. 1349 !ENDIF 1350 ! -- van albada 1 -- 1351 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1352 ! -- smart -- 1353 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1354 ! -- umist -- 1355 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1356 1357 ! high order flux corrected by the limiter 1358 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5 1359 1360 ENDIF 1361 END_2D 1474 1362 END DO 1475 1363 CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.) ! lateral boundary cond. … … 1496 1384 ! 1497 1385 DO jl = 1, jpl 1498 DO jj = 2, jpjm1 1499 DO ji = fs_2, fs_jpim1 ! vector opt. 1500 zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 1501 END DO 1502 END DO 1386 DO_2D_00_00 1387 zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 1388 END_2D 1503 1389 END DO 1504 1390 CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.) ! lateral boundary cond. 1505 1391 1506 1392 DO jl = 1, jpl 1507 DO jj = 2, jpjm1 1508 DO ji = fs_2, fs_jpim1 ! vector opt. 1509 vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 1510 1511 Rjm = zslpy(ji,jj-1,jl) 1512 Rj = zslpy(ji,jj ,jl) 1513 Rjp = zslpy(ji,jj+1,jl) 1514 1515 IF( np_limiter == 3 ) THEN 1516 1517 IF( pv(ji,jj) > 0. ) THEN ; Rr = Rjm 1518 ELSE ; Rr = Rjp 1393 DO_2D_00_00 1394 vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 1395 1396 Rjm = zslpy(ji,jj-1,jl) 1397 Rj = zslpy(ji,jj ,jl) 1398 Rjp = zslpy(ji,jj+1,jl) 1399 1400 IF( np_limiter == 3 ) THEN 1401 1402 IF( pv(ji,jj) > 0. ) THEN ; Rr = Rjm 1403 ELSE ; Rr = Rjp 1404 ENDIF 1405 1406 zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1407 IF( Rj > 0. ) THEN 1408 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)), & 1409 & MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1410 ELSE 1411 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)), & 1412 & MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1413 ENDIF 1414 pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 1415 1416 ELSEIF( np_limiter == 2 ) THEN 1417 1418 IF( Rj /= 0. ) THEN 1419 IF( pv(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1420 ELSE ; Cr = Rjp / Rj 1519 1421 ENDIF 1520 1521 zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1522 IF( Rj > 0. ) THEN 1523 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)), & 1524 & MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)), zh3, 1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1525 ELSE 1526 zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)), & 1527 & MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 1528 ENDIF 1529 pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 1530 1531 ELSEIF( np_limiter == 2 ) THEN 1532 1533 IF( Rj /= 0. ) THEN 1534 IF( pv(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj 1535 ELSE ; Cr = Rjp / Rj 1536 ENDIF 1537 ELSE 1538 Cr = 0. 1539 ENDIF 1540 1541 ! -- superbee -- 1542 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1543 ! -- van albada 2 -- 1544 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1545 ! -- sweby (with beta=1) -- 1546 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1547 ! -- van Leer -- 1548 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1549 ! -- ospre -- 1550 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1551 ! -- koren -- 1552 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1553 ! -- charm -- 1554 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1555 !ELSE ; zpsi = 0. 1556 !ENDIF 1557 ! -- van albada 1 -- 1558 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1559 ! -- smart -- 1560 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1561 ! -- umist -- 1562 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1563 1564 ! high order flux corrected by the limiter 1565 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5 1566 1422 ELSE 1423 Cr = 0. 1567 1424 ENDIF 1568 END DO 1569 END DO 1425 1426 ! -- superbee -- 1427 zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 1428 ! -- van albada 2 -- 1429 !!zpsi = 2.*Cr / (Cr*Cr+1.) 1430 ! -- sweby (with beta=1) -- 1431 !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 1432 ! -- van Leer -- 1433 !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 1434 ! -- ospre -- 1435 !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 1436 ! -- koren -- 1437 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 1438 ! -- charm -- 1439 !IF( Cr > 0. ) THEN ; zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 1440 !ELSE ; zpsi = 0. 1441 !ENDIF 1442 ! -- van albada 1 -- 1443 !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 1444 ! -- smart -- 1445 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 1446 ! -- umist -- 1447 !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 1448 1449 ! high order flux corrected by the limiter 1450 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5 1451 1452 ENDIF 1453 END_2D 1570 1454 END DO 1571 1455 CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.) ! lateral boundary cond. … … 1604 1488 ! 1605 1489 DO jl = 1, jpl 1606 DO jj = 1, jpj 1607 DO ji = 1, jpi 1608 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1490 DO_2D_11_11 1491 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1492 ! 1493 ! ! -- check h_ip -- ! 1494 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1495 IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1496 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1497 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 1498 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 1499 ENDIF 1500 ENDIF 1501 ! 1502 ! ! -- check h_i -- ! 1503 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 1504 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 1505 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1506 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 1507 ENDIF 1508 ! 1509 ! ! -- check h_s -- ! 1510 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 1511 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 1512 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1513 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 1609 1514 ! 1610 ! ! -- check h_ip -- ! 1611 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1612 IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1613 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1614 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 1615 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 1616 ENDIF 1617 ENDIF 1515 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 1516 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1618 1517 ! 1619 ! ! -- check h_i -- ! 1620 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 1621 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 1622 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1623 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 1624 ENDIF 1625 ! 1626 ! ! -- check h_s -- ! 1627 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 1628 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 1629 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1630 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 1631 ! 1632 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 1633 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1634 ! 1635 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1636 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1637 ENDIF 1638 ! 1639 ! ! -- check s_i -- ! 1640 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 1641 zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 1642 IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1643 zfra = psi_max(ji,jj,jl) / zsi 1644 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 1645 psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 1646 ENDIF 1647 ! 1518 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1519 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1520 ENDIF 1521 ! 1522 ! ! -- check s_i -- ! 1523 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 1524 zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 1525 IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1526 zfra = psi_max(ji,jj,jl) / zsi 1527 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 1528 psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 1648 1529 ENDIF 1649 END DO 1650 END DO 1530 ! 1531 ENDIF 1532 END_2D 1651 1533 END DO 1652 1534 ! 1653 1535 ! ! -- check e_i/v_i -- ! 1654 1536 DO jl = 1, jpl 1655 DO jk = 1, nlay_i 1656 DO jj = 1, jpj 1657 DO ji = 1, jpi 1658 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1659 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 1660 zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 1661 IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1662 zfra = pei_max(ji,jj,jk,jl) / zei 1663 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1664 pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 1665 ENDIF 1666 ENDIF 1667 END DO 1668 END DO 1669 END DO 1537 DO_3D_11_11( 1, nlay_i ) 1538 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1539 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 1540 zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 1541 IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1542 zfra = pei_max(ji,jj,jk,jl) / zei 1543 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1544 pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 1545 ENDIF 1546 ENDIF 1547 END_3D 1670 1548 END DO 1671 1549 ! ! -- check e_s/v_s -- ! 1672 1550 DO jl = 1, jpl 1673 DO jk = 1, nlay_s 1674 DO jj = 1, jpj 1675 DO ji = 1, jpi 1676 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 1677 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 1678 zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 1679 IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1680 zfra = pes_max(ji,jj,jk,jl) / zes 1681 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1682 pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 1683 ENDIF 1684 ENDIF 1685 END DO 1686 END DO 1687 END DO 1551 DO_3D_11_11( 1, nlay_s ) 1552 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 1553 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 1554 zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 1555 IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1556 zfra = pes_max(ji,jj,jk,jl) / zes 1557 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1558 pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 1559 ENDIF 1560 ENDIF 1561 END_3D 1688 1562 END DO 1689 1563 ! … … 1718 1592 ! -- check snow load -- ! 1719 1593 DO jl = 1, jpl 1720 DO jj = 1, jpj 1721 DO ji = 1, jpi 1722 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1723 ! 1724 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 1725 ! 1726 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 1727 ! put snow excess in the ocean 1728 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 1729 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 1730 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1731 ! correct snow volume and heat content 1732 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1733 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 1734 ENDIF 1735 ! 1594 DO_2D_11_11 1595 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1596 ! 1597 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 1598 ! 1599 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 1600 ! put snow excess in the ocean 1601 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 1602 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 1603 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1604 ! correct snow volume and heat content 1605 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1606 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 1736 1607 ENDIF 1737 END DO 1738 END DO 1608 ! 1609 ENDIF 1610 END_2D 1739 1611 END DO 1740 1612 ! -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90
r13466 r13469 159 159 npti = 0 ; nptidx(:) = 0 160 160 ipti = 0 ; iptidx(:) = 0 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 IF ( at_i(ji,jj) > epsi10 ) THEN 164 npti = npti + 1 165 nptidx( npti ) = (jj - 1) * jpi + ji 166 ENDIF 167 END DO 168 END DO 161 DO_2D_11_11 162 IF ( at_i(ji,jj) > epsi10 ) THEN 163 npti = npti + 1 164 nptidx( npti ) = (jj - 1) * jpi + ji 165 ENDIF 166 END_2D 169 167 170 168 !-------------------------------------------------------- … … 777 775 ! !--------------------------------------------------! 778 776 CASE( 1 ) !--- Spatial smoothing 779 DO jj = 2, jpjm1 780 DO ji = 2, jpim1 781 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 782 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 783 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & 784 & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 785 & ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 786 ELSE 787 zworka(ji,jj) = 0._wp 788 ENDIF 789 END DO 790 END DO 777 DO_2D_00_00 778 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 779 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 780 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & 781 & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 782 & ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 783 ELSE 784 zworka(ji,jj) = 0._wp 785 ENDIF 786 END_2D 791 787 792 DO jj = 2, jpjm1 793 DO ji = 2, jpim1 794 strength(ji,jj) = zworka(ji,jj) 795 END DO 796 END DO 788 DO_2D_00_00 789 strength(ji,jj) = zworka(ji,jj) 790 END_2D 797 791 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 798 792 ! … … 803 797 ENDIF 804 798 ! 805 DO jj = 2, jpjm1 806 DO ji = 2, jpim1 807 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 808 itframe = 1 ! number of time steps for the running mean 809 IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 810 IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 811 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 812 zstrp2 (ji,jj) = zstrp1 (ji,jj) 813 zstrp1 (ji,jj) = strength(ji,jj) 814 strength(ji,jj) = zp 815 ENDIF 816 END DO 817 END DO 799 DO_2D_00_00 800 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 801 itframe = 1 ! number of time steps for the running mean 802 IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 803 IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 804 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 805 zstrp2 (ji,jj) = zstrp1 (ji,jj) 806 zstrp1 (ji,jj) = strength(ji,jj) 807 strength(ji,jj) = zp 808 ENDIF 809 END_2D 818 810 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 819 811 ! -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90
r13467 r13469 182 182 ! for diagnostics and convergence tests 183 183 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 184 DO jj = 1, jpj 185 DO ji = 1, jpi 186 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 187 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 188 END DO 189 END DO 184 DO_2D_11_11 185 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 186 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 187 END_2D 190 188 ! 191 189 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... … … 194 192 !------------------------------------------------------------------------------! 195 193 ! ocean/land mask 196 DO jj = 1, jpjm1 197 DO ji = 1, jpim1 ! NO vector opt. 198 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 199 END DO 200 END DO 194 DO_2D_10_10 195 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 196 END_2D 201 197 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 202 198 203 199 ! Lateral boundary conditions on velocity (modify zfmask) 204 DO jj = 2, jpjm1 205 DO ji = fs_2, fs_jpim1 ! vector opt. 206 IF( zfmask(ji,jj) == 0._wp ) THEN 207 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 208 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 209 ENDIF 210 END DO 211 END DO 200 DO_2D_00_00 201 IF( zfmask(ji,jj) == 0._wp ) THEN 202 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 203 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 204 ENDIF 205 END_2D 212 206 DO jj = 2, jpjm1 213 207 IF( zfmask(1,jj) == 0._wp ) THEN … … 272 266 zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 273 267 274 DO jj = 2, jpjm1 275 DO ji = fs_2, fs_jpim1 276 277 ! ice fraction at U-V points 278 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 279 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 280 281 ! Ice/snow mass at U-V points 282 zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) ) 283 zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) ) 284 zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) ) 285 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 286 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 287 288 ! Ocean currents at U-V points 289 v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 290 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 291 292 ! Coriolis at T points (m*f) 293 zmf(ji,jj) = zm1 * ff_t(ji,jj) 294 295 ! dt/m at T points (for alpha and beta coefficients) 296 zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) 297 298 ! m/dt 299 zmU_t(ji,jj) = zmassU * z1_dtevp 300 zmV_t(ji,jj) = zmassV * z1_dtevp 301 302 ! Drag ice-atm. 303 ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 304 ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 305 306 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 307 zspgU(ji,jj) = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 308 zspgV(ji,jj) = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 309 310 ! masks 311 zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 312 zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 313 314 ! switches 315 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; zmsk01x(ji,jj) = 0._wp 316 ELSE ; zmsk01x(ji,jj) = 1._wp ; ENDIF 317 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; zmsk01y(ji,jj) = 0._wp 318 ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF 319 320 END DO 321 END DO 268 DO_2D_00_00 269 270 ! ice fraction at U-V points 271 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 272 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 273 274 ! Ice/snow mass at U-V points 275 zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) ) 276 zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) ) 277 zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) ) 278 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 279 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 280 281 ! Ocean currents at U-V points 282 v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 283 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 284 285 ! Coriolis at T points (m*f) 286 zmf(ji,jj) = zm1 * ff_t(ji,jj) 287 288 ! dt/m at T points (for alpha and beta coefficients) 289 zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) 290 291 ! m/dt 292 zmU_t(ji,jj) = zmassU * z1_dtevp 293 zmV_t(ji,jj) = zmassV * z1_dtevp 294 295 ! Drag ice-atm. 296 ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 297 ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 298 299 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 300 zspgU(ji,jj) = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 301 zspgV(ji,jj) = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 302 303 ! masks 304 zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 305 zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 306 307 ! switches 308 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; zmsk01x(ji,jj) = 0._wp 309 ELSE ; zmsk01x(ji,jj) = 1._wp ; ENDIF 310 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; zmsk01y(ji,jj) = 0._wp 311 ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF 312 313 END_2D 322 314 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. ) 323 315 ! … … 325 317 ! 326 318 IF( ln_landfast_L16 ) THEN !-- Lemieux 2016 327 DO jj = 2, jpjm1 328 DO ji = fs_2, fs_jpim1 329 ! ice thickness at U-V points 330 zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 331 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 332 ! ice-bottom stress at U points 333 zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj) 334 ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 335 ! ice-bottom stress at V points 336 zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj) 337 ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 338 ! ice_bottom stress at T points 339 zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj) 340 tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 341 END DO 342 END DO 319 DO_2D_00_00 320 ! ice thickness at U-V points 321 zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 322 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 323 ! ice-bottom stress at U points 324 zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj) 325 ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 326 ! ice-bottom stress at V points 327 zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj) 328 ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 329 ! ice_bottom stress at T points 330 zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj) 331 tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 332 END_2D 343 333 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 344 334 ! 345 335 ELSE !-- no landfast 346 DO jj = 2, jpjm1 347 DO ji = fs_2, fs_jpim1 348 ztaux_base(ji,jj) = 0._wp 349 ztauy_base(ji,jj) = 0._wp 350 END DO 351 END DO 336 DO_2D_00_00 337 ztaux_base(ji,jj) = 0._wp 338 ztauy_base(ji,jj) = 0._wp 339 END_2D 352 340 ENDIF 353 341 … … 363 351 ! convergence test 364 352 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 365 DO jj = 1, jpj 366 DO ji = 1, jpi 367 zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 368 zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 369 END DO 370 END DO 353 DO_2D_11_11 354 zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 355 zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 356 END_2D 371 357 ENDIF 372 358 373 359 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 374 DO jj = 1, jpjm1 ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 375 DO ji = 1, jpim1 376 377 ! shear at F points 378 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 379 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 380 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 381 382 END DO 383 END DO 360 DO_2D_10_10 361 362 ! shear at F points 363 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 364 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 365 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 366 367 END_2D 384 368 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 385 369 386 DO jj = 2, jpj ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 387 DO ji = 2, jpi ! no vector loop 388 389 ! shear**2 at T points (doc eq. A16) 390 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 391 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 392 & ) * 0.25_wp * r1_e1e2t(ji,jj) 393 394 ! divergence at T points 395 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 396 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 397 & ) * r1_e1e2t(ji,jj) 398 zdiv2 = zdiv * zdiv 399 400 ! tension at T points 401 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 402 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 403 & ) * r1_e1e2t(ji,jj) 404 zdt2 = zdt * zdt 405 406 ! delta at T points 407 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 408 409 ! P/delta at T points 410 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 411 412 ! alpha for aEVP 413 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 414 ! alpha = beta = sqrt(4*gamma) 415 IF( ln_aEVP ) THEN 416 zalph1 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 417 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 418 zalph2 = zalph1 419 z1_alph2 = z1_alph1 420 ! explicit: 421 ! z1_alph1 = 1._wp / zalph1 422 ! z1_alph2 = 1._wp / zalph1 423 ! zalph1 = zalph1 - 1._wp 424 ! zalph2 = zalph1 425 ENDIF 426 427 ! stress at T points (zkt/=0 if landfast) 428 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 429 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 430 431 END DO 432 END DO 370 DO_2D_01_01 371 372 ! shear**2 at T points (doc eq. A16) 373 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 374 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 375 & ) * 0.25_wp * r1_e1e2t(ji,jj) 376 377 ! divergence at T points 378 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 379 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 380 & ) * r1_e1e2t(ji,jj) 381 zdiv2 = zdiv * zdiv 382 383 ! tension at T points 384 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 385 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 386 & ) * r1_e1e2t(ji,jj) 387 zdt2 = zdt * zdt 388 389 ! delta at T points 390 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 391 392 ! P/delta at T points 393 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 394 395 ! alpha for aEVP 396 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 397 ! alpha = beta = sqrt(4*gamma) 398 IF( ln_aEVP ) THEN 399 zalph1 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 400 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 401 zalph2 = zalph1 402 z1_alph2 = z1_alph1 403 ! explicit: 404 ! z1_alph1 = 1._wp / zalph1 405 ! z1_alph2 = 1._wp / zalph1 406 ! zalph1 = zalph1 - 1._wp 407 ! zalph2 = zalph1 408 ENDIF 409 410 ! stress at T points (zkt/=0 if landfast) 411 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 412 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 413 414 END_2D 433 415 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 434 416 435 417 ! Save beta at T-points for further computations 436 418 IF( ln_aEVP ) THEN 437 DO jj = 1, jpj 438 DO ji = 1, jpi 439 zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 440 END DO 441 END DO 419 DO_2D_11_11 420 zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 421 END_2D 442 422 ENDIF 443 423 444 DO jj = 1, jpjm1 445 DO ji = 1, jpim1 446 447 ! alpha for aEVP 448 IF( ln_aEVP ) THEN 449 zalph2 = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 450 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 451 ! explicit: 452 ! z1_alph2 = 1._wp / zalph2 453 ! zalph2 = zalph2 - 1._wp 454 ENDIF 455 456 ! P/delta at F points 457 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 458 459 ! stress at F points (zkt/=0 if landfast) 460 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 461 462 END DO 463 END DO 424 DO_2D_10_10 425 426 ! alpha for aEVP 427 IF( ln_aEVP ) THEN 428 zalph2 = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 429 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 430 ! explicit: 431 ! z1_alph2 = 1._wp / zalph2 432 ! zalph2 = zalph2 - 1._wp 433 ENDIF 434 435 ! P/delta at F points 436 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 437 438 ! stress at F points (zkt/=0 if landfast) 439 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 440 441 END_2D 464 442 465 443 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 466 DO jj = 2, jpjm1 467 DO ji = fs_2, fs_jpim1 468 ! !--- U points 469 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 470 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 471 & ) * r1_e2u(ji,jj) & 472 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 473 & ) * 2._wp * r1_e1u(ji,jj) & 474 & ) * r1_e1e2u(ji,jj) 475 ! 476 ! !--- V points 477 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 478 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 479 & ) * r1_e1v(ji,jj) & 480 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 481 & ) * 2._wp * r1_e2v(ji,jj) & 482 & ) * r1_e1e2v(ji,jj) 483 ! 484 ! !--- ice currents at U-V point 485 v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 486 u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 487 ! 488 END DO 489 END DO 444 DO_2D_00_00 445 ! !--- U points 446 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 447 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 448 & ) * r1_e2u(ji,jj) & 449 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 450 & ) * 2._wp * r1_e1u(ji,jj) & 451 & ) * r1_e1e2u(ji,jj) 452 ! 453 ! !--- V points 454 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 455 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 456 & ) * r1_e1v(ji,jj) & 457 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 458 & ) * 2._wp * r1_e2v(ji,jj) & 459 & ) * r1_e1e2v(ji,jj) 460 ! 461 ! !--- ice currents at U-V point 462 v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 463 u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 464 ! 465 END_2D 490 466 ! 491 467 ! --- Computation of ice velocity --- ! … … 494 470 IF( MOD(jter,2) == 0 ) THEN ! even iterations 495 471 ! 496 DO jj = 2, jpjm1 497 DO ji = fs_2, fs_jpim1 498 ! !--- tau_io/(v_oce - v_ice) 499 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 500 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 501 ! !--- Ocean-to-Ice stress 502 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 503 ! 504 ! !--- tau_bottom/v_ice 505 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 506 zTauB = ztauy_base(ji,jj) / zvel 507 ! !--- OceanBottom-to-Ice stress 508 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 509 ! 510 ! !--- Coriolis at V-points (energy conserving formulation) 511 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 512 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 513 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 514 ! 515 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 516 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 517 ! 518 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 519 ! 1 = sliding friction : TauB < RHS 520 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 521 ! 522 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 523 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 524 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 525 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 526 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 527 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 528 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 529 & ) / ( zbetav + 1._wp ) & 530 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 531 & ) * zmsk00y(ji,jj) 532 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 533 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 534 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 535 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 536 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 537 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 538 & ) * zmsk00y(ji,jj) 539 ENDIF 540 END DO 541 END DO 472 DO_2D_00_00 473 ! !--- tau_io/(v_oce - v_ice) 474 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 475 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 476 ! !--- Ocean-to-Ice stress 477 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 478 ! 479 ! !--- tau_bottom/v_ice 480 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 481 zTauB = ztauy_base(ji,jj) / zvel 482 ! !--- OceanBottom-to-Ice stress 483 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 484 ! 485 ! !--- Coriolis at V-points (energy conserving formulation) 486 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 487 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 488 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 489 ! 490 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 491 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 492 ! 493 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 494 ! 1 = sliding friction : TauB < RHS 495 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 496 ! 497 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 498 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 499 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 500 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 501 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 502 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 503 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 504 & ) / ( zbetav + 1._wp ) & 505 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 506 & ) * zmsk00y(ji,jj) 507 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 508 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 509 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 510 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 511 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 512 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 513 & ) * zmsk00y(ji,jj) 514 ENDIF 515 END_2D 542 516 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 543 517 ! … … 548 522 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 549 523 ! 550 DO jj = 2, jpjm1 551 DO ji = fs_2, fs_jpim1 552 ! !--- tau_io/(u_oce - u_ice) 553 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 554 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 555 ! !--- Ocean-to-Ice stress 556 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 557 ! 558 ! !--- tau_bottom/u_ice 559 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 560 zTauB = ztaux_base(ji,jj) / zvel 561 ! !--- OceanBottom-to-Ice stress 562 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 563 ! 564 ! !--- Coriolis at U-points (energy conserving formulation) 565 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 566 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 567 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 568 ! 569 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 570 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 571 ! 572 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 573 ! 1 = sliding friction : TauB < RHS 574 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 575 ! 576 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 577 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 578 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 579 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 580 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 581 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 582 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 583 & ) / ( zbetau + 1._wp ) & 584 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 585 & ) * zmsk00x(ji,jj) 586 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 587 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 588 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 589 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 590 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 591 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 592 & ) * zmsk00x(ji,jj) 593 ENDIF 594 END DO 595 END DO 524 DO_2D_00_00 525 ! !--- tau_io/(u_oce - u_ice) 526 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 527 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 528 ! !--- Ocean-to-Ice stress 529 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 530 ! 531 ! !--- tau_bottom/u_ice 532 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 533 zTauB = ztaux_base(ji,jj) / zvel 534 ! !--- OceanBottom-to-Ice stress 535 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 536 ! 537 ! !--- Coriolis at U-points (energy conserving formulation) 538 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 539 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 540 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 541 ! 542 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 543 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 544 ! 545 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 546 ! 1 = sliding friction : TauB < RHS 547 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 548 ! 549 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 550 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 551 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 552 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 553 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 554 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 555 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 556 & ) / ( zbetau + 1._wp ) & 557 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 558 & ) * zmsk00x(ji,jj) 559 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 560 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 561 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 562 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 563 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 564 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 565 & ) * zmsk00x(ji,jj) 566 ENDIF 567 END_2D 596 568 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 597 569 ! … … 604 576 ELSE ! odd iterations 605 577 ! 606 DO jj = 2, jpjm1 607 DO ji = fs_2, fs_jpim1 608 ! !--- tau_io/(u_oce - u_ice) 609 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 610 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 611 ! !--- Ocean-to-Ice stress 612 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 613 ! 614 ! !--- tau_bottom/u_ice 615 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 616 zTauB = ztaux_base(ji,jj) / zvel 617 ! !--- OceanBottom-to-Ice stress 618 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 619 ! 620 ! !--- Coriolis at U-points (energy conserving formulation) 621 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 622 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 623 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 624 ! 625 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 626 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 627 ! 628 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 629 ! 1 = sliding friction : TauB < RHS 630 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 631 ! 632 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 633 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 634 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 635 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 636 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 637 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 638 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 639 & ) / ( zbetau + 1._wp ) & 640 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 641 & ) * zmsk00x(ji,jj) 642 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 643 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 644 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 645 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 646 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 647 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 648 & ) * zmsk00x(ji,jj) 649 ENDIF 650 END DO 651 END DO 578 DO_2D_00_00 579 ! !--- tau_io/(u_oce - u_ice) 580 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 581 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 582 ! !--- Ocean-to-Ice stress 583 ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 584 ! 585 ! !--- tau_bottom/u_ice 586 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 587 zTauB = ztaux_base(ji,jj) / zvel 588 ! !--- OceanBottom-to-Ice stress 589 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 590 ! 591 ! !--- Coriolis at U-points (energy conserving formulation) 592 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 593 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 594 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 595 ! 596 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 597 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 598 ! 599 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 600 ! 1 = sliding friction : TauB < RHS 601 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 602 ! 603 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 604 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 605 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 606 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 607 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 608 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 609 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 610 & ) / ( zbetau + 1._wp ) & 611 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 612 & ) * zmsk00x(ji,jj) 613 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 614 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 615 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 616 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 617 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 618 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 619 & ) * zmsk00x(ji,jj) 620 ENDIF 621 END_2D 652 622 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 653 623 ! … … 658 628 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 659 629 ! 660 DO jj = 2, jpjm1 661 DO ji = fs_2, fs_jpim1 662 ! !--- tau_io/(v_oce - v_ice) 663 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 664 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 665 ! !--- Ocean-to-Ice stress 666 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 667 ! 668 ! !--- tau_bottom/v_ice 669 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 670 zTauB = ztauy_base(ji,jj) / zvel 671 ! !--- OceanBottom-to-Ice stress 672 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 673 ! 674 ! !--- Coriolis at v-points (energy conserving formulation) 675 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 676 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 677 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 678 ! 679 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 680 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 681 ! 682 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 683 ! 1 = sliding friction : TauB < RHS 684 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 685 ! 686 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 687 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 688 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 689 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 690 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 691 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 692 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 693 & ) / ( zbetav + 1._wp ) & 694 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 695 & ) * zmsk00y(ji,jj) 696 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 697 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 698 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 699 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 700 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 701 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 702 & ) * zmsk00y(ji,jj) 703 ENDIF 704 END DO 705 END DO 630 DO_2D_00_00 631 ! !--- tau_io/(v_oce - v_ice) 632 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 633 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 634 ! !--- Ocean-to-Ice stress 635 ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 636 ! 637 ! !--- tau_bottom/v_ice 638 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 639 zTauB = ztauy_base(ji,jj) / zvel 640 ! !--- OceanBottom-to-Ice stress 641 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 642 ! 643 ! !--- Coriolis at v-points (energy conserving formulation) 644 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 645 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 646 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 647 ! 648 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 649 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 650 ! 651 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 652 ! 1 = sliding friction : TauB < RHS 653 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 654 ! 655 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 656 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 657 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 658 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 659 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 660 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 661 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 662 & ) / ( zbetav + 1._wp ) & 663 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 664 & ) * zmsk00y(ji,jj) 665 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 666 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 667 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 668 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 669 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 670 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 671 & ) * zmsk00y(ji,jj) 672 ENDIF 673 END_2D 706 674 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 707 675 ! … … 725 693 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 726 694 !------------------------------------------------------------------------------! 727 DO jj = 1, jpjm1 728 DO ji = 1, jpim1 729 730 ! shear at F points 731 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 732 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 733 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 734 735 END DO 736 END DO 695 DO_2D_10_10 696 697 ! shear at F points 698 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 699 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 700 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 701 702 END_2D 737 703 738 DO jj = 2, jpjm1 739 DO ji = 2, jpim1 ! no vector loop 740 741 ! tension**2 at T points 742 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 743 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 744 & ) * r1_e1e2t(ji,jj) 745 zdt2 = zdt * zdt 746 747 ! shear**2 at T points (doc eq. A16) 748 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 749 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 750 & ) * 0.25_wp * r1_e1e2t(ji,jj) 751 752 ! shear at T points 753 pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 754 755 ! divergence at T points 756 pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 757 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 758 & ) * r1_e1e2t(ji,jj) 759 760 ! delta at T points 761 zdelta = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 762 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 763 pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 764 765 END DO 766 END DO 704 DO_2D_00_00 705 706 ! tension**2 at T points 707 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 708 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 709 & ) * r1_e1e2t(ji,jj) 710 zdt2 = zdt * zdt 711 712 ! shear**2 at T points (doc eq. A16) 713 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 714 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 715 & ) * 0.25_wp * r1_e1e2t(ji,jj) 716 717 ! shear at T points 718 pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 719 720 ! divergence at T points 721 pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 722 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 723 & ) * r1_e1e2t(ji,jj) 724 725 ! delta at T points 726 zdelta = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 727 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 728 pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 729 730 END_2D 767 731 CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 768 732 … … 802 766 ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 803 767 ! 804 DO jj = 2, jpjm1 805 DO ji = 2, jpim1 806 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 807 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 808 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 809 810 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 811 812 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 768 DO_2D_00_00 769 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 770 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 771 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 772 773 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 774 775 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 813 776 814 777 !! zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) … … 816 779 !! zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress 817 780 !! ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11)) 818 zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) ) ! compressive stress, see Bouillon et al. 2015 819 zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear ) ! shear stress 820 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 821 END DO 822 END DO 781 zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) ) ! compressive stress, see Bouillon et al. 2015 782 zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear ) ! shear stress 783 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 784 END_2D 823 785 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 824 786 ! … … 855 817 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 856 818 ! 857 DO jj = 2, jpjm1 858 DO ji = 2, jpim1 859 ! 2D ice mass, snow mass, area transport arrays (X, Y) 860 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 861 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 862 863 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 864 zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) ! '' Y- '' 865 866 zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 867 zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) ! '' Y- '' 868 869 zdiag_xatrp(ji,jj) = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) ) ! area transport, X-component 870 zdiag_yatrp(ji,jj) = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) ) ! '' Y- '' 871 872 END DO 873 END DO 819 DO_2D_00_00 820 ! 2D ice mass, snow mass, area transport arrays (X, Y) 821 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 822 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 823 824 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 825 zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) ! '' Y- '' 826 827 zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 828 zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) ! '' Y- '' 829 830 zdiag_xatrp(ji,jj) = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) ) ! area transport, X-component 831 zdiag_yatrp(ji,jj) = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) ) ! '' Y- '' 832 833 END_2D 874 834 875 835 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & … … 957 917 zresm = 0._wp 958 918 ELSE 959 DO jj = 1, jpj 960 DO ji = 1, jpi 961 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 962 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 963 END DO 964 END DO 919 DO_2D_11_11 920 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 921 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 922 END_2D 965 923 zresm = MAXVAL( zres ) 966 924 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90
r13466 r13469 287 287 ! select ice covered grid points 288 288 npti = 0 ; nptidx(:) = 0 289 DO jj = 1, jpj 290 DO ji = 1, jpi 291 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 292 npti = npti + 1 293 nptidx(npti) = (jj - 1) * jpi + ji 294 ENDIF 295 END DO 296 END DO 289 DO_2D_11_11 290 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 291 npti = npti + 1 292 nptidx(npti) = (jj - 1) * jpi + ji 293 ENDIF 294 END_2D 297 295 298 296 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) … … 344 342 CALL ice_var_salprof ! for sz_i 345 343 DO jl = 1, jpl 346 DO jj = 1, jpj 347 DO ji = 1, jpi 348 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 349 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 350 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 351 END DO 352 END DO 344 DO_2D_11_11 345 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 346 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 347 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 348 END_2D 353 349 END DO 354 350 ! 355 351 DO jl = 1, jpl 356 DO jk = 1, nlay_s 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 360 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 361 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 362 END DO 363 END DO 364 END DO 352 DO_3D_11_11( 1, nlay_s ) 353 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 354 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 355 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 356 END_3D 365 357 END DO 366 358 ! 367 359 DO jl = 1, jpl 368 DO jk = 1, nlay_i 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 372 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 373 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 374 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 375 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 376 & - rcp * ( ztmelts - rt0 ) ) 377 END DO 378 END DO 379 END DO 360 DO_3D_11_11( 1, nlay_i ) 361 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 362 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 363 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 364 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 365 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 366 & - rcp * ( ztmelts - rt0 ) ) 367 END_3D 380 368 END DO 381 369 -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90
r13466 r13469 97 97 ! 98 98 npti = 0 ; nptidx(:) = 0 99 DO jj = 1, jpj 100 DO ji = 1, jpi 101 IF ( at_i(ji,jj) > epsi10 ) THEN 102 npti = npti + 1 103 nptidx( npti ) = (jj - 1) * jpi + ji 104 ENDIF 105 END DO 106 END DO 99 DO_2D_11_11 100 IF ( at_i(ji,jj) > epsi10 ) THEN 101 npti = npti + 1 102 nptidx( npti ) = (jj - 1) * jpi + ji 103 ENDIF 104 END_2D 107 105 108 106 !----------------------------------------------------------------------------------------------- … … 606 604 ! !--------------------------------------- 607 605 npti = 0 ; nptidx(:) = 0 608 DO jj = 1, jpj 609 DO ji = 1, jpi 610 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 611 npti = npti + 1 612 nptidx( npti ) = (jj - 1) * jpi + ji 613 ENDIF 614 END DO 615 END DO 606 DO_2D_11_11 607 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 608 npti = npti + 1 609 nptidx( npti ) = (jj - 1) * jpi + ji 610 ENDIF 611 END_2D 616 612 ! 617 613 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) … … 647 643 ! !----------------------------------------- 648 644 npti = 0 ; nptidx(:) = 0 649 DO jj = 1, jpj 650 DO ji = 1, jpi 651 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 652 npti = npti + 1 653 nptidx( npti ) = (jj - 1) * jpi + ji 654 ENDIF 655 END DO 656 END DO 645 DO_2D_11_11 646 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 647 npti = npti + 1 648 nptidx( npti ) = (jj - 1) * jpi + ji 649 ENDIF 650 END_2D 657 651 ! 658 652 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90
r13466 r13469 77 77 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 78 78 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 79 DO jj = 2, jpjm1 80 DO ji = 2, jpim1 81 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 82 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 83 END DO 84 END DO 79 DO_2D_00_00 80 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 81 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 82 END_2D 85 83 CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 86 84 ENDIF -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icestp.F90
r13467 r13469 209 209 ! --- Ocean time step --- ! 210 210 !-------------------------! 211 IF( ln_icedyn ) CALL ice_update_tau( kt, u b(:,:,1), vb(:,:,1) ) ! -- update surface ocean stresses211 IF( ln_icedyn ) CALL ice_update_tau( kt, uu(:,:,1,Nnn), vv(:,:,1,Nnn) ) ! -- update surface ocean stresses 212 212 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 213 213 ! -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90
r13466 r13469 120 120 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 121 121 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 122 DO jj = 2, jpjm1 123 DO ji = fs_2, fs_jpim1 124 zfric(ji,jj) = rn_cio * ( 0.5_wp * & 125 & ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 126 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 127 END DO 128 END DO 122 DO_2D_00_00 123 zfric(ji,jj) = rn_cio * ( 0.5_wp * & 124 & ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 125 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 126 END_2D 129 127 ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean 130 DO jj = 2, jpjm1 131 DO ji = fs_2, fs_jpim1 132 zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * & 133 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 134 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 135 END DO 136 END DO 128 DO_2D_00_00 129 zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * & 130 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 131 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 132 END_2D 137 133 ENDIF 138 134 CALL lbc_lnk( 'icethd', zfric, 'T', 1. ) … … 141 137 ! Partial computation of forcing for the thermodynamic sea ice model 142 138 !--------------------------------------------------------------------! 143 DO jj = 1, jpj 144 DO ji = 1, jpi 145 rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 146 ! 147 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 148 ! ! practically no "direct lateral ablation" 149 ! 150 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 151 ! ! temperature and turbulent mixing (McPhee, 1992) 152 ! 153 ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 154 zqld = tmask(ji,jj,1) * rdt_ice * & 155 & ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + & 156 & ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 157 158 ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 159 zqfr = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 160 zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0 161 162 ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 163 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 164 qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 165 166 qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 167 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 168 ! the freezing point, so that we do not have SST < T_freeze 169 ! This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 170 171 !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 172 qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 173 174 ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 175 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 176 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 177 IF( ln_leadhfx ) THEN ; fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 178 ELSE ; fhld(ji,jj) = 0._wp 179 ENDIF 180 qlead(ji,jj) = 0._wp 181 ELSE 182 fhld (ji,jj) = 0._wp 139 DO_2D_11_11 140 rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 141 ! 142 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 143 ! ! practically no "direct lateral ablation" 144 ! 145 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 146 ! ! temperature and turbulent mixing (McPhee, 1992) 147 ! 148 ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 149 zqld = tmask(ji,jj,1) * rdt_ice * & 150 & ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + & 151 & ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 152 153 ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 154 zqfr = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 155 zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0 156 157 ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 158 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 159 qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 160 161 qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 162 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 163 ! the freezing point, so that we do not have SST < T_freeze 164 ! This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 165 166 !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 167 qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 168 169 ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 170 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 171 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 172 IF( ln_leadhfx ) THEN ; fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 173 ELSE ; fhld(ji,jj) = 0._wp 183 174 ENDIF 184 ! 185 ! Net heat flux on top of the ice-ocean [W.m-2] 186 ! --------------------------------------------- 187 qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 188 END DO 189 END DO 175 qlead(ji,jj) = 0._wp 176 ELSE 177 fhld (ji,jj) = 0._wp 178 ENDIF 179 ! 180 ! Net heat flux on top of the ice-ocean [W.m-2] 181 ! --------------------------------------------- 182 qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 183 END_2D 190 184 191 185 ! In case we bypass open-water ice formation … … 215 209 ! select ice covered grid points 216 210 npti = 0 ; nptidx(:) = 0 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 220 npti = npti + 1 221 nptidx(npti) = (jj - 1) * jpi + ji 222 ENDIF 223 END DO 224 END DO 211 DO_2D_11_11 212 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 213 npti = npti + 1 214 nptidx(npti) = (jj - 1) * jpi + ji 215 ENDIF 216 END_2D 225 217 226 218 IF( npti > 0 ) THEN ! If there is no ice, do nothing. -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90
r13466 r13469 114 114 ENDIF 115 115 116 DO jj = 1, jpj 117 DO ji = 1, jpi 118 119 ! Solar heat flux reaching the ocean = zqsr (W.m-2) 120 !--------------------------------------------------- 121 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 122 123 ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 124 !--------------------------------------------------- 125 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 126 qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 127 128 ! Add the residual from heat diffusion equation and sublimation (W.m-2) 129 !---------------------------------------------------------------------- 130 qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) + & 131 & ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 132 133 ! New qsr and qns used to compute the oceanic heat flux at the next time step 134 !---------------------------------------------------------------------------- 135 qsr(ji,jj) = zqsr 136 qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr 137 138 ! Mass flux at the atm. surface 139 !----------------------------------- 140 wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) 141 142 ! Mass flux at the ocean surface 143 !------------------------------------ 144 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 145 ! ------------------------------------------------------------------------------------- 146 ! The idea of this approach is that the system that we consider is the ICE-OCEAN system 147 ! Thus FW flux = External ( E-P+snow melt) 148 ! Salt flux = Exchanges in the ice-ocean system then converted into FW 149 ! Associated to Ice formation AND Ice melting 150 ! Even if i see Ice melting as a FW and SALT flux 151 ! 152 ! mass flux from ice/ocean 153 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 154 & + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 155 156 ! add the snow melt water to snow mass flux to the ocean 157 wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 158 159 ! mass flux at the ocean/ice interface 160 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) ! F/M mass flux save at least for biogeochemical model 161 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 162 163 164 ! Salt flux at the ocean surface 165 !------------------------------------------ 166 sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & 167 & + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 168 169 ! Mass of snow and ice per unit area 170 !---------------------------------------- 171 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step 172 ! ! new mass per unit area 173 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) 174 ! ! time evolution of snow+ice mass 175 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 176 177 END DO 178 END DO 116 DO_2D_11_11 117 118 ! Solar heat flux reaching the ocean = zqsr (W.m-2) 119 !--------------------------------------------------- 120 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 121 122 ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 123 !--------------------------------------------------- 124 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 125 qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 126 127 ! Add the residual from heat diffusion equation and sublimation (W.m-2) 128 !---------------------------------------------------------------------- 129 qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) + & 130 & ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 131 132 ! New qsr and qns used to compute the oceanic heat flux at the next time step 133 !---------------------------------------------------------------------------- 134 qsr(ji,jj) = zqsr 135 qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr 136 137 ! Mass flux at the atm. surface 138 !----------------------------------- 139 wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) 140 141 ! Mass flux at the ocean surface 142 !------------------------------------ 143 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 144 ! ------------------------------------------------------------------------------------- 145 ! The idea of this approach is that the system that we consider is the ICE-OCEAN system 146 ! Thus FW flux = External ( E-P+snow melt) 147 ! Salt flux = Exchanges in the ice-ocean system then converted into FW 148 ! Associated to Ice formation AND Ice melting 149 ! Even if i see Ice melting as a FW and SALT flux 150 ! 151 ! mass flux from ice/ocean 152 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 153 & + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 154 155 ! add the snow melt water to snow mass flux to the ocean 156 wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 157 158 ! mass flux at the ocean/ice interface 159 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) ! F/M mass flux save at least for biogeochemical model 160 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 161 162 163 ! Salt flux at the ocean surface 164 !------------------------------------------ 165 sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & 166 & + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 167 168 ! Mass of snow and ice per unit area 169 !---------------------------------------- 170 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step 171 ! ! new mass per unit area 172 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) 173 ! ! time evolution of snow+ice mass 174 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 175 176 END_2D 179 177 180 178 ! Storing the transmitted variables … … 335 333 ! 336 334 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 337 DO jj = 2, jpjm1 !* update the modulus of stress at ocean surface (T-point) 338 DO ji = fs_2, fs_jpim1 339 ! ! 2*(U_ice-U_oce) at T-point 340 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) 341 zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 342 ! ! |U_ice-U_oce|^2 343 zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) 344 ! ! update the ocean stress modulus 345 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 346 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 347 END DO 348 END DO 335 DO_2D_00_00 336 ! ! 2*(U_ice-U_oce) at T-point 337 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) 338 zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 339 ! ! |U_ice-U_oce|^2 340 zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) 341 ! ! update the ocean stress modulus 342 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 343 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 344 END_2D 349 345 CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. ) 350 346 ! … … 363 359 ENDIF 364 360 ! 365 DO jj = 2, jpjm1 !* update the stress WITHOUT an ice-ocean rotation angle 366 DO ji = fs_2, fs_jpim1 ! Vect. Opt. 367 ! ice area at u and v-points 368 zat_u = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj ) * tmask(ji+1,jj ,1) ) & 369 & / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj ,1) ) 370 zat_v = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji ,jj+1 ) * tmask(ji ,jj+1,1) ) & 371 & / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji ,jj+1,1) ) 372 ! ! linearized quadratic drag formulation 373 zutau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) ) 374 zvtau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) ) 375 ! ! stresses at the ocean surface 376 utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice 377 vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 378 END DO 379 END DO 361 DO_2D_00_00 362 ! ice area at u and v-points 363 zat_u = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj ) * tmask(ji+1,jj ,1) ) & 364 & / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj ,1) ) 365 zat_v = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji ,jj+1 ) * tmask(ji ,jj+1,1) ) & 366 & / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji ,jj+1,1) ) 367 ! ! linearized quadratic drag formulation 368 zutau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) ) 369 zvtau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) ) 370 ! ! stresses at the ocean surface 371 utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice 372 vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 373 END_2D 380 374 CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. ) ! lateral boundary condition 381 375 ! -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90
r13466 r13469 263 263 zlay_i = REAL( nlay_i , wp ) ! number of layers 264 264 DO jl = 1, jpl 265 DO jk = 1, nlay_i 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area 269 ! 270 ze_i = e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i ! Energy of melting e(S,T) [J.m-3] 271 ztmelts = - sz_i(ji,jj,jk,jl) * rTmlt ! Ice layer melt temperature [C] 272 ! Conversion q(S,T) -> T (second order equation) 273 zbbb = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 274 zccc = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 275 t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0 ! [K] with bounds: -100 < t_i < ztmelts 276 ! 277 ELSE !--- no ice 278 t_i(ji,jj,jk,jl) = rt0 279 ENDIF 280 END DO 281 END DO 282 END DO 265 DO_3D_11_11( 1, nlay_i ) 266 IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area 267 ! 268 ze_i = e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i ! Energy of melting e(S,T) [J.m-3] 269 ztmelts = - sz_i(ji,jj,jk,jl) * rTmlt ! Ice layer melt temperature [C] 270 ! Conversion q(S,T) -> T (second order equation) 271 zbbb = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 272 zccc = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 273 t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0 ! [K] with bounds: -100 < t_i < ztmelts 274 ! 275 ELSE !--- no ice 276 t_i(ji,jj,jk,jl) = rt0 277 ENDIF 278 END_3D 283 279 END DO 284 280 … … 372 368 z1_dS = 1._wp / ( zsi1 - zsi0 ) 373 369 DO jl = 1, jpl 374 DO jj = 1, jpj 375 DO ji = 1, jpi 376 zalpha(ji,jj,jl) = MAX( 0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp ) ) 377 ! ! force a constant profile when SSS too low (Baltic Sea) 378 IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) ) zalpha(ji,jj,jl) = 0._wp 379 END DO 380 END DO 370 DO_2D_11_11 371 zalpha(ji,jj,jl) = MAX( 0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp ) ) 372 ! ! force a constant profile when SSS too low (Baltic Sea) 373 IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) ) zalpha(ji,jj,jl) = 0._wp 374 END_2D 381 375 END DO 382 376 ! 383 377 ! Computation of the profile 384 378 DO jl = 1, jpl 385 DO jk = 1, nlay_i 386 DO jj = 1, jpj 387 DO ji = 1, jpi 388 ! ! linear profile with 0 surface value 389 zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 390 zs = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl) ! weighting the profile 391 sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 392 END DO 393 END DO 394 END DO 379 DO_3D_11_11( 1, nlay_i ) 380 ! ! linear profile with 0 surface value 381 zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 382 zs = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl) ! weighting the profile 383 sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 384 END_3D 395 385 END DO 396 386 ! … … 517 507 ! Zap ice energy and use ocean heat to melt ice 518 508 !----------------------------------------------------------------- 519 DO jk = 1, nlay_i 520 DO jj = 1 , jpj 521 DO ji = 1 , jpi 522 ! update exchanges with ocean 523 hfx_res(ji,jj) = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 524 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 525 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 526 END DO 527 END DO 528 END DO 529 ! 530 DO jk = 1, nlay_s 531 DO jj = 1 , jpj 532 DO ji = 1 , jpi 533 ! update exchanges with ocean 534 hfx_res(ji,jj) = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 535 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 536 t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 537 END DO 538 END DO 539 END DO 509 DO_3D_11_11( 1, nlay_i ) 510 ! update exchanges with ocean 511 hfx_res(ji,jj) = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 512 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 513 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 514 END_3D 515 ! 516 DO_3D_11_11( 1, nlay_s ) 517 ! update exchanges with ocean 518 hfx_res(ji,jj) = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 519 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 520 t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 521 END_3D 540 522 ! 541 523 !----------------------------------------------------------------- 542 524 ! zap ice and snow volume, add water and salt to ocean 543 525 !----------------------------------------------------------------- 544 DO jj = 1 , jpj 545 DO ji = 1 , jpi 546 ! update exchanges with ocean 547 sfx_res(ji,jj) = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_rdtice 548 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_rdtice 549 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_rdtice 550 ! 551 a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 552 v_i (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) 553 v_s (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj) 554 t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) ) 555 oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj) 556 sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj) 557 ! 558 h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj) 559 h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj) 560 ! 561 a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 562 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 563 v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 564 ! 565 END DO 566 END DO 526 DO_2D_11_11 527 ! update exchanges with ocean 528 sfx_res(ji,jj) = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_rdtice 529 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_rdtice 530 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_rdtice 531 ! 532 a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 533 v_i (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) 534 v_s (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj) 535 t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) ) 536 oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj) 537 sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj) 538 ! 539 h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj) 540 h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj) 541 ! 542 a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 543 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 544 v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 545 ! 546 END_2D 567 547 ! 568 548 END DO … … 617 597 ! zap ice energy and send it to the ocean 618 598 !---------------------------------------- 619 DO jk = 1, nlay_i 620 DO jj = 1 , jpj 621 DO ji = 1 , jpi 622 IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 623 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 624 pe_i(ji,jj,jk,jl) = 0._wp 625 ENDIF 626 END DO 627 END DO 628 END DO 629 ! 630 DO jk = 1, nlay_s 631 DO jj = 1 , jpj 632 DO ji = 1 , jpi 633 IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 634 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 635 pe_s(ji,jj,jk,jl) = 0._wp 636 ENDIF 637 END DO 638 END DO 639 END DO 599 DO_3D_11_11( 1, nlay_i ) 600 IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 601 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 602 pe_i(ji,jj,jk,jl) = 0._wp 603 ENDIF 604 END_3D 605 ! 606 DO_3D_11_11( 1, nlay_s ) 607 IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 608 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 609 pe_s(ji,jj,jk,jl) = 0._wp 610 ENDIF 611 END_3D 640 612 ! 641 613 !----------------------------------------------------- 642 614 ! zap ice and snow volume, add water and salt to ocean 643 615 !----------------------------------------------------- 644 DO jj = 1 , jpj 645 DO ji = 1 , jpi 646 IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 647 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 648 pv_i (ji,jj,jl) = 0._wp 649 ENDIF 650 IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 651 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 652 pv_s (ji,jj,jl) = 0._wp 653 ENDIF 654 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 655 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 656 psv_i (ji,jj,jl) = 0._wp 657 ENDIF 658 END DO 659 END DO 616 DO_2D_11_11 617 IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 618 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 619 pv_i (ji,jj,jl) = 0._wp 620 ENDIF 621 IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 622 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 623 pv_s (ji,jj,jl) = 0._wp 624 ENDIF 625 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 626 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 627 psv_i (ji,jj,jl) = 0._wp 628 ENDIF 629 END_2D 660 630 ! 661 631 END DO -
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icewri.F90
r13466 r13469 69 69 70 70 ! tresholds for outputs 71 DO jj = 1, jpj 72 DO ji = 1, jpi 73 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 74 zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less 75 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 76 zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06 ) ) ! 1 if snow , 0 if no snow 77 END DO 78 END DO 71 DO_2D_11_11 72 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 73 zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less 74 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 75 zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06 ) ) ! 1 if snow , 0 if no snow 76 END_2D 79 77 DO jl = 1, jpl 80 DO jj = 1, jpj 81 DO ji = 1, jpi 82 zmsk00l(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 83 zmsksnl(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) 84 END DO 85 END DO 78 DO_2D_11_11 79 zmsk00l(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 80 zmsksnl(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) 81 END_2D 86 82 END DO 87 83 … … 134 130 ! 135 131 IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity 136 DO jj = 2 , jpjm1 137 DO ji = 2 , jpim1 138 z2da = u_ice(ji,jj) + u_ice(ji-1,jj) 139 z2db = v_ice(ji,jj) + v_ice(ji,jj-1) 140 z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 141 END DO 142 END DO 132 DO_2D_00_00 133 z2da = u_ice(ji,jj) + u_ice(ji-1,jj) 134 z2db = v_ice(ji,jj) + v_ice(ji,jj-1) 135 z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 136 END_2D 143 137 CALL lbc_lnk( 'icewri', z2d, 'T', 1. ) 144 138 CALL iom_put( 'icevel', z2d )
Note: See TracChangeset
for help on using the changeset viewer.
