- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5836 r7351 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 … … 52 53 53 54 !! * Substitutions 54 # include "domzgr_substitute.h90"55 55 # include "vectopt_loop_substitute.h90" 56 56 !!---------------------------------------------------------------------- … … 81 81 !!--------------------------------------------------------------------- 82 82 INTEGER, INTENT(in) :: kt ! number of iteration 83 ! !83 ! 84 84 INTEGER :: ji, jj, jk, jl ! dummy loop indices 85 85 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 86 INTEGER :: ii, ij ! temporary dummy loop index87 86 REAL(wp) :: zfric_u, zqld, zqfr 88 87 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 89 88 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 90 89 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 91 !92 90 !!------------------------------------------------------------------- 93 91 94 IF( nn_timing == 1 ) CALL timing_start('limthd')92 IF( nn_timing == 1 ) CALL timing_start('limthd') 95 93 96 94 ! conservation test 97 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 ) 98 96 99 97 CALL lim_var_glo2eqv … … 147 145 148 146 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 149 zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )147 zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 150 148 151 149 ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! … … 226 224 227 225 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 228 229 !-------------------------! 230 ! --- Move to 1D arrays --- 231 !-------------------------! 232 CALL lim_thd_1d2d( nbpb, jl, 1 ) 233 234 !--------------------------------------! 235 ! --- Ice/Snow Temperature profile --- ! 236 !--------------------------------------! 237 CALL lim_thd_dif( 1, nbpb ) 238 239 !---------------------------------! 240 ! --- Ice/Snow thickness --- ! 241 !---------------------------------! 242 CALL lim_thd_dh( 1, nbpb ) 243 244 ! --- Ice enthalpy remapping --- ! 245 CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 246 247 !---------------------------------! 248 ! --- Ice salinity --- ! 249 !---------------------------------! 250 CALL lim_thd_sal( 1, nbpb ) 251 252 !---------------------------------! 253 ! --- temperature update --- ! 254 !---------------------------------! 255 CALL lim_thd_temp( 1, nbpb ) 256 257 !------------------------------------! 258 ! --- lateral melting if monocat --- ! 259 !------------------------------------! 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 --- ! 260 240 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 261 241 CALL lim_thd_lam( 1, nbpb ) 262 242 END IF 263 264 !-------------------------! 265 ! --- Move to 2D arrays --- 266 !-------------------------! 267 CALL lim_thd_1d2d( nbpb, jl, 2 ) 268 269 ! 270 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 ?? 271 247 ENDIF 272 248 ! … … 410 386 ENDIF 411 387 ! 412 IF( nn_timing == 1 ) CALL timing_stop('limthd')413 388 IF( nn_timing == 1 ) CALL timing_stop('limthd') 389 ! 414 390 END SUBROUTINE lim_thd 415 391 … … 424 400 !!------------------------------------------------------------------- 425 401 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 426 ! !402 ! 427 403 INTEGER :: ji, jk ! dummy loop indices 428 404 REAL(wp) :: ztmelts, zaaa, zbbb, zccc, zdiscrim ! local scalar … … 444 420 END DO 445 421 END DO 446 422 ! 447 423 END SUBROUTINE lim_thd_temp 424 448 425 449 426 SUBROUTINE lim_thd_lam( kideb, kiut ) … … 455 432 !!----------------------------------------------------------------------- 456 433 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 457 INTEGER :: ji ! dummy loop indices 458 REAL(wp) :: zhi_bef ! ice thickness before thermo 459 REAL(wp) :: zdh_mel, zda_mel ! net melting 460 REAL(wp) :: zvi, zvs ! ice/snow volumes 461 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 ! 462 441 DO ji = kideb, kiut 463 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )442 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) ) 464 443 IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN 465 444 zvi = a_i_1d(ji) * ht_i_1d(ji) … … 477 456 END IF 478 457 END DO 479 458 ! 480 459 END SUBROUTINE lim_thd_lam 460 481 461 482 462 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) … … 486 466 !! ** Purpose : move arrays from 1d to 2d and the reverse 487 467 !!----------------------------------------------------------------------- 488 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 489 ! 2= from 1D to 2D 468 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 490 469 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 491 470 INTEGER, INTENT(in) :: jl ! ice cat 471 ! 492 472 INTEGER :: jk ! dummy loop indices 493 473 !!----------------------------------------------------------------------- 474 ! 494 475 SELECT CASE( kn ) 495 496 CASE( 1 ) 497 476 ! 477 CASE( 1 ) ! from 2D to 1D 478 ! 498 479 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 499 480 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 500 481 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 501 482 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 502 483 ! 503 484 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 504 485 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 512 493 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 513 494 END DO 514 495 ! 515 496 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 497 CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 516 498 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 517 499 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) … … 526 508 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 527 509 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 528 510 ! 529 511 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 530 512 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 531 513 ! 532 514 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 533 515 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) … … 536 518 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 537 519 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 538 520 ! 539 521 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 540 522 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) … … 543 525 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 544 526 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 545 527 CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub , jpi, jpj,npb(1:nbpb) ) 528 ! 546 529 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 547 530 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) … … 557 540 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 558 541 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 559 560 CASE( 2 ) 561 542 ! 543 CASE( 2 ) ! from 1D to 2D 544 ! 562 545 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 563 546 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) … … 576 559 END DO 577 560 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 578 561 ! 579 562 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 580 563 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 581 564 ! 582 565 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 583 566 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) … … 586 569 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 587 570 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 588 571 ! 589 572 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 590 573 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) … … 593 576 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 594 577 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 595 578 CALL tab_1d_2d( nbpb, sfx_sub , npb, sfx_sub_1d(1:nbpb) , jpi, jpj ) 579 ! 596 580 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 597 581 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) … … 612 596 ! 613 597 END SELECT 614 598 ! 615 599 END SUBROUTINE lim_thd_1d2d 616 600 … … 629 613 !!------------------------------------------------------------------- 630 614 INTEGER :: ios ! Local integer output status for namelist read 631 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 632 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 615 !! 616 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 617 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 633 618 & nn_monocat, ln_it_qnsice 634 619 !!-------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
