- Timestamp:
- 2017-09-01T15:49:35+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceadv.F90
r8426 r8486 10 10 #if defined key_lim3 11 11 !!---------------------------------------------------------------------- 12 !! 'key_lim3' LIM3 sea-ice model13 !!---------------------------------------------------------------------- 14 !! ice_adv : advection/diffusion process of sea ice12 !! 'key_lim3' LIM3 sea-ice model 13 !!---------------------------------------------------------------------- 14 !! ice_adv : advection/diffusion process of sea ice 15 15 !!---------------------------------------------------------------------- 16 16 USE phycst ! physical constant 17 17 USE dom_oce ! ocean domain 18 USE sbc_oce , ONLY : nn_fsbc 19 USE ice ! ice variables 20 USE icevar ! 21 USE iceadv_prather ! advection scheme (Prather) 22 USE iceadv_umx ! advection scheme (ultimate-macho) 18 USE sbc_oce , ONLY : nn_fsbc ! frequency of sea-ice call 19 USE ice ! sea-ice: variables 20 USE icevar ! sea-ice: operations 21 USE iceadv_prather ! sea-ice: advection scheme (Prather) 22 USE iceadv_umx ! sea-ice: advection scheme (ultimate-macho) 23 USE icectl ! sea-ice: control prints 23 24 ! 24 25 USE in_out_manager ! I/O manager 25 26 USE lbclnk ! lateral boundary conditions -- MPP exchanges 26 27 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays28 28 USE prtctl ! Print control 29 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 30 USE timing ! Timing 31 USE icectl ! control prints32 31 33 32 IMPLICIT NONE … … 36 35 PUBLIC ice_adv ! called by icestp 37 36 38 INTEGER :: ncfl! number of ice time step with CFL>1/237 INTEGER :: ncfl ! number of ice time step with CFL>1/2 39 38 40 39 !! * Substitution 41 40 # include "vectopt_loop_substitute.h90" 42 41 !!---------------------------------------------------------------------- 43 !! NEMO/ LIM3 4.0 , UCL - NEMO Consortium (2011)42 !! NEMO/ICE 4.0 , NEMO Consortium (2017) 44 43 !! $Id: iceadv.F90 8373 2017-07-25 17:44:54Z clem $ 45 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 48 47 49 48 SUBROUTINE ice_adv( kt ) 50 !!------------------------------------------------------------------- 49 !!---------------------------------------------------------------------- 51 50 !! *** ROUTINE ice_adv *** 52 51 !! … … 60 59 !! 61 60 !! ** action : 62 !!--------------------------------------------------------------------- 61 !!---------------------------------------------------------------------- 63 62 INTEGER, INTENT(in) :: kt ! number of iteration 64 63 ! … … 73 72 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhimax, zviold, zvsold 74 73 ! --- ultimate macho only --- ! 75 REAL(wp) 76 REAL(wp), POINTER, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box74 REAL(wp) :: zdt 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box 77 76 ! --- prather only --- ! 78 REAL(wp), POINTER, DIMENSION(:,:):: zarea79 REAL(wp), POINTER, DIMENSION(:,:,:):: z0opw80 REAL(wp), POINTER, DIMENSION(:,:,:):: z0ice, z0snw, z0ai, z0es , z0smi , z0oi77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0opw 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi 81 80 ! MV MP 2016 82 REAL(wp), POINTER, DIMENSION(:,:,:):: z0ap , z0vp81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0ap , z0vp 83 82 REAL(wp) :: za_old 84 83 ! END MV MP 2016 85 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei 86 !! 84 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z0ei 87 85 !!--------------------------------------------------------------------- 88 86 IF( nn_timing == 1 ) CALL timing_start('iceadv') … … 90 88 IF( kt == nit000 .AND. lwp ) THEN 91 89 WRITE(numout,*)'' 92 WRITE(numout,*)'iceadv '93 WRITE(numout,*)'~~~~~~ '90 WRITE(numout,*)'iceadv : sea-ice advection' 91 WRITE(numout,*)'~~~~~~~' 94 92 ncfl = 0 ! nb of time step with CFL > 1/2 95 93 ENDIF … … 127 125 DO jj = 2, jpjm1 128 126 DO ji = 2, jpim1 127 !!gm use of MAXVAL here is very probably less efficient than expending the 9 values 129 128 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 130 129 END DO … … 156 155 !=============================! 157 156 158 CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box)157 ALLOCATE( zudy(jpi,jpj) , zvdx(jpi,jpj) , zcu_box(jpi,jpj) , zcv_box(jpi,jpj) ) 159 158 160 159 IF( kt == nit000 .AND. lwp ) THEN … … 212 211 END DO 213 212 ! 214 CALL wrk_dealloc( jpi,jpj,zudy, zvdx, zcu_box, zcv_box )213 DEALLOCATE( zudy, zvdx, zcu_box, zcv_box ) 215 214 216 215 !=============================! … … 218 217 !=============================! 219 218 220 CALL wrk_alloc( jpi,jpj, zarea ) 221 CALL wrk_alloc( jpi,jpj,1, z0opw ) 222 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 223 CALL wrk_alloc( jpi,jpj,jpl, z0ap , z0vp ) 224 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 219 ALLOCATE( zarea(jpi,jpj) , z0opw(jpi,jpj, 1 ) , & 220 & z0ice(jpi,jpj,jpl) , z0snw(jpi,jpj,jpl) , z0ai(jpi,jpj,jpl) , z0es(jpi,jpj,jpl) , & 221 & z0smi(jpi,jpj,jpl) , z0oi (jpi,jpj,jpl) , z0ap(jpi,jpj,jpl) , z0vp(jpi,jpj,jpl) , & 222 & z0ei (jpi,jpj,nlay_i,jpl) ) 225 223 226 224 IF( kt == nit000 .AND. lwp ) THEN … … 237 235 z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:) ! Open water area 238 236 DO jl = 1, jpl 239 z0snw (:,:,jl)= v_s (:,:, jl) * e1e2t(:,:) ! Snow volume240 z0ice(:,:,jl) 241 z0ai (:,:,jl)= a_i (:,:, jl) * e1e2t(:,:) ! Ice area242 z0smi (:,:,jl)= smv_i(:,:, jl) * e1e2t(:,:) ! Salt content243 z0oi (:,:,jl) 244 z0es (:,:,jl) 237 z0snw(:,:,jl) = v_s (:,:, jl) * e1e2t(:,:) ! Snow volume 238 z0ice(:,:,jl) = v_i (:,:, jl) * e1e2t(:,:) ! Ice volume 239 z0ai (:,:,jl) = a_i (:,:, jl) * e1e2t(:,:) ! Ice area 240 z0smi(:,:,jl) = smv_i(:,:, jl) * e1e2t(:,:) ! Salt content 241 z0oi (:,:,jl) = oa_i (:,:, jl) * e1e2t(:,:) ! Age content 242 z0es (:,:,jl) = e_s (:,:,1,jl) * e1e2t(:,:) ! Snow heat content 245 243 DO jk = 1, nlay_i 246 z0ei (:,:,jk,jl) = e_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content244 z0ei(:,:,jk,jl) = e_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 247 245 END DO 248 246 ! MV MP 2016 249 247 IF ( nn_pnd_scheme > 0 ) THEN 250 z0ap (:,:,jl) = a_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction251 z0vp (:,:,jl) = v_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume248 z0ap(:,:,jl) = a_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 249 z0vp(:,:,jl) = v_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 252 250 ENDIF 253 251 ! END MV MP 2016 254 255 END DO 256 252 END DO 257 253 258 254 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! … … 383 379 ! END MV MP 2016 384 380 END DO 385 381 ! 386 382 at_i(:,:) = a_i(:,:,1) ! total ice fraction 387 383 DO jl = 2, jpl 388 384 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 389 385 END DO 390 391 CALL wrk_dealloc( jpi,jpj, zarea ) 392 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 393 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 394 ! MV MP 2016 395 CALL wrk_dealloc( jpi,jpj,jpl, z0ap , z0vp ) 396 ! END MV MP 2016 397 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 398 386 ! 387 DEALLOCATE( zarea , z0opw , z0ice, z0snw , z0ai , z0es , z0smi , z0oi , z0ap , z0vp , z0ei ) 388 ! 399 389 END SELECT 400 390 … … 411 401 412 402 IF( nn_limdyn == 2) THEN 413 414 ! zap small areas 415 CALL ice_var_zapsmall 416 417 !--- Thickness correction in case too high --- ! 418 DO jl = 1, jpl 403 ! 404 CALL ice_var_zapsmall !--- zap small areas ---! 405 ! 406 DO jl = 1, jpl !--- Thickness correction in case too high --- ! 419 407 DO jj = 1, jpj 420 408 DO ji = 1, jpi 421 409 ! 422 410 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 423 411 ! 424 412 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 425 413 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 426 414 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 427 415 ! 428 416 zdv = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl) 429 417 ! 430 418 IF ( ( zdv > 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 431 419 & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 432 420 ! 433 421 rswitch = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 434 422 a_i(ji,jj,jl) = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 ) 435 423 ! 436 424 ! small correction due to *rswitch for a_i 437 425 v_i (ji,jj,jl) = rswitch * v_i (ji,jj,jl) … … 447 435 ENDIF 448 436 ! END MV MP 2016 449 437 ! 450 438 ENDIF 451 439 ! 452 440 ENDIF 453 441 ! 454 442 END DO 455 443 END DO 456 444 END DO 457 ! ------------------------------------------------- 458 459 ! Force the upper limit of ht_i to always be < hi_max (99 m). 460 DO jj = 1, jpj 445 446 DO jj = 1, jpj !--- bound ht_i to hi_max (99 m). 461 447 DO ji = 1, jpi 462 448 ! MV MP 2016 … … 474 460 END DO 475 461 END DO 476 477 462 ! 478 463 ENDIF 479 464 … … 482 467 !------------------------------------------------------------ 483 468 ! 484 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 485 IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 469 !!gm remplace the test by, l_piling a logical compute one for all in icestp.F90 (and its declaration in ice.F90 470 !!gm IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 471 IF( l_piling ) THEN 472 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 486 473 DO jl = 1, jpl 487 474 DO jj = 1, jpj 488 475 DO ji = 1, jpi 489 rswitch = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) ) 490 zda = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp ) & 491 & * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 ) 476 rswitch = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) ) 477 zda = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 ) 492 478 a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda 493 479 END DO 494 480 END DO 495 481 END DO 482 !!gm better and faster coding? 483 ! DO jl = 1, jpl 484 ! WHERE( at_i(:,:) > epsi20 ) 485 ! a_i(:,:,jl) = a_i(:,:,jl) * ( 1._wp + MIN( rn_amax_2d(:,:) - at_i(:,:) , 0._wp ) / at_i(:,:) ) 486 ! END WHERE 487 ! END DO 488 !!gm end 496 489 ENDIF 497 490 … … 527 520 !! Default option Empty Module No sea-ice model 528 521 !!---------------------------------------------------------------------- 529 CONTAINS530 SUBROUTINE ice_adv ! Empty routine531 END SUBROUTINE ice_adv532 522 #endif 523 533 524 !!====================================================================== 534 525 END MODULE iceadv
Note: See TracChangeset
for help on using the changeset viewer.
