Changeset 8233 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO
- Timestamp:
- 2017-06-28T14:33:07+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO
- Files:
-
- 15 edited
- 1 copied
-
LIM_SRC_3/ice.F90 (modified) (7 diffs)
-
LIM_SRC_3/limistate.F90 (modified) (5 diffs)
-
LIM_SRC_3/limitd_me.F90 (modified) (12 diffs)
-
LIM_SRC_3/limitd_th.F90 (modified) (3 diffs)
-
LIM_SRC_3/limmp.F90 (copied) (copied from branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90)
-
LIM_SRC_3/limrst.F90 (modified) (4 diffs)
-
LIM_SRC_3/limsbc.F90 (modified) (3 diffs)
-
LIM_SRC_3/limthd.F90 (modified) (2 diffs)
-
LIM_SRC_3/limthd_dh.F90 (modified) (4 diffs)
-
LIM_SRC_3/limtrp.F90 (modified) (14 diffs)
-
LIM_SRC_3/limvar.F90 (modified) (5 diffs)
-
LIM_SRC_3/limwri.F90 (modified) (6 diffs)
-
LIM_SRC_3/thd_ice.F90 (modified) (2 diffs)
-
OPA_SRC/DOM/phycst.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/albedo.F90 (modified) (13 diffs)
-
OPA_SRC/SBC/sbcice_lim.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r7813 r8233 273 273 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value) 274 274 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging 275 REAL(wp), PUBLIC :: rn_fpondrdg !: fractional melt pond loss to the ocean during ridging 275 276 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not 276 277 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging 277 278 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting 278 279 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging 280 REAL(wp), PUBLIC :: rn_fpondrft !: fractional snow loss to the ocean during rafting 281 282 ! MV MP 2016 283 ! !!** melt pond namelist (namicemp) 284 LOGICAL , PUBLIC :: ln_pnd !: activate ponds or not 285 LOGICAL , PUBLIC :: ln_pnd_rad !: ponds radiatively active or not 286 LOGICAL , PUBLIC :: ln_pnd_fw !: ponds active wrt meltwater or not 287 INTEGER , PUBLIC :: nn_pnd_scheme !: type of melt pond scheme: =0 prescribed, =1 empirical, =2 topographic 288 REAL(wp), PUBLIC :: rn_apnd !: prescribed pond fraction (0<rn_apnd<1), only if nn_pnd_scheme = 0 289 REAL(wp), PUBLIC :: rn_hpnd !: prescribed pond depth (0<rn_hpnd<1), only if nn_pnd_scheme = 0 290 ! END MV MP 2016 279 291 280 292 ! !!** some other parameters … … 311 323 312 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 325 ! MV MP 2016 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sum !: surface melt component of wfx_snw [kg.m-2.s-1] 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_pnd !: melt pond-ocean mass exchange [kg.m-2.s-1] 328 ! END MV MP 2016 313 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 314 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] … … 405 421 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU] 406 422 423 ! MV MP 2016 424 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond fraction per grid cell area 425 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 426 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond volume per ice area 427 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond thickness [m] 428 429 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond fraction 430 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per unit area [m] 431 ! END MV MP 2016 432 407 433 !!-------------------------------------------------------------------------- 408 434 !! * Moments for advection … … 416 442 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage !: ice age 417 443 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye !: ice layers heat content 444 ! MV MP 2016 445 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxap , syap , sxxap , syyap , sxyap !: melt pond fraction 446 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvp , syvp , sxxvp , syyvp , sxyvp !: melt pond volume 447 ! END MV MP 2016 418 448 419 449 !!-------------------------------------------------------------------------- … … 479 509 ALLOCATE( t_bo (jpi,jpj) , frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 480 510 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) , & 511 ! MV MP 2016 512 & wfx_pnd(jpi,jpj) , wfx_snw_sum(jpi,jpj) , & 513 ! END MV MP 2016 481 514 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 482 515 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & … … 509 542 ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 510 543 544 ! MV MP 2016 545 ii = ii + 1 546 ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , & 547 & h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 548 ii = ii + 1 549 ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 550 ! END MV MP 2016 551 511 552 ! * Moments for advection 512 553 ii = ii + 1 … … 526 567 & syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 527 568 569 ! MV MP 2016 570 ALLOCATE( sxap(jpi,jpj,jpl) , syap(jpi,jpj,jpl) , sxxap(jpi,jpj,jpl) , syyap(jpi,jpj,jpl) , sxyap(jpi,jpj,jpl) , & 571 & sxvp(jpi,jpj,jpl) , syvp(jpi,jpj,jpl) , sxxvp(jpi,jpj,jpl) , syyvp(jpi,jpj,jpl) , sxyvp(jpi,jpj,jpl) , & 572 & STAT = ierr(ii) ) 573 ! END MV MP 2016 574 528 575 ! * Old values of global variables 529 576 ii = ii + 1 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7761 r8233 78 78 !! 4.0 ! 09-11 (M. Vancoppenolle) Enhanced version for ice cats 79 79 !!-------------------------------------------------------------------- 80 INTEGER :: ji, jj, jk, jl ! dummy loop indices 81 REAL(wp) :: ztmelts, zdh 82 INTEGER :: i_hemis, i_fill, jl0 83 REAL(wp) :: zarg, zV, zconv, zdv 80 !! * Local variables 81 INTEGER :: ji, jj, jk, jl ! dummy loop indices 82 REAL(wp) :: ztmelts, zdh 83 INTEGER :: i_hemis, i_fill, jl0 84 REAL(wp) :: zarg, zV, zconv, zdv 84 85 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 85 86 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file … … 372 373 tn_ice (:,:,:) = t_su (:,:,:) 373 374 375 ! MV MP 2016 376 ! Melt pond volume and fraction 377 IF ( ln_pnd ) THEN 378 379 DO jl = 1, jpl 380 381 a_ip_frac(:,:,jl) = 0.2 * zswitch(:,:) 382 h_ip (:,:,jl) = 0.05 * zswitch(:,:) 383 a_ip(:,:,jl) = a_ip_frac(:,:,jl) * a_i (:,:,jl) 384 v_ip(:,:,jl) = h_ip (:,:,jl) * a_ip(:,:,jl) 385 386 END DO 387 388 ELSE 389 390 a_ip(:,:,:) = 0._wp 391 v_ip(:,:,:) = 0._wp 392 a_ip_frac(:,:,:) = 0._wp 393 h_ip (:,:,:) = 0._wp 394 395 ENDIF 396 ! END MV MP 2016 397 374 398 ELSE ! if ln_limini=false 375 399 a_i (:,:,:) = 0._wp … … 395 419 END DO 396 420 421 a_ip(:,:,:) = 0._wp 422 v_ip(:,:,:) = 0._wp 423 a_ip_frac(:,:,:) = 0._wp 424 h_ip (:,:,:) = 0._wp 425 397 426 ENDIF ! ln_limini 398 427 … … 401 430 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 402 431 END DO 403 ! 432 404 433 !-------------------------------------------------------------------- 405 434 ! 4) Global ice variables for output diagnostics | … … 458 487 u_ice_b(:,:) = u_ice(:,:) 459 488 v_ice_b(:,:) = v_ice(:,:) 489 490 ! MV MP 2016 491 IF ( nn_pnd_scheme > 0 ) THEN 492 sxap (:,:,:) = 0._wp ; sxvp (:,:,:) = 0._wp 493 syap (:,:,:) = 0._wp ; syvp (:,:,:) = 0._wp 494 sxxap (:,:,:) = 0._wp ; sxxvp (:,:,:) = 0._wp 495 syyap (:,:,:) = 0._wp ; syyvp (:,:,:) = 0._wp 496 sxyap (:,:,:) = 0._wp ; sxyvp (:,:,:) = 0._wp 497 ENDIF 498 ! END MV MP 2016 460 499 461 500 !!!clem -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r7753 r8233 507 507 REAL(wp), POINTER, DIMENSION(:) :: ardg1 , ardg2 ! area of ice ridged & new ridges 508 508 REAL(wp), POINTER, DIMENSION(:) :: vsrdg , esrdg ! snow volume & energy of ridging ice 509 ! MV MP 2016 510 REAL(wp), POINTER, DIMENSION(:) :: vprdg ! pond volume of ridging ice 511 REAL(wp), POINTER, DIMENSION(:) :: aprdg1 ! pond area of ridging ice 512 REAL(wp), POINTER, DIMENSION(:) :: aprdg2 ! pond area of ridging ice 513 ! END MV MP 2016 509 514 REAL(wp), POINTER, DIMENSION(:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 510 515 … … 520 525 REAL(wp), POINTER, DIMENSION(:) :: arft1 , arft2 ! area of ice rafted and new rafted zone 521 526 REAL(wp), POINTER, DIMENSION(:) :: virft , vsrft ! ice & snow volume of rafting ice 527 ! MV MP 2016 528 REAL(wp), POINTER, DIMENSION(:) :: vprft ! pond volume of rafting ice 529 REAL(wp), POINTER, DIMENSION(:) :: aprft1 ! pond area of rafted ice 530 REAL(wp), POINTER, DIMENSION(:) :: aprft2 ! pond area of new rafted ice 531 ! END MV MP 2016 522 532 REAL(wp), POINTER, DIMENSION(:) :: esrft , smrft ! snow energy & salinity of rafting ice 523 533 REAL(wp), POINTER, DIMENSION(:) :: oirft1, oirft2 ! ice age of ice rafted … … 531 541 CALL wrk_alloc( jpij, indxi, indxj ) 532 542 CALL wrk_alloc( jpij, zswitch, fvol ) 533 CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 543 ! MV MP 2016 544 !CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 545 CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, vprdg, aprdg1, aprdg2, dhr, dhr2 ) 546 ! END MV MP 2016 534 547 CALL wrk_alloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 535 CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 548 ! MV MP 2016 549 !CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 550 CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, aprft1, aprft2) 551 CALL wrk_alloc ( jpij, vprft, smrft, oirft1, oirft2 ) 552 ! END MV MP 2016 536 553 CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 537 554 … … 586 603 587 604 !-------------------------------------------------------------------------- 588 ! 3.4) Sub tract area, volume, and energy from ridging605 ! 3.4) Substract area, volume, and energy from ridging 589 606 ! / rafting category n1. 590 607 !-------------------------------------------------------------------------- … … 595 612 vsrdg (ij) = v_s (ji,jj, jl1) * afrac(ij) 596 613 esrdg (ij) = e_s (ji,jj,1,jl1) * afrac(ij) 614 !MV MP 2016 615 IF ( nn_pnd_scheme > 0 ) THEN 616 aprdg1(ij) = a_ip(ji,jj, jl1) * afrac(ij) 617 aprdg2(ij) = a_ip(ji,jj, jl1) * afrac(ij) * krdg(ji,jj,jl1) 618 vprdg(ij) = v_ip(ji,jj, jl1) * afrac(ij) 619 ENDIF 620 ! END MV MP 2016 597 621 srdg1 (ij) = smv_i(ji,jj, jl1) * afrac(ij) 598 622 oirdg1(ij) = oa_i (ji,jj, jl1) * afrac(ij) … … 602 626 virft (ij) = v_i (ji,jj, jl1) * afrft(ij) 603 627 vsrft (ij) = v_s (ji,jj, jl1) * afrft(ij) 628 !MV MP 2016 629 IF ( nn_pnd_scheme > 0 ) THEN 630 aprft1(ij) = a_ip (ji,jj, jl1) * afrft(ij) 631 aprft2(ij) = a_ip (ji,jj, jl1) * afrft(ij) * kraft 632 vprft(ij) = v_ip(ji,jj,jl1) * afrft(ij) 633 ENDIF 634 ! END MV MP 2016 635 srdg1 (ij) = smv_i(ji,jj, jl1) * afrac(ij) 604 636 esrft (ij) = e_s (ji,jj,1,jl1) * afrft(ij) 605 637 smrft (ij) = smv_i(ji,jj, jl1) * afrft(ij) … … 637 669 & - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 638 670 671 ! MV MP 2016 672 !------------------------------------------ 673 ! 3.X Put the melt pond water in the ocean 674 !------------------------------------------ 675 ! Place part of the melt pond volume into the ocean. 676 IF ( ( nn_pnd_scheme > 0 ) .AND. ln_pnd_fw ) THEN 677 wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( rhofw * vprdg(ij) * ( 1._wp - rn_fpondrdg ) & 678 & + rhofw * vprft(ij) * ( 1._wp - rn_fpondrft ) ) * r1_rdtice ! fresh water source for ocean 679 ENDIF 680 ! END MV MP 2016 681 639 682 !----------------------------------------------------------------- 640 683 ! 3.8 Compute quantities used to apportion ice among categories … … 652 695 smv_i(ji,jj, jl1) = smv_i(ji,jj, jl1) - srdg1 (ij) - smrft (ij) 653 696 oa_i (ji,jj, jl1) = oa_i (ji,jj, jl1) - oirdg1(ij) - oirft1(ij) 697 698 ! MV MP 2016 699 IF ( nn_pnd_scheme > 0 ) THEN 700 v_ip (ji,jj,jl1) = v_ip (ji,jj,jl1) - vprdg (ij) - vprft (ij) 701 a_ip (ji,jj,jl1) = a_ip (ji,jj,jl1) - aprdg1(ij) - aprft1(ij) 702 ENDIF 703 ! END MV MP 2016 654 704 655 705 END DO … … 716 766 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnowrdg * fvol(ij) + & 717 767 & esrft (ij) * rn_fsnowrft * zswitch(ij) ) 768 ! MV MP 2016 769 IF ( nn_pnd_scheme > 0 ) THEN 770 v_ip (ji,jj,jl2) = v_ip (ji,jj,jl2) + ( vprdg (ij) * rn_fpondrdg * fvol(ij) + & 771 & vprft (ij) * rn_fpondrft * zswitch(ij) ) 772 a_ip (ji,jj,jl2) = a_ip(ji,jj,jl2) + ( aprdg2(ij) * rn_fpondrdg * farea + & 773 & aprft2(ij) * rn_fpondrft * zswitch(ji) ) 774 ENDIF 775 ! END MV MP 2016 718 776 719 777 END DO … … 734 792 CALL wrk_dealloc( jpij, indxi, indxj ) 735 793 CALL wrk_dealloc( jpij, zswitch, fvol ) 736 CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 794 ! MV MP 2016 795 !CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 796 CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, vprdg, aprdg1, aprdg2, dhr, dhr2 ) 797 ! END MV MP 2016 737 798 CALL wrk_dealloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 738 CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 799 ! MV MP 2016 800 !CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 801 CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, aprft1, aprft2, vprft ) 802 CALL wrk_dealloc( jpij, smrft, oirft1, oirft2 ) 739 803 CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 740 804 ! … … 915 979 INTEGER :: ios ! Local integer output status for namelist read 916 980 NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar, & 917 & ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft 981 & ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, rn_fpondrdg, & 982 ln_rafting, rn_hraft, rn_craft, rn_fsnowrft, rn_fpondrft 918 983 !!------------------------------------------------------------------- 919 984 ! … … 939 1004 WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 940 1005 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 1006 WRITE(numout,*)' Fraction of pond volume conserved during ridging rn_fpondrdg = ', rn_fpondrdg 941 1007 WRITE(numout,*)' Rafting of ice sheets or not ln_rafting = ', ln_rafting 942 1008 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 943 1009 WRITE(numout,*)' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 944 1010 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 1011 WRITE(numout,*)' Fraction of pond volume conserved during rafting rn_fpondrft = ', rn_fpondrft 945 1012 ENDIF 946 1013 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r7753 r8233 357 357 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN 358 358 a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 359 ! MV MP 2016 360 IF ( nn_pnd_scheme > 0 ) THEN 361 a_ip(ii,ij,1) = a_ip(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 362 ENDIF 363 ! END MV MP 2016 359 364 ht_i(ii,ij,1) = rn_himin 360 365 ENDIF … … 485 490 REAL(wp) :: zdo_aice ! ice age times volume transferred 486 491 REAL(wp) :: zdaTsf ! aicen*Tsfcn transferred 492 ! MV MP 2016 493 REAL(wp) :: zdapnd ! pond fraction transferred 494 REAL(wp) :: zdvpnd ! pond volume transferred 495 ! END MV MP 2016 487 496 488 497 INTEGER, POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions … … 576 585 zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf 577 586 zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf 587 588 ! MV MP 2016 589 IF ( nn_pnd_scheme > 0 ) THEN 590 !--------------------- 591 ! Pond fraction 592 !--------------------- 593 zdapnd = a_ip(ii,ij,jl1) * zdaice(ii,ij,jl) 594 a_ip(ii,ij,jl1) = a_ip(ii,ij,jl1) - zdapnd 595 a_ip(ii,ij,jl2) = a_ip(ii,ij,jl2) + zdapnd 596 597 !--------------------- 598 ! Pond volume 599 !--------------------- 600 zdvpnd = v_ip(ii,ij,jl1) * zdaice(ii,ij,jl) 601 v_ip(ii,ij,jl1) = v_ip(ii,ij,jl1) - zdvpnd 602 v_ip(ii,ij,jl2) = v_ip(ii,ij,jl2) + zdvpnd 603 604 ENDIF 605 ! END MV MP 2016 578 606 579 607 END DO -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r7813 r8233 147 147 z2d(:,:) = t_su(:,:,jl) 148 148 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 149 END DO 150 151 ! MV MP 2016 152 IF ( nn_pnd_scheme > 0 ) THEN 153 DO jl = 1, jpl 154 WRITE(zchar,'(I2.2)') jl 155 znam = 'a_ip'//'_htc'//zchar 156 z2d(:,:) = a_ip(:,:,jl) 157 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 158 znam = 'v_ip'//'_htc'//zchar 159 z2d(:,:) = v_ip(:,:,jl) 160 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 161 END DO 162 ENDIF 163 ! END MV MP 2016 164 165 DO jl = 1, jpl 166 WRITE(zchar,'(I2.2)') jl 149 167 znam = 'tempt_sl1'//'_htc'//zchar 150 168 z2d(:,:) = e_s(:,:,1,jl) … … 291 309 END DO 292 310 END DO 311 ! MV MP 2016 312 IF ( nn_pnd_scheme > 0 ) THEN 313 DO jl = 1, jpl 314 WRITE(zchar,'(I2.2)') jl 315 znam = 'sxap'//'_htc'//zchar 316 z2d(:,:) = sxap(:,:,jl) 317 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 318 znam = 'syap'//'_htc'//zchar 319 z2d(:,:) = syap(:,:,jl) 320 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 321 znam = 'sxxap'//'_htc'//zchar 322 z2d(:,:) = sxxap(:,:,jl) 323 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 324 znam = 'syyap'//'_htc'//zchar 325 z2d(:,:) = syyap(:,:,jl) 326 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 327 znam = 'sxyap'//'_htc'//zchar 328 z2d(:,:) = sxyap(:,:,jl) 329 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 330 331 znam = 'sxvp'//'_htc'//zchar 332 z2d(:,:) = sxvp(:,:,jl) 333 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 334 znam = 'syvp'//'_htc'//zchar 335 z2d(:,:) = syvp(:,:,jl) 336 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 337 znam = 'sxxvp'//'_htc'//zchar 338 z2d(:,:) = sxxvp(:,:,jl) 339 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 340 znam = 'syyvp'//'_htc'//zchar 341 z2d(:,:) = syyvp(:,:,jl) 342 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 343 znam = 'sxyvp'//'_htc'//zchar 344 z2d(:,:) = sxyvp(:,:,jl) 345 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 346 END DO 347 ENDIF 293 348 294 349 ENDIF … … 368 423 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 369 424 t_su(:,:,jl) = z2d(:,:) 425 END DO 426 427 ! MV MP 2016 428 IF ( nn_pnd_scheme > 0 ) THEN 429 DO jl = 1, jpl 430 WRITE(zchar,'(I2.2)') jl 431 znam = 'a_ip'//'_htc'//zchar 432 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 433 a_ip(:,:,jl) = z2d(:,:) 434 znam = 'v_ip'//'_htc'//zchar 435 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 436 v_ip(:,:,jl) = z2d(:,:) 437 END DO 438 ENDIF 439 ! END MV MP 2016 440 441 DO jl = 1, jpl 442 WRITE(zchar,'(I2.2)') jl 370 443 znam = 'tempt_sl1'//'_htc'//zchar 371 444 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 484 557 sxyage(:,:,jl)= z2d(:,:) 485 558 END DO 559 ! MV MP 2016 560 IF ( nn_pnd_scheme > 0 ) THEN 561 DO jl = 1, jpl 562 WRITE(zchar,'(I2.2)') jl 563 znam = 'sxap'//'_htc'//zchar 564 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 565 sxap(:,:,jl) = z2d(:,:) 566 znam = 'syap'//'_htc'//zchar 567 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 568 syap(:,:,jl) = z2d(:,:) 569 znam = 'sxxap'//'_htc'//zchar 570 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 571 sxxap(:,:,jl) = z2d(:,:) 572 znam = 'syyap'//'_htc'//zchar 573 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 574 syyap(:,:,jl) = z2d(:,:) 575 znam = 'sxyap'//'_htc'//zchar 576 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 577 sxyap(:,:,jl) = z2d(:,:) 578 579 znam = 'sxvp'//'_htc'//zchar 580 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 581 sxvp(:,:,jl) = z2d(:,:) 582 znam = 'syvp'//'_htc'//zchar 583 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 584 syvp(:,:,jl) = z2d(:,:) 585 znam = 'sxxvp'//'_htc'//zchar 586 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 587 sxxvp(:,:,jl) = z2d(:,:) 588 znam = 'syyvp'//'_htc'//zchar 589 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 590 syyvp(:,:,jl) = z2d(:,:) 591 znam = 'sxyvp'//'_htc'//zchar 592 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 593 sxyvp(:,:,jl) = z2d(:,:) 594 END DO 595 ENDIF 596 ! END MV MP 2016 486 597 487 598 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r7753 r8233 127 127 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 128 128 END WHERE 129 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output129 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 130 130 131 131 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b ) 132 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output132 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! surface albedo output 133 133 134 134 CALL wrk_dealloc( jpi,jpj, zalb ) … … 177 177 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 178 178 179 IF ( ln_pnd_fw ) & 180 wfx_ice(ji,jj) = wfx_ice(ji,jj) + wfx_pnd(ji,jj) 181 182 ! add the snow melt water to snow mass flux to the ocean 183 wfx_snw(:,:) = wfx_snw(:,:) + wfx_snw_sum(:,:) 184 179 185 ! mass flux at the ocean/ice interface 180 186 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 … … 211 217 !------------------------------------------------------------------------! 212 218 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 213 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 219 CALL albedo_ice( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 220 214 221 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 215 222 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r7813 r8233 468 468 ! 469 469 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 470 CALL tab_2d_1d( nbpb, wfx_snw_sum_1d(1:nbpb), wfx_snw_sum , jpi, jpj, npb(1:nbpb) ) 470 471 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 471 472 ! … … 519 520 ! 520 521 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 522 CALL tab_1d_2d( nbpb, wfx_snw_sum , npb, wfx_snw_sum_1d(1:nbpb),jpi, jpj ) 521 523 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 522 524 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r7646 r8233 169 169 hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 170 170 ! Contribution to mass flux 171 wfx_snw_ 1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice171 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 172 172 ! updates 173 173 ht_s_1d(ji) = 0._wp … … 233 233 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 234 234 ! snow melting only = water into the ocean (then without snow precip), >0 235 wfx_snw_ 1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice235 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 236 236 ! updates available heat + precipitations after melting 237 237 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) ) … … 255 255 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice 256 256 ! snow melting only = water into the ocean (then without snow precip) 257 wfx_snw_ 1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice257 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 258 258 ! updates available heat + thickness 259 259 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) … … 607 607 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0) 608 608 ! Contribution to mass flux 609 wfx_snw_ 1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice609 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 610 610 ! 611 611 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r7753 r8233 76 76 ! --- diffusion --- ! 77 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 78 INTEGER , PARAMETER :: ihdf_vars = 6 ! Number of variables in which we apply horizontal diffusion 78 ! MV MP 2016 79 ! With melt ponds, we have to diffuse them 80 ! We hard code the number of variables to diffuse 81 ! since we can't put an IF ( nn_pnd_scheme ) for a declaration 82 ! ideally, the ihdf_vars should probably be passed as an argument and 83 ! defined somewhere depending on nn_pnd_scheme 84 ! END MV MP 2016 85 INTEGER , PARAMETER :: ihdf_vars = 8 ! Number of variables in which we apply horizontal diffusion 79 86 ! inside limtrp for each ice category , not counting the 80 87 ! variables corresponding to ice_layers … … 86 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw 87 94 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi 95 ! MV MP 2016 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ap , z0vp 97 REAL(wp) :: za_old 98 ! END MV MP 2016 88 99 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei 89 100 !! … … 205 216 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_s(:,:,jl) ) ! Snow volume 206 217 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) ) ! Snow heat content 218 ! MV MP 2016 219 IF ( nn_pnd_scheme > 0 ) THEN 220 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_ip(:,:,jl) ) ! Melt pond fraction 221 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_ip(:,:,jl) ) ! Melt pond volume 222 ENDIF 223 ! END MV MP 2016 207 224 END DO 208 225 END DO … … 222 239 CALL wrk_alloc( jpi,jpj,1, z0opw ) 223 240 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 241 CALL wrk_alloc( jpi,jpj,jpl, z0ap , z0vp ) 224 242 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 225 243 … … 246 264 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 247 265 END DO 266 ! MV MP 2016 267 IF ( nn_pnd_scheme > 0 ) THEN 268 z0ap (:,:,jl) = a_ip (:,:,jl) * e12t(:,:) ! Melt pond fraction 269 z0vp (:,:,jl) = v_ip (:,:,jl) * e12t(:,:) ! Melt pond volume 270 ENDIF 271 ! END MV MP 2016 272 248 273 END DO 249 274 … … 288 313 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 289 314 END DO 315 ! MV MP 2016 316 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & !--- melt pond fraction -- 317 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) ) 318 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & 319 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) ) 320 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & !--- melt pond volume -- 321 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) ) 322 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & 323 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) ) 324 ! END MV MP 2016 290 325 END DO 291 326 END DO … … 329 364 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 330 365 END DO 366 ! MV MP 2016 367 IF ( nn_pnd_scheme > 0 ) THEN 368 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & !--- melt pond fraction --- 369 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) ) 370 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & 371 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) ) 372 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & !--- melt pond volume --- 373 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) ) 374 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & 375 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) ) 376 ENDIF 377 ! END MV MP 2016 331 378 END DO 332 379 END DO … … 347 394 e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) 348 395 END DO 396 ! MV MP 2016 397 IF ( nn_pnd_scheme > 0 ) THEN 398 a_ip (:,:,jl) = z0ap (:,:,jl) * r1_e12t(:,:) 399 v_ip (:,:,jl) = z0vp (:,:,jl) * r1_e12t(:,:) 400 ENDIF 401 ! END MV MP 2016 349 402 END DO 350 403 … … 357 410 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 358 411 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 412 ! MV MP 2016 413 CALL wrk_dealloc( jpi,jpj,jpl, z0ap , z0vp ) 414 ! END MV MP 2016 359 415 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 360 416 … … 385 441 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 386 442 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 443 ! MV MP 2016 444 IF ( nn_pnd_scheme > 0 ) THEN 445 zhdfptab(:,:,jm)= a_ip (:,:, jl); jm = jm + 1 446 zhdfptab(:,:,jm)= v_ip (:,:, jl); jm = jm + 1 447 ENDIF 448 ! END MV MP 2016 387 449 ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 388 450 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 … … 418 480 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 419 481 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 482 ! MV MP 2016 483 IF ( nn_pnd_scheme > 0 ) THEN 484 a_ip (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 485 v_ip (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 486 ENDIF 420 487 ! Sample of adding more variables to apply lim_hdf 421 488 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 … … 470 537 e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl) 471 538 e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 539 540 ! MV MP 2016 541 IF ( nn_pnd_scheme > 0 ) THEN 542 a_ip (ji,jj,jl) = rswitch * a_ip (ji,jj,jl) 543 v_ip (ji,jj,jl) = rswitch * v_ip (ji,jj,jl) 544 ENDIF 545 ! END MV MP 2016 472 546 473 547 ENDIF … … 483 557 DO jj = 1, jpj 484 558 DO ji = 1, jpi 559 ! MV MP 2016 560 za_old = a_i(ji,jj,jpl) 561 ! END MV MP 2016 485 562 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 486 563 ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 487 564 a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 488 END DO 489 END DO 565 ! MV MP 2016 566 IF ( nn_pnd_scheme > 0 ) THEN 567 ! correct pond fraction to avoid a_ip > a_i 568 a_ip(ji,jj,jpl) = a_ip(ji,jj,jpl) * a_i(ji,jj,jpl) / MAX( za_old , epsi20 ) * rswitch 569 ENDIF 570 ! END MP 2016 571 END DO 572 END DO 573 490 574 491 575 ENDIF … … 513 597 vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 514 598 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 599 600 ! MV MP 2016 (remove once we get rid of a_i_frac and ht_i) 601 IF ( nn_pnd_scheme > 0 ) THEN 602 at_ip(:,:) = SUM( a_ip(:,:,:), dim = 3 ) 603 vt_ip(:,:) = SUM( v_ip(:,:,:), dim = 3 ) 604 ENDIF 605 ! END MP 2016 515 606 516 607 ! --- open water = 1 if at_i=0 -------------------------------- -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r7813 r8233 91 91 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 92 92 93 ! MV MP 2016 94 IF ( ln_pnd ) THEN 95 at_ip(:,:) = SUM( a_ip, dim=3 ) 96 vt_ip(:,:) = SUM( v_ip, dim=3 ) 97 ENDIF 98 ! END MP 2016 99 93 100 ! open water fraction 94 101 DO jj = 1, jpj … … 244 251 END DO 245 252 246 ! integrated values 253 ! integrated values 247 254 vt_i (:,:) = SUM( v_i, dim=3 ) 248 255 vt_s (:,:) = SUM( v_s, dim=3 ) 249 256 at_i (:,:) = SUM( a_i, dim=3 ) 257 258 ! MV MP 2016 259 ! probably should resum for melt ponds ??? 250 260 251 261 ! … … 516 526 !!------------------------------------------------------------------- 517 527 INTEGER :: ji, jj, jl, jk ! dummy loop indices 518 REAL(wp) :: zsal, zvi, zvs, zei, zes 528 REAL(wp) :: zsal, zvi, zvs, zei, zes, zvp 519 529 !!------------------------------------------------------------------- 520 530 at_i (:,:) = 0._wp … … 556 566 zvs = v_s (ji,jj, jl) 557 567 zes = e_s (ji,jj,1,jl) 568 IF ( ( nn_pnd_scheme > 0 ) .AND. ln_pnd_fw ) zvp = v_ip (ji,jj ,jl) 558 569 !----------------------------------------------------------------- 559 570 ! Zap snow energy … … 572 583 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch 573 584 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch 585 586 ! MV MP 2016 587 IF ( ln_pnd ) THEN 588 a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * rswitch 589 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * rswitch 590 IF ( ln_pnd_fw ) wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_ip(ji,jj,jl) - zvp ) * rhofw * r1_rdtice 591 ENDIF 592 ! END MV MP 2016 574 593 575 594 ! update exchanges with ocean -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r7753 r8233 172 172 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 173 173 174 IF ( ln_pnd ) & 175 CALL iom_put( "vfxpnd" , wfx_pnd * ztmp ) ! melt pond water flux 176 174 177 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 175 178 WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog … … 207 210 CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice 208 211 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 212 213 ! MV MP 2016 214 IF ( ln_pnd ) THEN 215 CALL iom_put( "iceamp" , at_ip * zswi ) ! melt pond total fraction 216 CALL iom_put( "icevmp" , vt_ip * zswi ) ! melt pond total volume per unit area 217 ENDIF 218 ! END MV MP 2016 209 219 210 220 … … 224 234 ! brine volume 225 235 IF ( iom_use( "brinevol_cat" ) ) CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 ) 236 237 ! MV MP 2016 238 IF ( ln_pnd ) THEN 239 IF ( iom_use( "iceamp_cat" ) ) CALL iom_put( "iceamp_cat" , a_ip * zswi2 ) ! melt pond frac for categories 240 IF ( iom_use( "icevmp_cat" ) ) CALL iom_put( "icevmp_cat" , v_ip * zswi2 ) ! melt pond frac for categories 241 IF ( iom_use( "icehmp_cat" ) ) CALL iom_put( "icehmp_cat" , h_ip * zswi2 ) ! melt pond frac for categories 242 IF ( iom_use( "iceafp_cat" ) ) CALL iom_put( "iceafp_cat" , a_ip_frac * zswi2 ) ! melt pond frac for categories 243 ENDIF 244 ! END MV MP 2016 226 245 227 246 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s … … 287 306 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 288 307 308 ! MV MP 2016 309 IF ( ln_pnd ) THEN 310 CALL histdef( kid, "si_amp", "Melt pond fraction" , "%" , & 311 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 312 CALL histdef( kid, "si_vmp", "Melt pond volume" , "m" , & 313 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 314 ENDIF 315 ! END MV MP 2016 316 289 317 CALL histdef( kid, "vfxbog", "Ice bottom production" , "m/s" , & 290 318 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) … … 331 359 CALL histwrite( kid, "sidive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 332 360 361 ! MV MP 2016 362 IF ( ln_pnd ) THEN 363 CALL histwrite( kid, "si_amp", kt, at_ip , jpi*jpj, (/1/) ) 364 CALL histwrite( kid, "si_vmp", kt, vt_ip , jpi*jpj, (/1/) ) 365 ENDIF 366 ! END MV MP 2016 367 333 368 CALL histwrite( kid, "vfxbog", kt, wfx_bog , jpi*jpj, (/1/) ) 334 369 CALL histwrite( kid, "vfxdyn", kt, wfx_dyn , jpi*jpj, (/1/) ) … … 338 373 CALL histwrite( kid, "vfxbom", kt, wfx_bom , jpi*jpj, (/1/) ) 339 374 CALL histwrite( kid, "vfxsum", kt, wfx_sum , jpi*jpj, (/1/) ) 375 IF ( ln_pnd ) & 376 CALL histwrite( kid, "vfxpnd", kt, wfx_pnd , jpi*jpj, (/1/) ) 340 377 341 378 CALL histwrite( kid, "sithicat", kt, ht_i , jpi*jpj*jpl, (/1/) ) -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r7646 r8233 58 58 59 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_1d 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_sum_1d 60 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sub_1d 61 62 … … 146 147 ii = ii + 1 147 148 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 148 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , 149 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , wfx_snw_sum_1d(jpij) , & 149 150 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) , & 150 151 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , & -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r7813 r8233 54 54 55 55 REAL(wp), PUBLIC :: rhosn = 330._wp !: volumic mass of snow [kg/m3] 56 ! MV MP 2016 57 REAL(wp), PUBLIC :: rhofw = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3] 58 ! END MV MP 2016 56 59 REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice 57 60 REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice [psu] … … 176 179 WRITE(numout,*) ' density of sea ice = ', rhoic , ' kg/m^3' 177 180 WRITE(numout,*) ' density of snow = ', rhosn , ' kg/m^3' 181 WRITE(numout,*) ' density of freshwater (in melt ponds) = ', rhofw , ' kg/m^3' 178 182 WRITE(numout,*) ' emissivity of snow or ice = ', emic 179 183 WRITE(numout,*) ' salinity of ice = ', sice , ' psu' -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r7813 r8233 7 7 !! NEMO 1.0 ! 2003-07 (C. Ethe, G. Madec) Optimization (old name:shine) 8 8 !! - ! 2004-11 (C. Talandier) add albedo_init 9 !! - ! 200 1-06 (M. Vancoppenolle) LIM 3.09 !! - ! 2006-06 (M. Vancoppenolle) LIM 3.0 10 10 !! - ! 2006-08 (G. Madec) cleaning for surface module 11 11 !! 3.6 ! 2016-01 (C. Rousset) new parameterization for sea ice albedo 12 !! 4.0 ! 2017-05 (M. Vancoppenolle, O. Lecomte) Melt ponds 12 13 !!---------------------------------------------------------------------- 13 14 … … 39 40 ! !!* namelist namsbc_alb 40 41 INTEGER :: nn_ice_alb 41 REAL(wp) :: rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt 42 REAL(wp) :: rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt, rn_alb_dpnd 42 43 43 44 !!---------------------------------------------------------------------- … … 48 49 CONTAINS 49 50 50 SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pa _ice_cs, pa_ice_os )51 SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pafrac_pnd, ph_pnd, ld_pnd, pa_ice_cs, pa_ice_os ) 51 52 !!---------------------------------------------------------------------- 52 53 !! *** ROUTINE albedo_ice *** … … 58 59 !! 1: the scheme is "home made" (for cloudy skies) and based on Brandt et al. (J. Climate 2005) 59 60 !! and Grenfell & Perovich (JGR 2004) 61 !! 2: fractional surface-based formulation of scheme 1 (NEW) 60 62 !! Description of scheme 1: 61 63 !! 1) Albedo dependency on ice thickness follows the findings from Brandt et al (2005) … … 80 82 !! Brandt et al. 2005, J. Climate, vol 18 81 83 !! Grenfell & Perovich 2004, JGR, vol 109 82 !!---------------------------------------------------------------------- 83 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pt_ice ! ice surface temperature (Kelvin) 84 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_ice ! sea-ice thickness 85 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_snw ! snow thickness 86 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pa_ice_cs ! albedo of ice under clear sky 87 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pa_ice_os ! albedo of ice under overcast sky 88 !! 89 INTEGER :: ji, jj, jl ! dummy loop indices 90 INTEGER :: ijpl ! number of ice categories (3rd dim of ice input arrays) 91 REAL(wp) :: zswitch, z1_c1, z1_c2 84 !! 85 !!---------------------------------------------------------------------- 86 !! 87 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pt_ice ! ice surface temperature (Kelvin) 88 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_ice ! sea-ice thickness 89 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_snw ! snow depth 90 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pafrac_pnd ! melt pond relative fraction (per unit ice area) 91 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_pnd ! melt pond depth 92 LOGICAL , INTENT(in ) :: ld_pnd ! melt ponds radiatively active or not 93 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pa_ice_cs ! albedo of ice under clear sky 94 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pa_ice_os ! albedo of ice under overcast sky 95 !! 96 INTEGER :: ji, jj, jl ! dummy loop indices 97 INTEGER :: ijpl ! number of ice categories (3rd dim of ice input arrays) 98 REAL(wp) :: zswitch, z1_c1, z1_c2 99 REAL(wp) :: zhref_pnd 92 100 REAL(wp) :: zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total 93 101 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalb_it ! intermediate variable & albedo of ice (snow free) 102 !! MV MP 103 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_pnd ! ponded sea ice albedo 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! bare sea ice albedo 105 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_snw ! snow-covered sea ice albedo 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: zafrac_snw ! relative snow fraction 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zafrac_ice ! relative ice fraction 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zafrac_pnd ! relative ice fraction (effective) 109 !! 94 110 !!--------------------------------------------------------------------- 95 111 … … 97 113 98 114 CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it ) 115 CALL wrk_alloc( jpi,jpj,ijpl, zalb_pnd, zalb_ice, zalb_snw ) 116 CALL wrk_alloc( jpi,jpj,ijpl, zalb_pnd, zafrac_snw, zafrac_ice, zafrac_pnd ) 99 117 100 118 IF( albd_init == 0 ) CALL albedo_init ! initialization 101 119 120 !----------------------------------------------------- 121 ! Snow-free albedo (no ice thickness dependence yet) 122 !----------------------------------------------------- 123 ! 124 ! Part common to nn_ice_alb = 0, 1, 2 125 ! 126 IF ( .NOT. ld_pnd ) THEN !--- No melt ponds OR radiatively inactive melt ponds 127 ! Bare ice albedo is prescribed, with implicit assumption on pond fraction and depth 128 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = rn_alb_imlt 129 ! !!! MV I think we could replace rt0_ice by rt0 and get rid of rt0 130 ELSE WHERE ; zalb(:,:,:) = rn_alb_idry 131 END WHERE 132 ENDIF 133 102 134 SELECT CASE ( nn_ice_alb ) 103 135 … … 105 137 ! Shine and Henderson-Sellers (1985) 106 138 !------------------------------------------ 139 ! NB: This parameterization is based on clear sky values 140 107 141 CASE( 0 ) 108 142 109 ! Computation of ice albedo (free of snow) 110 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = rn_alb_imlt 111 ELSE WHERE ; zalb(:,:,:) = rn_alb_idry 112 END WHERE 113 143 ! Thickness-dependent bare ice albedo 114 144 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb 115 145 ELSE WHERE( 1.0 < ph_ice .AND. ph_ice <= 1.5 ) ; zalb_it = 0.472 + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 ) … … 119 149 ELSE WHERE ; zalb_it = 0.1 + 3.6 * ph_ice 120 150 END WHERE 121 151 152 IF ( ld_pnd ) THEN 153 ! Depth-dependent ponded ice albedo 154 zhref_pnd = 0.05 ! Characteristic length scale for thickness dependence of ponded ice albedo, Lecomte et al (2015) 155 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_it ) * EXP( - ph_pnd / zhref_pnd ) 156 157 ! Snow-free ice albedo is a function of pond fraction 158 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb_it = zalb_it * ( 1. - pafrac_pnd ) + zalb_pnd * pafrac_pnd ; END WHERE 159 ENDIF 160 122 161 DO jl = 1, ijpl 123 162 DO jj = 1, jpj 124 163 DO ji = 1, jpi 125 ! freezing snow164 ! Freezing snow 126 165 ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2 127 166 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) ) … … 130 169 & + zswitch * rn_alb_sdry 131 170 132 ! melting snow171 ! Melting snow 133 172 ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2 134 173 zswitch = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) ) … … 136 175 & + zswitch * rn_alb_smlt 137 176 ! 138 ! snow albedo177 ! Snow albedo 139 178 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 140 179 zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 141 180 142 ! Ice/snowalbedo143 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )144 pa_ice_cs(ji,jj,jl) = 181 ! Surface albedo 182 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 183 pa_ice_cs(ji,jj,jl) = zswitch * zalb_st + ( 1._wp - zswitch ) * zalb_it(ji,jj,jl) 145 184 ! 146 185 END DO … … 153 192 ! New parameterization (2016) 154 193 !------------------------------------------ 194 ! NB: This parameterization is based on overcast skies values 195 155 196 CASE( 1 ) 156 197 157 ! compilation of values from literature 198 ! compilation of values from literature (reference overcast sky values) 158 199 ! rn_alb_sdry = 0.85 ! dry snow 159 200 ! rn_alb_smlt = 0.75 ! melting snow 160 201 ! rn_alb_idry = 0.60 ! bare frozen ice 202 ! rn_alb_dpnd = 0.36 ! ponded-ice overcast albedo (Lecomte et al, 2015) 203 ! ! early melt pnds 0.27, late melt ponds 0.14 Grenfell & Perovich 161 204 ! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 162 205 ! rn_alb_sdry = 0.85 ! dry snow … … 168 211 ! rn_alb_idry = 0.54 ! bare frozen ice 169 212 ! 170 ! Computation of ice albedo (free of snow)213 ! Computation of snow-free ice albedo 171 214 z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 172 215 z1_c2 = 1. / 0.05 173 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb = rn_alb_imlt 174 ELSE WHERE ; zalb = rn_alb_idry 175 END WHERE 176 177 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb 178 ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 ) ; zalb_it = zalb + ( 0.18 - zalb ) * z1_c1 * & 216 217 ! Accounting for the ice-thickness dependency 218 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb 219 ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 ) ; zalb_it = zalb + ( 0.18 - zalb ) * z1_c1 * & 179 220 & ( LOG(1.5) - LOG(ph_ice) ) 180 ELSE WHERE ; zalb_it = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice221 ELSE WHERE ; zalb_it = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice 181 222 END WHERE 223 224 IF ( ld_pnd ) THEN 225 ! Depth-dependent ponded ice albedo 226 zhref_pnd = 0.05 ! Characteristic length scale for thickness dependence of ponded ice albedo, Lecomte et al (2015) 227 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_it ) * EXP( - ph_pnd / zhref_pnd ) 228 229 ! Snow-free ice albedo is weighted mean of ponded ice and bare ice contributions 230 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb_it = zalb_it * ( 1. - pafrac_pnd ) + zalb_pnd * pafrac_pnd ; END WHERE 231 ENDIF 182 232 183 233 z1_c1 = 1. / 0.02 184 234 z1_c2 = 1. / 0.03 185 ! Computation of the snow/ice albedo 235 236 ! Overcast sky surface albedo (accounting for snow, ice melt ponds) 186 237 DO jl = 1, ijpl 187 238 DO jj = 1, jpj 188 239 DO ji = 1, jpi 240 ! Snow depth dependence of snow albedo 189 241 zalb_sf = rn_alb_sdry - ( rn_alb_sdry - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 ); 190 242 zalb_sm = rn_alb_smlt - ( rn_alb_smlt - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 ); 191 243 192 ! snow albedo244 ! Snow albedo (MV I guess we could use rt0 instead of rt0_snow) 193 245 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 194 246 zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 195 247 196 ! Ice/snowalbedo248 ! Surface albedo 197 249 zswitch = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 198 250 pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch * zalb_it(ji,jj,jl) … … 201 253 END DO 202 254 END DO 203 ! Effect of the clouds (2d order polynomial) 255 256 ! Clear sky surface albedo 204 257 pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 258 259 !--------------------------------------------------- 260 ! Fractional surface-based parameterization (2017) 261 !--------------------------------------------------- 262 CASE( 2 ) 263 264 ! MV: I propose this formulation that is more elegant, and more easy to expand towards 265 ! varying pond and snow fraction. 266 ! Formulation 1 has issues to handle ponds and snow together that 267 ! can't easily be fixed. This one handles it better, I believe. 268 269 !----------------------------------------- 270 ! Snow, bare ice and ponded ice fractions 271 !----------------------------------------- 272 ! Specific fractions (zafrac) refer to relative area covered by snow within each ice category 273 274 !--- Effective pond fraction (for now, we prevent melt ponds and snow at the same time) 275 zafrac_pnd = 0._wp 276 IF ( ld_pnd ) THEN 277 WHERE( ph_snw == 0._wp ) ; zafrac_pnd = pafrac_pnd ; END WHERE ! Snow fully "shades" melt ponds 278 ENDIF 279 280 !--- Specific snow fraction (for now, prescribed) 281 WHERE ( ph_snw > 0._wp ) ; zafrac_snw = 1. 282 ELSE WHERE ; zafrac_snw = 0. 283 END WHERE 284 285 !--- Specific ice fraction 286 zafrac_ice = 1. - zafrac_snw - zafrac_pnd 287 288 !-------------------------------------------------- 289 ! Snow-covered, pond-covered, and bare ice albedos 290 !-------------------------------------------------- 291 ! Bare ice albedo 292 z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 293 z1_c2 = 1. / 0.05 294 WHERE ( 1.5 < ph_ice ) ; zalb_ice = zalb 295 ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 ) ; zalb_ice = zalb + ( 0.18 - zalb ) * z1_c1 * & 296 & ( LOG(1.5) - LOG(ph_ice) ) 297 ELSE WHERE ; zalb_ice = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice 298 END WHERE 299 300 ! Snow-covered ice albedo (freezing, melting cases) 301 z1_c1 = 1. / 0.02 302 z1_c2 = 1. / 0.03 303 304 WHERE( pt_ice < rt0_snow ) ; zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw * z1_c1 ); 305 ELSE WHERE ; zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw * z1_c2 ); 306 END WHERE 307 308 ! Depth-dependent ponded ice albedo 309 IF ( ld_pnd ) THEN 310 zhref_pnd = 0.05 ! Characteristic length scale for thickness dependence of ponded ice albedo, Lecomte et al (2015) 311 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd / zhref_pnd ) 312 ELSE 313 zalb_pnd = rn_alb_dpnd 314 ENDIF 315 316 ! Surface albedo is weighted mean of snow, ponds and bare ice contributions 317 pa_ice_os = zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice 318 319 pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ) 205 320 206 321 END SELECT 207 322 208 323 CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it ) 324 CALL wrk_dealloc( jpi,jpj,ijpl, zalb_pnd, zalb_ice, zalb_snw ) 325 CALL wrk_dealloc( jpi,jpj,ijpl, zalb_pnd, zafrac_snw, zafrac_ice, zafrac_pnd ) 209 326 ! 210 327 END SUBROUTINE albedo_ice -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7777 r8233 48 48 USE limvar ! Ice variables switch 49 49 USE limctl ! 50 ! MV MP 2016 51 USE limmp 52 ! END MV MP 2016 53 50 54 USE limistate ! LIM initial state 51 55 USE limthd_sal ! LIM ice thermodynamics: salinity … … 208 212 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 209 213 210 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 214 CALL albedo_ice( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos MV MP 2016 215 211 216 SELECT CASE( ksbc ) 212 217 CASE( jp_usr ) ; CALL usrdef_sbc_ice_flx( kt ) ! user defined formulation … … 231 236 ! --- zap this if no ice thermo --- ! 232 237 IF( ln_limthd ) CALL lim_thd( kt ) ! -- Ice thermodynamics 238 239 ! MV MP 2016 240 IF ( ln_pnd ) CALL lim_mp( kt ) ! -- Melt ponds 241 ! END MV MP 2016 242 233 243 IF( ln_limthd ) CALL lim_update2( kt ) ! -- Corrections 234 244 ! --- … … 311 321 ! 312 322 CALL lim_thd_sal_init ! set ice salinity parameters 313 ! 323 324 ! MV MP 2016 325 CALL lim_mp_init ! set melt ponds parameters 326 ! END MV MP 2016 327 314 328 IF( ln_limdyn ) CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 315 329 ! ! Initial sea-ice state … … 620 634 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 621 635 wfx_spr(:,:) = 0._wp ; wfx_lam(:,:) = 0._wp 636 637 ! MV MP 2016 638 wfx_pnd(:,:) = 0._wp ; wfx_snw_sum(:,:) = 0._wp 639 ! END MV MP 2016 622 640 623 641 hfx_thd(:,:) = 0._wp ;
Note: See TracChangeset
for help on using the changeset viewer.
