- Timestamp:
- 2015-07-23T18:05:51+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5500 r5630 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE oce , ONLY : fraqsr_1lev25 24 USE ice ! LIM: sea-ice variables 26 25 USE sbc_oce ! Surface boundary condition: ocean fields … … 28 27 USE thd_ice ! LIM thermodynamic sea-ice variables 29 28 USE dom_ice ! LIM sea-ice domain 30 USE domvvl ! domain: variable volume level31 29 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 32 30 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation … … 50 48 PRIVATE 51 49 52 PUBLIC lim_thd ! called by limstp module53 PUBLIC lim_thd_init ! called by sbc_lim_init50 PUBLIC lim_thd ! called by limstp module 51 PUBLIC lim_thd_init ! called by sbc_lim_init 54 52 55 53 !! * Substitutions … … 92 90 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 93 91 ! 94 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns95 92 !!------------------------------------------------------------------- 96 CALL wrk_alloc( jpi,jpj, zqsr, zqns )97 93 98 94 IF( nn_timing == 1 ) CALL timing_start('limthd') … … 136 132 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! 137 133 !-----------------------------------------------------------------------------! 138 139 !--- Ocean solar and non solar fluxes to be used in zqld140 IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean141 !142 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:)143 !144 ELSE ! --- coupled case, fluxes to the lead are total - intercepted145 !146 zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:)147 !148 DO jl = 1, jpl149 DO jj = 1, jpj150 DO ji = 1, jpi151 zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl)152 zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl)153 END DO154 END DO155 END DO156 !157 ENDIF158 159 134 DO jj = 1, jpj 160 135 DO ji = 1, jpi … … 167 142 ! ! temperature and turbulent mixing (McPhee, 1992) 168 143 ! 169 170 144 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 171 ! REMARK valid at least in forced mode from clem 172 ! precip is included in qns but not in qns_ice 173 IF ( lk_cpl ) THEN 174 zqld = tmask(ji,jj,1) * rdt_ice * & 175 & ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode 176 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 177 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 178 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 179 ELSE 180 zqld = tmask(ji,jj,1) * rdt_ice * & 181 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 182 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 183 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 184 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 185 ENDIF 145 zqld = tmask(ji,jj,1) * rdt_ice * & 146 & ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 186 147 187 148 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! … … 210 171 ! Net heat flux on top of ice-ocean [W.m-2] 211 172 ! ----------------------------------------- 212 ! heat flux at the ocean surface + precip 213 ! + heat flux at the ice surface 214 hfx_in(ji,jj) = hfx_in(ji,jj) & 215 ! heat flux above the ocean 216 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 217 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 218 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 219 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 220 ! heat flux above the ice 221 & + SUM( a_i_b(ji,jj,:) * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 173 hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 222 174 223 175 ! ----------------------------------------------------------------------------- 224 ! Net heat flux that is retroceded to the ocean or taken from the ocean[W.m-2]176 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 225 177 ! ----------------------------------------------------------------------------- 226 178 ! First step here : non solar + precip - qlead - qturb 227 179 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 228 180 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 229 hfx_out(ji,jj) = hfx_out(ji,jj) & 230 ! Non solar heat flux received by the ocean 231 & + pfrld(ji,jj) * zqns(ji,jj) & 232 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 233 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 234 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 235 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 236 ! heat flux taken from the ocean where there is open water ice formation 237 & - qlead(ji,jj) * r1_rdtice & 238 ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 239 & - at_i(ji,jj) * fhtur(ji,jj) & 240 & - at_i(ji,jj) * fhld(ji,jj) 241 181 hfx_out(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) & ! Non solar heat flux received by the ocean 182 & - qlead(ji,jj) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation 183 & - at_i(ji,jj) * fhtur(ji,jj) & ! heat flux taken by turbulence 184 & - at_i(ji,jj) * fhld(ji,jj) ! heat flux taken during bottom growth/melt 185 ! (fhld should be 0 while bott growth) 242 186 END DO 243 187 END DO … … 412 356 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 413 357 414 CALL wrk_dealloc( jpi,jpj, zqsr, zqns )415 416 358 !------------------------------------------------------------------------------| 417 359 ! 6) Transport of ice between thickness categories. | … … 472 414 END SUBROUTINE lim_thd 473 415 416 474 417 SUBROUTINE lim_thd_temp( kideb, kiut ) 475 418 !!----------------------------------------------------------------------- … … 570 513 END DO 571 514 572 CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:), jpi, jpj, npb(1:nbpb) )515 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 573 516 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 574 517 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) … … 576 519 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 577 520 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 578 IF( .NOT. lk_cpl ) THEN 579 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 580 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 581 ENDIF 521 CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 582 522 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 583 523 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) … … 670 610 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 671 611 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 672 612 ! 673 613 END SELECT 674 614
Note: See TracChangeset
for help on using the changeset viewer.