- Timestamp:
- 2015-12-04T17:05:58+01:00 (9 years ago)
- Location:
- branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 2 edited
-
limsbc.F90 (modified) (6 diffs)
-
limthd.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5866 r6004 23 23 !! lim_sbc_tau : update i- and j-stresses, and its modulus at the ocean surface 24 24 !!---------------------------------------------------------------------- 25 USE par_oce ! ocean parameters 26 USE phycst ! physical constants 27 USE dom_oce ! ocean domain 28 USE ice ! LIM sea-ice variables 29 USE sbc_ice ! Surface boundary condition: sea-ice fields 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 USE sbccpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 USE albedo ! albedo parameters 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! work arrays 37 USE in_out_manager ! I/O manager 38 USE prtctl ! Print control 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 USE traqsr ! add penetration of solar flux in the calculation of heat budget 41 USE iom 42 USE domvvl ! Variable volume 43 USE limctl 44 USE limcons 25 USE par_oce ! ocean parameters 26 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 27 USE phycst ! physical constants 28 USE dom_oce ! ocean domain 29 USE ice ! LIM sea-ice variables 30 USE sbc_ice ! Surface boundary condition: sea-ice fields 31 USE sbc_oce ! Surface boundary condition: ocean fields 32 USE sbccpl ! Surface boundary condition: coupled interface 33 USE albedo ! albedo parameters 34 USE traqsr ! add penetration of solar flux in the calculation of heat budget 35 USE domvvl ! Variable volume 36 USE limctl ! 37 USE limcons ! 38 ! 39 USE in_out_manager ! I/O manager 40 USE iom ! xIO server 41 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 42 USE lib_mpp ! MPP library 43 USE wrk_nemo ! work arrays 44 USE prtctl ! Print control 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 45 46 46 47 IMPLICIT NONE 47 48 PRIVATE 48 49 49 PUBLIC lim_sbc_init ! called by sbc _lim_init50 PUBLIC lim_sbc_init ! called by sbcice_lim 50 51 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 51 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 100 101 !! The ref should be Rousset et al., 2015 101 102 !!--------------------------------------------------------------------- 102 INTEGER, INTENT(in) :: kt 103 INTEGER :: ji, jj, jl, jk ! dummy loop indices104 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2)105 REAL(wp) :: zq sr ! New solar flux received by the ocean106 !107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace103 INTEGER, INTENT(in) :: kt ! number of iteration 104 ! 105 INTEGER :: ji, jj, jl, jk ! dummy loop indices 106 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 107 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace 108 109 !!--------------------------------------------------------------------- 109 110 ! 110 111 ! make calls for heat fluxes before it is modified 111 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface … … 197 198 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 198 199 !------------------------------------------------------------------------! 199 CALL wrk_alloc( jpi, jpj, jpl,zalb_cs, zalb_os )200 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 200 201 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 201 202 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 202 CALL wrk_dealloc( jpi, jpj, jpl,zalb_cs, zalb_os )203 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 203 204 204 205 ! conservation test 205 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )206 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 206 207 207 208 ! control prints 208 209 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 209 210 ! 210 211 IF(ln_ctl) THEN 211 212 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) … … 214 215 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 215 216 ENDIF 216 217 ! 217 218 END SUBROUTINE lim_sbc_flx 218 219 … … 245 246 INTEGER , INTENT(in) :: kt ! ocean time-step index 246 247 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 247 ! !248 ! 248 249 INTEGER :: ji, jj ! dummy loop indices 249 250 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar … … 302 303 !! ** input : Namelist namicedia 303 304 !!------------------------------------------------------------------- 304 INTEGER :: ji, jj, jk ! dummy loop indices 305 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 305 INTEGER :: ji, jj, jk ! dummy loop indices 306 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 307 !!------------------------------------------------------------------- 308 ! 306 309 IF(lwp) WRITE(numout,*) 307 310 IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5845 r6004 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE thd_ice ! LIM thermodynamic sea-ice variables28 USE dom_ice ! LIM sea-ice domain27 USE dom_ice ! LIM: sea-ice domain 28 USE thd_ice ! LIM: thermodynamic sea-ice variables 29 29 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 30 30 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation 31 31 USE limthd_sal ! LIM: thermodynamics, ice salinity 32 32 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 33 USE limthd_lac ! LIM -3lateral accretion34 USE limitd_th ! remapping thickness distribution33 USE limthd_lac ! LIM: lateral accretion 34 USE limitd_th ! LIM: remapping thickness distribution 35 35 USE limtab ! LIM: 1D <==> 2D transformation 36 36 USE limvar ! LIM: sea-ice variables 37 USE limcons ! LIM: conservation tests 38 USE limctl ! LIM: control print 39 ! 40 USE in_out_manager ! I/O manager 41 USE prtctl ! Print control 37 42 USE lbclnk ! lateral boundary condition - MPP links 38 43 USE lib_mpp ! MPP library 39 44 USE wrk_nemo ! work arrays 40 USE in_out_manager ! I/O manager41 USE prtctl ! Print control42 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 43 46 USE timing ! Timing 44 USE limcons ! conservation tests45 USE limctl46 47 47 48 IMPLICIT NONE … … 80 81 !!--------------------------------------------------------------------- 81 82 INTEGER, INTENT(in) :: kt ! number of iteration 82 ! !83 ! 83 84 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 85 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 85 INTEGER :: ii, ij ! temporary dummy loop index86 86 REAL(wp) :: zfric_u, zqld, zqfr 87 87 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 88 88 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 89 89 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 90 !91 90 !!------------------------------------------------------------------- 92 91 93 IF( nn_timing == 1 ) CALL timing_start('limthd')92 IF( nn_timing == 1 ) CALL timing_start('limthd') 94 93 95 94 ! conservation test 96 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)95 IF( ln_limdiahsb ) CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 97 96 98 97 CALL lim_var_glo2eqv … … 225 224 226 225 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 227 228 !-------------------------! 229 ! --- Move to 1D arrays --- 230 !-------------------------! 231 CALL lim_thd_1d2d( nbpb, jl, 1 ) 232 233 !--------------------------------------! 234 ! --- Ice/Snow Temperature profile --- ! 235 !--------------------------------------! 236 CALL lim_thd_dif( 1, nbpb ) 237 238 !---------------------------------! 239 ! --- Ice/Snow thickness --- ! 240 !---------------------------------! 241 CALL lim_thd_dh( 1, nbpb ) 242 243 ! --- Ice enthalpy remapping --- ! 244 CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 245 246 !---------------------------------! 247 ! --- Ice salinity --- ! 248 !---------------------------------! 249 CALL lim_thd_sal( 1, nbpb ) 250 251 !---------------------------------! 252 ! --- temperature update --- ! 253 !---------------------------------! 254 CALL lim_thd_temp( 1, nbpb ) 255 256 !------------------------------------! 257 ! --- lateral melting if monocat --- ! 258 !------------------------------------! 226 ! 227 CALL lim_thd_1d2d( nbpb, jl, 1 ) ! --- Move to 1D arrays ---! 228 ! 229 CALL lim_thd_dif ( 1, nbpb ) ! --- Ice/Snow Temperature profile --- ! 230 ! 231 CALL lim_thd_dh ( 1, nbpb ) ! --- Ice/Snow thickness ---! 232 ! 233 CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) ) ! --- Ice enthalpy remapping --- ! 234 ! 235 CALL lim_thd_sal ( 1, nbpb ) ! --- Ice salinity --- ! 236 ! 237 CALL lim_thd_temp( 1, nbpb ) ! --- temperature update --- ! 238 ! 239 ! ! --- lateral melting if monocat --- ! 259 240 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 260 241 CALL lim_thd_lam( 1, nbpb ) 261 242 END IF 262 263 !-------------------------! 264 ! --- Move to 2D arrays --- 265 !-------------------------! 266 CALL lim_thd_1d2d( nbpb, jl, 2 ) 267 268 ! 269 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 243 ! 244 CALL lim_thd_1d2d( nbpb, jl, 2 ) ! --- Move to 2D arrays --- 245 ! 246 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 270 247 ENDIF 271 248 ! … … 409 386 ENDIF 410 387 ! 411 IF( nn_timing == 1 ) CALL timing_stop('limthd')412 388 IF( nn_timing == 1 ) CALL timing_stop('limthd') 389 ! 413 390 END SUBROUTINE lim_thd 414 391 … … 423 400 !!------------------------------------------------------------------- 424 401 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 425 ! !402 ! 426 403 INTEGER :: ji, jk ! dummy loop indices 427 404 REAL(wp) :: ztmelts, zaaa, zbbb, zccc, zdiscrim ! local scalar … … 443 420 END DO 444 421 END DO 445 422 ! 446 423 END SUBROUTINE lim_thd_temp 424 447 425 448 426 SUBROUTINE lim_thd_lam( kideb, kiut ) … … 454 432 !!----------------------------------------------------------------------- 455 433 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 456 INTEGER :: ji ! dummy loop indices 457 REAL(wp) :: zhi_bef ! ice thickness before thermo 458 REAL(wp) :: zdh_mel, zda_mel ! net melting 459 REAL(wp) :: zvi, zvs ! ice/snow volumes 460 434 ! 435 INTEGER :: ji ! dummy loop indices 436 REAL(wp) :: zhi_bef ! ice thickness before thermo 437 REAL(wp) :: zdh_mel, zda_mel ! net melting 438 REAL(wp) :: zvi, zvs ! ice/snow volumes 439 !!----------------------------------------------------------------------- 440 ! 461 441 DO ji = kideb, kiut 462 442 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) … … 476 456 END IF 477 457 END DO 478 458 ! 479 459 END SUBROUTINE lim_thd_lam 460 480 461 481 462 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) … … 485 466 !! ** Purpose : move arrays from 1d to 2d and the reverse 486 467 !!----------------------------------------------------------------------- 487 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 488 ! 2= from 1D to 2D 468 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 489 469 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 490 470 INTEGER, INTENT(in) :: jl ! ice cat 471 ! 491 472 INTEGER :: jk ! dummy loop indices 492 473 !!----------------------------------------------------------------------- 474 ! 493 475 SELECT CASE( kn ) 494 495 CASE( 1 ) 496 476 ! 477 CASE( 1 ) ! from 2D to 1D 478 ! 497 479 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 498 480 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 499 481 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 500 482 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 501 483 ! 502 484 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 503 485 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 511 493 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 512 494 END DO 513 495 ! 514 496 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 515 497 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 525 507 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 526 508 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 527 509 ! 528 510 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 529 511 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 530 512 ! 531 513 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 532 514 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) … … 535 517 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 536 518 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 537 519 ! 538 520 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 539 521 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) … … 542 524 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 543 525 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 544 526 ! 545 527 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 546 528 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) … … 556 538 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 557 539 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 558 559 CASE( 2 ) 560 540 ! 541 CASE( 2 ) ! from 1D to 2D 542 ! 561 543 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 562 544 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) … … 575 557 END DO 576 558 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 577 559 ! 578 560 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 579 561 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 580 562 ! 581 563 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 582 564 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) … … 585 567 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 586 568 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 587 569 ! 588 570 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 589 571 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) … … 592 574 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 593 575 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 594 576 ! 595 577 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 596 578 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) … … 611 593 ! 612 594 END SELECT 613 595 ! 614 596 END SUBROUTINE lim_thd_1d2d 615 597 … … 628 610 !!------------------------------------------------------------------- 629 611 INTEGER :: ios ! Local integer output status for namelist read 630 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 631 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 612 !! 613 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 614 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 632 615 & nn_monocat, ln_it_qnsice 633 616 !!-------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
