Changeset 8326 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
- Timestamp:
- 2017-07-12T17:52:17+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 4 edited
-
limthd.F90 (modified) (6 diffs)
-
limthd_dh.F90 (modified) (8 diffs)
-
limthd_sal.F90 (modified) (3 diffs)
-
thd_ice.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r8325 r8326 23 23 USE dom_oce ! ocean space and time domain variables 24 24 USE ice ! sea-ice variables 25 USE sbc_oce , ONLY : ss t_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl25 USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl 26 26 USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, & 27 27 & fr1_i0, fr2_i0, nn_limflx … … 55 55 # include "vectopt_loop_substitute.h90" 56 56 !!---------------------------------------------------------------------- 57 !! NEMO/LIM3 3.3, UCL - NEMO Consortium (2010)57 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 58 58 !! $Id$ 59 59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 458 458 CALL tab_2d_1d( nbpb, wfx_snw_sub_1d(1:nbpb), wfx_snw_sub , jpi, jpj, npb(1:nbpb) ) 459 459 CALL tab_2d_1d( nbpb, wfx_ice_sub_1d(1:nbpb), wfx_ice_sub , jpi, jpj, npb(1:nbpb) ) 460 CALL tab_2d_1d( nbpb, wfx_err_sub_1d(1:nbpb), wfx_err_sub , jpi, jpj, npb(1:nbpb) ) 460 461 ! 461 462 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) … … 487 488 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 488 489 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 490 CALL tab_2d_1d( nbpb, hfx_out_1d (1:nbpb), hfx_out , jpi, jpj, npb(1:nbpb) ) 489 491 ! 490 492 ! SIMIP diagnostics 491 493 CALL tab_2d_1d( nbpb, diag_fc_bo_1d (1:nbpb), diag_fc_bo , jpi, jpj, npb(1:nbpb) ) 492 494 CALL tab_2d_1d( nbpb, diag_fc_su_1d (1:nbpb), diag_fc_su , jpi, jpj, npb(1:nbpb) ) 495 ! ocean surface fields 496 CALL tab_2d_1d( nbpb, sst_1d(1:nbpb), sst_m, jpi, jpj, npb(1:nbpb) ) 497 CALL tab_2d_1d( nbpb, sss_1d(1:nbpb), sss_m, jpi, jpj, npb(1:nbpb) ) 493 498 ! 494 499 CASE( 2 ) ! from 1D to 2D … … 516 521 CALL tab_1d_2d( nbpb, wfx_snw_sub , npb, wfx_snw_sub_1d(1:nbpb), jpi, jpj ) 517 522 CALL tab_1d_2d( nbpb, wfx_ice_sub , npb, wfx_ice_sub_1d(1:nbpb), jpi, jpj ) 523 CALL tab_1d_2d( nbpb, wfx_err_sub , npb, wfx_err_sub_1d(1:nbpb), jpi, jpj ) 518 524 ! 519 525 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) … … 545 551 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 546 552 CALL tab_1d_2d( nbpb, hfx_err_dif , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj ) 553 CALL tab_1d_2d( nbpb, hfx_out , npb, hfx_out_1d(1:nbpb) , jpi, jpj ) 547 554 ! 548 555 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r8325 r8326 18 18 USE par_oce ! ocean parameters 19 19 USE phycst ! physical constants (OCE directory) 20 USE sbc_oce , ONLY : sst_m, sss_m21 20 USE ice ! LIM variables 22 21 USE thd_ice ! LIM thermodynamics … … 70 69 !! 71 70 INTEGER :: ji , jk ! dummy loop indices 72 INTEGER :: ii, ij ! 2D corresponding indices to ji73 71 INTEGER :: iter 74 72 … … 87 85 REAL(wp) :: zdE ! specific enthalpy difference (J/kg) 88 86 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 89 REAL(wp) :: zsstK ! SST (K)90 87 91 88 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3) … … 403 400 ! remaining "potential" evap is sent to ocean 404 401 DO ji = kideb, kiut 405 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 406 wfx_err_sub(ii,ij) = wfx_err_sub(ii,ij) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice ! <=0 (net evap for the ocean in kg.m-2.s-1) 402 wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice ! <=0 (net evap for the ocean in kg.m-2.s-1) 407 403 END DO 408 404 … … 445 441 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) , 0.5 ) 446 442 447 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 448 449 s_i_new(ji) = zswitch_sal * zfracs * sss_m(ii,ij) & ! New ice salinity 443 s_i_new(ji) = zswitch_sal * zfracs * sss_1d(ji) & ! New ice salinity 450 444 + ( 1. - zswitch_sal ) * sm_i_1d(ji) 451 445 ! New ice growth … … 611 605 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 612 606 ! 613 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1614 607 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 615 hfx_out (ii,ij) = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice608 hfx_out_1d(ji) = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 616 609 617 610 IF( ln_limctl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) … … 637 630 638 631 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 639 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1640 632 zfmdt = ( rhosn - rhoic ) * dh_snowice(ji) ! <0 641 zsstK = sst_m(ii,ij) + rt0 642 zEw = rcp * ( zsstK - rt0 ) 633 zEw = rcp * sst_1d(ji) 643 634 zQm = zfmdt * zEw 644 635 … … 647 638 648 639 ! Contribution to salt flux 649 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_ m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice640 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_rdtice 650 641 651 642 ! virtual salt flux to keep salinity constant 652 643 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 653 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_ m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean644 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean 654 645 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get rn_icesal from the ocean 655 646 ENDIF -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r8321 r8326 16 16 USE par_oce ! ocean parameters 17 17 USE phycst ! physical constants (ocean directory) 18 USE sbc_oce , ONLY : sss_m19 18 USE ice ! LIM variables 20 19 USE thd_ice ! LIM thermodynamics … … 51 50 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 52 51 ! 53 INTEGER :: ii, ij, ji, jk! dummy loop indices52 INTEGER :: ji, jk ! dummy loop indices 54 53 REAL(wp) :: iflush, igravdr ! local scalars 55 54 REAL(wp) :: zs_sni, zsm_i_gd, zsm_i_fl, zsm_i_si, zsm_i_bg ! local scalars … … 68 67 DO ji = kideb, kiut 69 68 70 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 171 69 !--------------------------------------------------------- 72 70 ! Update ice salinity from snow-ice and bottom growth 73 71 !--------------------------------------------------------- 74 zs_sni = sss_ m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic ! Salinity of snow ice72 zs_sni = sss_1d(ji) * ( rhoic - rhosn ) * r1_rhoic ! Salinity of snow ice 75 73 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 76 74 zsm_i_si = ( zs_sni - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! snow-ice -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r8325 r8326 48 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d 49 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_dif_1d 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_out_1d 50 51 51 52 ! heat flux associated with ice-atmosphere mass exchange … … 62 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_sub_1d 63 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_ice_sub_1d 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_err_sub_1d 64 66 65 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bog_1d … … 121 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: diag_fc_su_1d !: <==> the 2D diag_fc_su 122 124 125 ! surface fields from the ocean 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sst_1d 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sss_1d 128 123 129 INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point 124 130 … … 135 141 !!---------------------------------------------------------------------! 136 142 INTEGER :: thd_ice_alloc ! return value 137 INTEGER :: ierr( 5), ii143 INTEGER :: ierr(6), ii 138 144 !!---------------------------------------------------------------------! 139 145 ierr(:) = 0 … … 149 155 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 150 156 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 151 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) )157 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , hfx_out_1d(jpij), STAT=ierr(ii) ) 152 158 ! 153 159 ii = ii + 1 … … 156 162 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) , & 157 163 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , & 158 & wfx_snw_sub_1d(jpij), wfx_ice_sub_1d(jpij) ,&164 & wfx_snw_sub_1d(jpij), wfx_ice_sub_1d(jpij), wfx_err_sub_1d(jpij) , & 159 165 & dqns_ice_1d(jpij) , evap_ice_1d (jpij), & 160 166 & qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0 (jpij) , & … … 177 183 ii = ii + 1 178 184 ALLOCATE( diag_fc_bo_1d(jpij) , diag_fc_su_1d(jpij) , STAT=ierr(ii) ) 185 ! 186 ii = ii + 1 187 ALLOCATE( sst_1d(jpij) , sss_1d(jpij) , STAT=ierr(ii) ) 179 188 180 189 thd_ice_alloc = MAXVAL( ierr(:) )
Note: See TracChangeset
for help on using the changeset viewer.
