- Timestamp:
- 2014-12-01T11:11:43+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4872 r4933 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE oce , ONLY : iatte, oatte24 USE oce , ONLY : fraqsr_1lev 25 25 USE ice ! LIM: sea-ice variables 26 26 USE par_ice ! LIM: sea-ice parameters … … 43 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 44 USE timing ! Timing 45 USE cpl_oasis3, ONLY : lk_cpl46 45 USE limcons ! conservation tests 47 46 … … 68 67 !! *** ROUTINE lim_thd *** 69 68 !! 70 !! ** Purpose : This routine manages the ice thermodynamic.69 !! ** Purpose : This routine manages ice thermodynamics 71 70 !! 72 71 !! ** Action : - Initialisation of some variables … … 74 73 !! at the ice base, snow acc.,heat budget of the leads) 75 74 !! - selection of the icy points and put them in an array 76 !! - call lim_vert_ther for vert ice thermodynamic 77 !! - back to the geographic grid 78 !! - selection of points for lateral accretion 79 !! - call lim_lat_acc for the ice accretion 75 !! - call lim_thd_dif for vertical heat diffusion 76 !! - call lim_thd_dh for vertical ice growth and melt 77 !! - call lim_thd_ent for enthalpy remapping 78 !! - call lim_thd_sal for ice desalination 79 !! - call lim_thd_temp to retrieve temperature from ice enthalpy 80 80 !! - back to the geographic grid 81 81 !! 82 !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-9082 !! ** References : 83 83 !!--------------------------------------------------------------------- 84 84 INTEGER, INTENT(in) :: kt ! number of iteration … … 93 93 ! 94 94 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 95 ! 96 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 97 !!------------------------------------------------------------------- 98 CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 99 96 100 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 101 … … 137 141 !-----------------------------------------------------------------------------! 138 142 143 !--- Ocean solar and non solar fluxes to be used in zqld 144 IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean 145 ! 146 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:) 147 ! 148 ELSE ! --- coupled case, fluxes to the lead are total - intercepted 149 ! 150 zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:) 151 ! 152 DO jl = 1, jpl 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 156 zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 157 END DO 158 END DO 159 END DO 160 ! 161 ENDIF 162 139 163 !CDIR NOVERRCHK 140 164 DO jj = 1, jpj … … 149 173 ! ! temperature and turbulent mixing (McPhee, 1992) 150 174 ! 175 151 176 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 152 zqld = tms(ji,jj) * rdt_ice * & 153 & ( pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 154 & + qns(ji,jj) ) & ! non solar heat 155 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 156 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 157 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 158 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) & 159 & * rcp * ( tatm_ice(ji,jj) - rtt ) ) 177 ! REMARK valid at least in forced mode from clem 178 ! precip is included in qns but not in qns_ice 179 IF ( lk_cpl ) THEN 180 zqld = tms(ji,jj) * rdt_ice * & 181 & ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode 182 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 183 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 184 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 185 ELSE 186 zqld = tms(ji,jj) * rdt_ice * & 187 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 188 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 189 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 190 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 191 ENDIF 160 192 161 193 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! … … 187 219 hfx_in(ji,jj) = hfx_in(ji,jj) & 188 220 ! heat flux above the ocean 189 & + pfrld(ji,jj) * ( qns(ji,jj) + qsr(ji,jj) )&221 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 190 222 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 191 223 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & … … 198 230 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 199 231 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 200 hfx_out(ji,jj) = hfx_out(ji,jj) &232 hfx_out(ji,jj) = hfx_out(ji,jj) & 201 233 ! Non solar heat flux received by the ocean 202 & + pfrld(ji,jj) * qns(ji,jj) &234 & + pfrld(ji,jj) * qns(ji,jj) & 203 235 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 204 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) 205 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )&206 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) &236 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 237 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 238 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) & 207 239 ! heat flux taken from the ocean where there is open water ice formation 208 & - qlead(ji,jj) * r1_rdtice &240 & - qlead(ji,jj) * r1_rdtice & 209 241 ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 210 & - at_i(ji,jj) * fhtur(ji,jj) &242 & - at_i(ji,jj) * fhtur(ji,jj) & 211 243 & - at_i(ji,jj) * fhld(ji,jj) 212 244 … … 309 341 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 310 342 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 311 312 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) )313 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) )314 343 315 344 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) … … 485 514 ENDIF 486 515 ! 516 ! 517 CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 518 519 ! 487 520 ! conservation test 488 521 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 489 522 ! 490 523 IF( nn_timing == 1 ) CALL timing_stop('limthd') 524 491 525 END SUBROUTINE lim_thd 492 526 … … 555 589 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 556 590 IF(lwm) WRITE ( numoni, namicethd ) 591 592 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 557 593 ! 558 594 IF(lwp) THEN ! control print
Note: See TracChangeset
for help on using the changeset viewer.
