Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7646 r7698 109 109 ! 4 = Pure Coupled formulation) 110 110 !! 111 INTEGER :: jl 111 INTEGER :: jl, jj, ji ! dummy loop index 112 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 113 113 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice … … 133 133 134 134 ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean) 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 135 !$OMP PARALLEL DO schedule(static) private(jj, ji) 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 u_oce(ji,jj) = ssu_m(ji,jj) * umask(ji,jj,1) 139 v_oce(ji,jj) = ssv_m(ji,jj) * vmask(ji,jj,1) 140 END DO 141 END DO 137 142 138 143 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 139 144 CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 140 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 145 !$OMP PARALLEL 146 !$OMP DO schedule(static) private(jj, ji) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 t_bo(ji,jj) = ( t_bo(ji,jj) + rt0 ) * tmask(ji,jj,1) + rt0 * ( 1._wp - tmask(ji,jj,1) ) 150 END DO 151 END DO 141 152 142 153 ! Mask sea ice surface temperature (set to rt0 over land) 143 154 DO jl = 1, jpl 144 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 145 END DO 155 !$OMP DO schedule(static) private(jj, ji) 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 t_su(ji,jj,jl) = t_su(ji,jj,jl) * tmask(ji,jj,1) + rt0 * ( 1._wp - tmask(ji,jj,1) ) 159 END DO 160 END DO 161 END DO 162 !$OMP END PARALLEL 146 163 ! 147 164 !------------------------------------------------! … … 161 178 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 162 179 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 163 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 164 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 180 !$OMP PARALLEL DO schedule(static) private(jj, ji) 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 184 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 185 END DO 186 END DO 165 187 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 166 188 ENDIF … … 180 202 CALL lim_dyn( kt ) ! rheology 181 203 ELSE 182 u_ice(:,:) = rn_uice * umask(:,:,1) ! or prescribed velocity 183 v_ice(:,:) = rn_vice * vmask(:,:,1) 204 !$OMP PARALLEL DO schedule(static) private(jj, ji) 205 DO jj = 1, jpj 206 DO ji = 1, jpi 207 u_ice(ji,jj) = rn_uice * umask(ji,jj,1) ! or prescribed velocity 208 v_ice(ji,jj) = rn_vice * vmask(ji,jj,1) 209 END DO 210 END DO 184 211 ENDIF 185 212 CALL lim_trp( kt ) ! -- Ice transport (Advection/diffusion) … … 200 227 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 201 228 ! 202 pfrld(:,:) = 1._wp - at_i(:,:) 203 phicif(:,:) = vt_i(:,:) 229 !$OMP PARALLEL DO schedule(static) private(jj, ji) 230 DO jj = 1, jpj 231 DO ji = 1, jpi 232 pfrld(ji,jj) = 1._wp - at_i(ji,jj) 233 phicif(ji,jj) = vt_i(ji,jj) 234 END DO 235 END DO 204 236 205 237 !------------------------------------------------------! … … 220 252 CASE( jp_blk ) ! bulk formulation 221 253 ! albedo depends on cloud fraction because of non-linear spectral effects 222 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 254 DO jl = 1, jpl 255 !$OMP PARALLEL DO schedule(static) private(jj, ji) 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 259 END DO 260 END DO 261 END DO 223 262 CALL blk_ice_flx( t_su, alb_ice ) 224 263 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) … … 226 265 CASE ( jp_purecpl ) 227 266 ! albedo depends on cloud fraction because of non-linear spectral effects 228 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 267 DO jl = 1, jpl 268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 272 END DO 273 END DO 274 END DO 229 275 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 230 276 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) … … 285 331 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 286 332 !!---------------------------------------------------------------------- 287 INTEGER :: j i, jj, ierr333 INTEGER :: jl, ji, jj, ierr 288 334 !!---------------------------------------------------------------------- 289 335 IF(lwp) WRITE(numout,*) … … 334 380 IF( ln_limdiahsb) CALL lim_diahsb_init ! initialization for diags 335 381 ! 336 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction 337 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 338 ! 382 !$OMP PARALLEL 383 !$OMP DO schedule(static) private(jj, ji) 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 fr_i(ji,jj) = at_i(ji,jj) ! initialisation of sea-ice fraction 387 END DO 388 END DO 389 !$OMP END DO NOWAIT 390 DO jl = 1, jpl 391 !$OMP DO schedule(static) private(jj, ji) 392 DO jj = 1, jpj 393 DO ji = 1, jpi 394 tn_ice(ji,jj,jl) = t_su(ji,jj,jl) ! initialisation of surface temp for coupled simu 395 END DO 396 END DO 397 !$OMP END DO NOWAIT 398 END DO 399 ! 400 !$OMP DO schedule(static) private(jj, ji) 339 401 DO jj = 1, jpj 340 402 DO ji = 1, jpi … … 344 406 END DO 345 407 END DO 408 !$OMP END PARALLEL 346 409 ! 347 410 nstart = numit + nn_fsbc … … 527 590 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 528 591 ! 529 INTEGER :: jl ! dummy loop index592 INTEGER :: jl, jj, ji ! dummy loop index 530 593 ! 531 594 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m ! Mean albedo over all categories … … 550 613 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 551 614 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 615 616 !$OMP PARALLEL 552 617 DO jl = 1, jpl 553 pdqn_ice (:,:,jl) = z_dqn_m(:,:) 554 pdevap_ice(:,:,jl) = z_devap_m(:,:) 618 !$OMP DO schedule(static) private(jj, ji) 619 DO jj = 1, jpj 620 DO ji = 1, jpi 621 pdqn_ice (ji,jj,jl) = z_dqn_m(ji,jj) 622 pdevap_ice(ji,jj,jl) = z_devap_m(ji,jj) 623 END DO 624 END DO 625 !$OMP END DO NOWAIT 555 626 END DO 556 627 ! 557 628 DO jl = 1, jpl 558 pqns_ice (:,:,jl) = z_qns_m(:,:) 559 pqsr_ice (:,:,jl) = z_qsr_m(:,:) 560 pevap_ice(:,:,jl) = z_evap_m(:,:) 561 END DO 629 !$OMP DO schedule(static) private(jj, ji) 630 DO jj = 1, jpj 631 DO ji = 1, jpi 632 pqns_ice (ji,jj,jl) = z_qns_m(ji,jj) 633 pqsr_ice (ji,jj,jl) = z_qsr_m(ji,jj) 634 pevap_ice(ji,jj,jl) = z_evap_m(ji,jj) 635 END DO 636 END DO 637 END DO 638 !$OMP END PARALLEL 562 639 ! 563 640 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) … … 571 648 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 572 649 DO jl = 1, jpl 573 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 574 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 575 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 650 !$OMP PARALLEL DO schedule(static) private(jj, ji) 651 DO jj = 1, jpj 652 DO ji = 1, jpi 653 pqns_ice (ji,jj,jl) = pqns_ice (ji,jj,jl) + pdqn_ice (ji,jj,jl) * ( ptn_ice(ji,jj,jl) - ztem_m(ji,jj) ) 654 pevap_ice(ji,jj,jl) = pevap_ice(ji,jj,jl) + pdevap_ice(ji,jj,jl) * ( ptn_ice(ji,jj,jl) - ztem_m(ji,jj) ) 655 pqsr_ice (ji,jj,jl) = pqsr_ice (ji,jj,jl) * ( 1._wp - palb_ice(ji,jj,jl) ) / ( 1._wp - zalb_m(ji,jj) ) 656 END DO 657 END DO 576 658 END DO 577 659 ! … … 590 672 !! ** purpose : store ice variables at "before" time step 591 673 !!---------------------------------------------------------------------- 592 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 593 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 594 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 595 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 596 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 597 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 598 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 599 u_ice_b(:,:) = u_ice(:,:) 600 v_ice_b(:,:) = v_ice(:,:) 601 ! 602 at_i_b (:,:) = SUM( a_i_b(:,:,:), dim=3 ) 674 INTEGER :: jn, jl, jj, ji ! dummy loop index 675 676 !$OMP PARALLEL 677 DO jl = 1, jpl 678 !$OMP DO schedule(static) private(jj, ji) 679 DO jj = 1, jpj 680 DO ji = 1, jpi 681 a_i_b (ji,jj,jl) = a_i (ji,jj,jl) ! ice area 682 v_i_b (ji,jj,jl) = v_i (ji,jj,jl) ! ice volume 683 v_s_b (ji,jj,jl) = v_s (ji,jj,jl) ! snow volume 684 smv_i_b(ji,jj,jl) = smv_i(ji,jj,jl) ! salt content 685 oa_i_b (ji,jj,jl) = oa_i (ji,jj,jl) ! areal age content 686 END DO 687 END DO 688 !$OMP END DO NOWAIT 689 END DO 690 DO jl = 1, jpl 691 DO jn = 1, nlay_i 692 !$OMP DO schedule(static) private(jj, ji) 693 DO jj = 1, jpj 694 DO ji = 1, jpi 695 e_i_b (ji,jj,jn,jl) = e_i (ji,jj,jn,jl) ! ice thermal energy 696 END DO 697 END DO 698 !$OMP END DO NOWAIT 699 END DO 700 END DO 701 DO jl = 1, jpl 702 DO jn = 1, nlay_s 703 !$OMP DO schedule(static) private(jj, ji) 704 DO jj = 1, jpj 705 DO ji = 1, jpi 706 e_s_b (ji,jj,jn,jl) = e_s (ji,jj,jn,jl) ! snow thermal energy 707 END DO 708 END DO 709 !$OMP END DO NOWAIT 710 END DO 711 END DO 712 !$OMP DO schedule(static) private(jj, ji) 713 DO jj = 1, jpj 714 DO ji = 1, jpi 715 u_ice_b(ji,jj) = u_ice(ji,jj) 716 v_ice_b(ji,jj) = v_ice(ji,jj) 717 at_i_b (ji,jj) = 0._wp 718 END DO 719 END DO 720 DO jl = 1, jpl 721 !$OMP DO schedule(static) private(jj, ji) 722 DO jj = 1, jpj 723 DO ji = 1, jpi 724 ! 725 at_i_b (ji,jj) = at_i_b (ji,jj) + a_i_b(ji,jj,jl) 726 END DO 727 END DO 728 END DO 729 !$OMP END PARALLEL 603 730 604 731 END SUBROUTINE sbc_lim_bef … … 612 739 !! of the time step 613 740 !!---------------------------------------------------------------------- 614 sfx (:,:) = 0._wp ; 615 sfx_bri(:,:) = 0._wp ; sfx_lam(:,:) = 0._wp 616 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 617 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 618 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 619 sfx_res(:,:) = 0._wp ; sfx_sub(:,:) = 0._wp 620 ! 621 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 622 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 623 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 624 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 625 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 626 wfx_spr(:,:) = 0._wp ; wfx_lam(:,:) = 0._wp 741 INTEGER :: jj, ji ! dummy loop index 742 743 !$OMP PARALLEL DO schedule(static) private(jj, ji) 744 DO jj = 1, jpj 745 DO ji = 1, jpi 746 sfx (ji,jj) = 0._wp ; 747 sfx_bri(ji,jj) = 0._wp ; sfx_lam(ji,jj) = 0._wp 748 sfx_sni(ji,jj) = 0._wp ; sfx_opw(ji,jj) = 0._wp 749 sfx_bog(ji,jj) = 0._wp ; sfx_dyn(ji,jj) = 0._wp 750 sfx_bom(ji,jj) = 0._wp ; sfx_sum(ji,jj) = 0._wp 751 sfx_res(ji,jj) = 0._wp ; sfx_sub(ji,jj) = 0._wp 752 ! 753 wfx_snw(ji,jj) = 0._wp ; wfx_ice(ji,jj) = 0._wp 754 wfx_sni(ji,jj) = 0._wp ; wfx_opw(ji,jj) = 0._wp 755 wfx_bog(ji,jj) = 0._wp ; wfx_dyn(ji,jj) = 0._wp 756 wfx_bom(ji,jj) = 0._wp ; wfx_sum(ji,jj) = 0._wp 757 wfx_res(ji,jj) = 0._wp ; wfx_sub(ji,jj) = 0._wp 758 wfx_spr(ji,jj) = 0._wp ; wfx_lam(ji,jj) = 0._wp 627 759 628 hfx_thd(:,:) = 0._wp ; 629 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 630 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 631 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 632 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 633 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 634 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 635 hfx_err_dif(:,:) = 0._wp 636 wfx_err_sub(:,:) = 0._wp 637 ! 638 afx_tot(:,:) = 0._wp ; 639 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 640 ! 641 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp 642 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp 643 644 tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 760 hfx_thd(ji,jj) = 0._wp ; 761 hfx_snw(ji,jj) = 0._wp ; hfx_opw(ji,jj) = 0._wp 762 hfx_bog(ji,jj) = 0._wp ; hfx_dyn(ji,jj) = 0._wp 763 hfx_bom(ji,jj) = 0._wp ; hfx_sum(ji,jj) = 0._wp 764 hfx_res(ji,jj) = 0._wp ; hfx_sub(ji,jj) = 0._wp 765 hfx_spr(ji,jj) = 0._wp ; hfx_dif(ji,jj) = 0._wp 766 hfx_err(ji,jj) = 0._wp ; hfx_err_rem(ji,jj) = 0._wp 767 hfx_err_dif(ji,jj) = 0._wp 768 wfx_err_sub(ji,jj) = 0._wp 769 ! 770 afx_tot(ji,jj) = 0._wp ; 771 afx_dyn(ji,jj) = 0._wp ; afx_thd(ji,jj) = 0._wp 772 ! 773 diag_heat(ji,jj) = 0._wp ; diag_smvi(ji,jj) = 0._wp 774 diag_vice(ji,jj) = 0._wp ; diag_vsnw(ji,jj) = 0._wp 775 776 tau_icebfr(ji,jj) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 777 END DO 778 END DO 645 779 646 780 END SUBROUTINE sbc_lim_diag0
Note: See TracChangeset
for help on using the changeset viewer.
