Changeset 5313 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
- Timestamp:
- 2015-05-29T11:46:03+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5312 r5313 24 24 USE oce , ONLY : fraqsr_1lev 25 25 USE ice ! LIM: sea-ice variables 26 USE par_ice ! LIM: sea-ice parameters27 26 USE sbc_oce ! Surface boundary condition: ocean fields 28 27 USE sbc_ice ! Surface boundary condition: ice fields … … 34 33 USE limthd_sal ! LIM: thermodynamics, ice salinity 35 34 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 35 USE limthd_lac ! LIM-3 lateral accretion 36 USE limitd_th ! remapping thickness distribution 36 37 USE limtab ! LIM: 1D <==> 2D transformation 37 38 USE limvar ! LIM: sea-ice variables … … 44 45 USE timing ! Timing 45 46 USE limcons ! conservation tests 47 USE limctl 46 48 47 49 IMPLICIT NONE … … 49 51 50 52 PUBLIC lim_thd ! called by limstp module 51 PUBLIC lim_thd_init ! called by iceini module53 PUBLIC lim_thd_init ! called by sbc_lim_init 52 54 53 55 !! * Substitutions … … 80 82 !! ** References : 81 83 !!--------------------------------------------------------------------- 82 INTEGER, INTENT(in) :: 84 INTEGER, INTENT(in) :: kt ! number of iteration 83 85 !! 84 86 INTEGER :: ji, jj, jk, jl ! dummy loop indices 85 INTEGER :: nbpb ! nb of icy pts for thermo. cal.87 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 86 88 INTEGER :: ii, ij ! temporary dummy loop index 87 REAL(wp) :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)88 REAL(wp) :: zch = 0.0057_wp ! heat transfer coefficient89 REAL(wp) :: zareamin90 89 REAL(wp) :: zfric_u, zqld, zqfr 91 !92 90 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 91 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 92 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 93 93 ! 94 94 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 95 !!------------------------------------------------------------------- 96 CALL wrk_alloc( jpi, 96 CALL wrk_alloc( jpi,jpj, zqsr, zqns ) 97 97 98 98 IF( nn_timing == 1 ) CALL timing_start('limthd') … … 101 101 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 102 102 103 CALL lim_var_glo2eqv 103 104 !------------------------------------------------------------------------! 104 105 ! 1) Initialization of some variables ! … … 106 107 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 107 108 108 109 109 !-------------------- 110 110 ! 1.2) Heat content 111 111 !-------------------- 112 ! Change the units of heat content; from global units to J.m3112 ! Change the units of heat content; from J/m2 to J/m3 113 113 DO jl = 1, jpl 114 114 DO jk = 1, nlay_i … … 116 116 DO ji = 1, jpi 117 117 !0 if no ice and 1 if yes 118 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )118 rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 ) ) 119 119 !Energy of melting q(S,T) [J.m-3] 120 e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 121 !convert units ! very important that this line is here 122 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 120 e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i ) 123 121 END DO 124 122 END DO … … 128 126 DO ji = 1, jpi 129 127 !0 if no ice and 1 if yes 130 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 ) )128 rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) ) 131 129 !Energy of melting q(S,T) [J.m-3] 132 e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 133 !convert units ! very important that this line is here 134 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 130 e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s ) 135 131 END DO 136 132 END DO … … 161 157 ENDIF 162 158 163 !CDIR NOVERRCHK164 159 DO jj = 1, jpj 165 !CDIR NOVERRCHK166 160 DO ji = 1, jpi 167 rswitch = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 )) ) ! 0 if no ice161 rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 168 162 ! 169 163 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget … … 178 172 ! precip is included in qns but not in qns_ice 179 173 IF ( lk_cpl ) THEN 180 zqld = tm s(ji,jj) * rdt_ice * &174 zqld = tmask(ji,jj,1) * rdt_ice * & 181 175 & ( 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 precip183 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &184 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t) )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 ) ) 185 179 ELSE 186 zqld = tm s(ji,jj) * rdt_ice * &180 zqld = tmask(ji,jj,1) * rdt_ice * & 187 181 & ( 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 precip189 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &190 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t) )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 ) ) 191 185 ENDIF 192 186 193 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 194 zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 187 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 188 zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 189 190 ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 191 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 192 fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 193 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 194 ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 195 ! the freezing point, so that we do not have SST < T_freeze 196 ! This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 195 197 196 198 !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 197 qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )199 qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 198 200 199 201 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 200 IF( at_i(ji,jj) > epsi10 .AND.zqld > 0._wp ) THEN201 fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90202 IF( zqld > 0._wp ) THEN 203 fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 202 204 qlead(ji,jj) = 0._wp 203 205 ELSE … … 205 207 ENDIF 206 208 ! 207 !-- Energy from the turbulent oceanic heat flux --- !208 !clem zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )209 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )210 fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2211 ! upper bound for fhtur: we do not want SST to drop below Tfreeze.212 ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)213 ! This is not a clean budget, so that should be corrected at some point214 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )215 216 209 ! ----------------------------------------- 217 210 ! Net heat flux on top of ice-ocean [W.m-2] 218 211 ! ----------------------------------------- 219 ! First step here :heat flux at the ocean surface + precip220 ! Second step below : heat flux at the ice surface (after limthd_dif)212 ! heat flux at the ocean surface + precip 213 ! + heat flux at the ice surface 221 214 hfx_in(ji,jj) = hfx_in(ji,jj) & 222 215 ! heat flux above the ocean 223 216 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 224 217 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 225 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 226 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 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,:) ) ) 227 222 228 223 ! ----------------------------------------------------------------------------- … … 234 229 hfx_out(ji,jj) = hfx_out(ji,jj) & 235 230 ! Non solar heat flux received by the ocean 236 & + pfrld(ji,jj) * qns(ji,jj) &231 & + pfrld(ji,jj) * zqns(ji,jj) & 237 232 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 238 & + ( pfrld(ji,jj)** betas - pfrld(ji,jj) ) * sprecip(ji,jj) &239 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &240 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t) &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 ) & 241 236 ! heat flux taken from the ocean where there is open water ice formation 242 237 & - qlead(ji,jj) * r1_rdtice & … … 259 254 ENDIF 260 255 261 zareamin = epsi10262 256 nbpb = 0 263 257 DO jj = 1, jpj 264 258 DO ji = 1, jpi 265 IF ( a_i(ji,jj,jl) .gt. zareamin) THEN259 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 266 260 nbpb = nbpb + 1 267 261 npb(nbpb) = (jj - 1) * jpi + ji … … 272 266 ! debug point to follow 273 267 jiindex_1d = 0 274 IF( ln_ nicep) THEN275 DO ji = mi0( jiindx), mi1(jiindx)276 DO jj = mj0(j jindx), mj1(jjindx)268 IF( ln_icectl ) THEN 269 DO ji = mi0(iiceprt), mi1(iiceprt) 270 DO jj = mj0(jiceprt), mj1(jiceprt) 277 271 jiindex_1d = (jj - 1) * jpi + ji 278 272 WRITE(numout,*) ' lim_thd : Category no : ', jl … … 289 283 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 290 284 291 !------------------------- 292 ! 4.1 Move to 1D arrays 293 !------------------------- 294 295 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 296 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 297 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 298 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 299 300 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 301 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 302 DO jk = 1, nlay_s 303 CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 304 CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 305 END DO 306 DO jk = 1, nlay_i 307 CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 308 CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 309 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 310 END DO 311 312 CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 313 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 314 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 315 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 316 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 317 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 318 IF( .NOT. lk_cpl ) THEN 319 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 320 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 321 ENDIF 322 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 323 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 324 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 325 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 326 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 327 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 328 329 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 330 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 331 332 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 333 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 334 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 335 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 336 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 337 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 338 339 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 340 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 341 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 342 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 343 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 344 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 345 346 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 347 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 348 CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) ) 349 CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) ) 350 CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) ) 351 CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) ) 352 CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) ) 353 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 354 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 355 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 356 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 357 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 358 359 !-------------------------------- 360 ! 4.3) Thermodynamic processes 361 !-------------------------------- 285 !-------------------------! 286 ! --- Move to 1D arrays --- 287 !-------------------------! 288 CALL lim_thd_1d2d( nbpb, jl, 1 ) 289 290 !--------------------------------------! 291 ! --- Ice/Snow Temperature profile --- ! 292 !--------------------------------------! 293 CALL lim_thd_dif( 1, nbpb ) 362 294 363 295 !---------------------------------! 364 ! Ice/Snow Temperature profile ! 365 !---------------------------------! 366 CALL lim_thd_dif( 1, nbpb ) 367 368 !---------------------------------! 369 ! Ice/Snow thicnkess ! 296 ! --- Ice/Snow thickness --- ! 370 297 !---------------------------------! 371 298 CALL lim_thd_dh( 1, nbpb ) … … 375 302 376 303 !---------------------------------! 377 ! --- Ice salinity --- !304 ! --- Ice salinity --- ! 378 305 !---------------------------------! 379 306 CALL lim_thd_sal( 1, nbpb ) 380 307 381 308 !---------------------------------! 382 ! --- temperature update --- !309 ! --- temperature update --- ! 383 310 !---------------------------------! 384 311 CALL lim_thd_temp( 1, nbpb ) 385 312 386 !-------------------------------- 387 ! 4.4) Move 1D to 2D vectors 388 !-------------------------------- 389 390 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 391 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) 392 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj ) 393 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj ) 394 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj ) 395 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj ) 396 DO jk = 1, nlay_s 397 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj) 398 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj) 399 END DO 400 DO jk = 1, nlay_i 401 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj) 402 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj) 403 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj) 404 END DO 405 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 406 407 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 408 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 409 410 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 411 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 412 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 413 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 414 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 415 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 416 417 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 418 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 419 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 420 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 421 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 422 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 423 424 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 425 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 426 CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj ) 427 CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj ) 428 CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj ) 429 CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj ) 430 CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj ) 431 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 432 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 433 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 434 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 435 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb) , jpi, jpj ) 436 ! 437 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 438 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 313 !------------------------------------! 314 ! --- lateral melting if monocat --- ! 315 !------------------------------------! 316 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 317 CALL lim_thd_lam( 1, nbpb ) 318 END IF 319 320 !-------------------------! 321 ! --- Move to 2D arrays --- 322 !-------------------------! 323 CALL lim_thd_1d2d( nbpb, jl, 2 ) 324 439 325 ! 440 326 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 441 327 ENDIF 442 328 ! 443 END DO 329 END DO !jl 444 330 445 331 !------------------------------------------------------------------------------! … … 448 334 449 335 !------------------------ 450 ! 5.1)Ice heat content336 ! Ice heat content 451 337 !------------------------ 452 ! Enthalpies are global variables we have to readjust the units (heat content in J oules)338 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 453 339 DO jl = 1, jpl 454 340 DO jk = 1, nlay_i 455 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a rea(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) )341 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 456 342 END DO 457 343 END DO 458 344 459 345 !------------------------ 460 ! 5.2)Snow heat content346 ! Snow heat content 461 347 !------------------------ 462 ! Enthalpies are global variables we have to readjust the units (heat content in J oules)348 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 463 349 DO jl = 1, jpl 464 350 DO jk = 1, nlay_s 465 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a rea(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) )351 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 466 352 END DO 467 353 END DO 468 354 469 355 !---------------------------------- 470 ! 5.3)Change thickness to volume356 ! Change thickness to volume 471 357 !---------------------------------- 472 CALL lim_var_eqv2glo 358 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 359 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 360 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 361 362 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 363 DO jl = 1, jpl 364 DO jj = 1, jpj 365 DO ji = 1, jpi 366 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) ) 367 oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) 368 END DO 369 END DO 370 END DO 371 372 CALL lim_var_zapsmall 473 373 474 374 !-------------------------------------------- 475 ! 5.4)Diagnostic thermodynamic growth rates375 ! Diagnostic thermodynamic growth rates 476 376 !-------------------------------------------- 377 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print 378 477 379 IF(ln_ctl) THEN ! Control print 478 380 CALL prt_ctl_info(' ') 479 381 CALL prt_ctl_info(' - Cell values : ') 480 382 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 481 CALL prt_ctl(tab2d_1= area, clinfo1=' lim_thd : cell area :')383 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd : cell area :') 482 384 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd : at_i :') 483 385 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd : vt_i :') … … 508 410 ! 509 411 ! 510 CALL wrk_dealloc( jpi, jpj, zqsr, zqns )511 512 !513 ! conservation test514 412 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 413 414 CALL wrk_dealloc( jpi,jpj, zqsr, zqns ) 415 416 !------------------------------------------------------------------------------| 417 ! 6) Transport of ice between thickness categories. | 418 !------------------------------------------------------------------------------| 419 ! Given thermodynamic growth rates, transport ice between thickness categories. 420 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 421 422 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 423 424 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 425 426 !------------------------------------------------------------------------------| 427 ! 7) Add frazil ice growing in leads. 428 !------------------------------------------------------------------------------| 429 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 430 431 CALL lim_thd_lac 432 433 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 434 435 ! Control print 436 IF(ln_ctl) THEN 437 CALL lim_var_glo2eqv 438 439 CALL prt_ctl_info(' ') 440 CALL prt_ctl_info(' - Cell values : ') 441 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 442 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th : cell area :') 443 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :') 444 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :') 445 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :') 446 DO jl = 1, jpl 447 CALL prt_ctl_info(' ') 448 CALL prt_ctl_info(' - Category : ', ivar1=jl) 449 CALL prt_ctl_info(' ~~~~~~~~~~') 450 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ') 451 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ') 452 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ') 453 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ') 454 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ') 455 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ') 456 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ') 457 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ') 458 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 459 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 460 DO jk = 1, nlay_i 461 CALL prt_ctl_info(' ') 462 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 463 CALL prt_ctl_info(' ~~~~~~~') 464 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 465 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 466 END DO 467 END DO 468 ENDIF 515 469 ! 516 470 IF( nn_timing == 1 ) CALL timing_stop('limthd') … … 534 488 DO jk = 1, nlay_i 535 489 DO ji = kideb, kiut 536 ztmelts = -tmut * s_i_1d(ji,jk) + rt t490 ztmelts = -tmut * s_i_1d(ji,jk) + rt0 537 491 ! Conversion q(S,T) -> T (second order equation) 538 492 zaaa = cpic 539 zbbb = ( rcp - cpic ) * ( ztmelts - rt t ) + q_i_1d(ji,jk) /rhoic - lfus540 zccc = lfus * ( ztmelts - rt t)493 zbbb = ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus 494 zccc = lfus * ( ztmelts - rt0 ) 541 495 zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 542 t_i_1d(ji,jk) = rt t- ( zbbb + zdiscrim ) / ( 2._wp * zaaa )496 t_i_1d(ji,jk) = rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 543 497 544 498 ! mask temperature 545 499 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 546 t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt t500 t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 547 501 END DO 548 502 END DO 549 503 550 504 END SUBROUTINE lim_thd_temp 505 506 SUBROUTINE lim_thd_lam( kideb, kiut ) 507 !!----------------------------------------------------------------------- 508 !! *** ROUTINE lim_thd_lam *** 509 !! 510 !! ** Purpose : Lateral melting in case monocategory 511 !! ( dA = A/2h dh ) 512 !!----------------------------------------------------------------------- 513 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 514 INTEGER :: ji ! dummy loop indices 515 REAL(wp) :: zhi_bef ! ice thickness before thermo 516 REAL(wp) :: zdh_mel, zda_mel ! net melting 517 REAL(wp) :: zvi, zvs ! ice/snow volumes 518 519 DO ji = kideb, kiut 520 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 521 IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN 522 zvi = a_i_1d(ji) * ht_i_1d(ji) 523 zvs = a_i_1d(ji) * ht_s_1d(ji) 524 ! lateral melting = concentration change 525 zhi_bef = ht_i_1d(ji) - zdh_mel 526 rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 527 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 528 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 529 ! adjust thickness 530 ht_i_1d(ji) = zvi / a_i_1d(ji) 531 ht_s_1d(ji) = zvs / a_i_1d(ji) 532 ! retrieve total concentration 533 at_i_1d(ji) = a_i_1d(ji) 534 END IF 535 END DO 536 537 END SUBROUTINE lim_thd_lam 538 539 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 540 !!----------------------------------------------------------------------- 541 !! *** ROUTINE lim_thd_1d2d *** 542 !! 543 !! ** Purpose : move arrays from 1d to 2d and the reverse 544 !!----------------------------------------------------------------------- 545 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 546 ! 2= from 1D to 2D 547 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 548 INTEGER, INTENT(in) :: jl ! ice cat 549 INTEGER :: jk ! dummy loop indices 550 551 SELECT CASE( kn ) 552 553 CASE( 1 ) 554 555 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 556 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 557 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 558 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 559 560 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 561 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 562 DO jk = 1, nlay_s 563 CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 564 CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 565 END DO 566 DO jk = 1, nlay_i 567 CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 568 CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 569 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 570 END DO 571 572 CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 573 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 574 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 575 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 576 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 577 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 582 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 583 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 584 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 585 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 586 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 587 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 588 589 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 590 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 591 592 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 593 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 594 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 595 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 596 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 597 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 598 599 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 600 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 601 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 602 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 603 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 604 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 605 606 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 607 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 608 CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) ) 609 CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) ) 610 CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) ) 611 CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) ) 612 CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) ) 613 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 614 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 615 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 616 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 617 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 618 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 619 620 CASE( 2 ) 621 622 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 623 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) 624 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj ) 625 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj ) 626 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj ) 627 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj ) 628 DO jk = 1, nlay_s 629 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj) 630 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj) 631 END DO 632 DO jk = 1, nlay_i 633 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj) 634 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj) 635 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj) 636 END DO 637 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 638 639 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 640 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 641 642 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 643 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 644 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 645 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 646 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 647 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 648 649 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 650 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 651 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 652 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 653 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 654 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 655 656 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 657 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 658 CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj ) 659 CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj ) 660 CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj ) 661 CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj ) 662 CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj ) 663 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 664 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 665 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 666 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 667 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 668 CALL tab_1d_2d( nbpb, hfx_err_dif , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj ) 669 ! 670 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 671 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 672 673 END SELECT 674 675 END SUBROUTINE lim_thd_1d2d 676 551 677 552 678 SUBROUTINE lim_thd_init … … 563 689 !!------------------------------------------------------------------- 564 690 INTEGER :: ios ! Local integer output status for namelist read 565 NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,&566 & hiclim, hnzst, parsub, betas, &567 & kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi691 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 692 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 693 & nn_monocat, ln_it_qnsice 568 694 !!------------------------------------------------------------------- 569 695 ! … … 582 708 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 583 709 IF(lwm) WRITE ( numoni, namicethd ) 584 585 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 710 ! 711 IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN 712 nn_monocat = 0 713 IF(lwp) WRITE(numout, *) ' nn_monocat must be 0 in multi-category case ' 714 ENDIF 715 586 716 ! 587 717 IF(lwp) THEN ! control print 588 718 WRITE(numout,*) 589 719 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 590 WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt 591 WRITE(numout,*)' ice thick. for lateral accretion hiccrit = ', hiccrit 592 WRITE(numout,*)' Frazil ice thickness as a function of wind or not fraz_swi = ', fraz_swi 593 WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom maxfrazb = ', maxfrazb 594 WRITE(numout,*)' Thresold relative drift speed for collection of frazil vfrazb = ', vfrazb 595 WRITE(numout,*)' Squeezing coefficient for collection of frazil Cfrazb = ', Cfrazb 596 WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim 720 WRITE(numout,*)' ice thick. for lateral accretion rn_hnewice = ', rn_hnewice 721 WRITE(numout,*)' Frazil ice thickness as a function of wind or not ln_frazil = ', ln_frazil 722 WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom rn_maxfrazb = ', rn_maxfrazb 723 WRITE(numout,*)' Thresold relative drift speed for collection of frazil rn_vfrazb = ', rn_vfrazb 724 WRITE(numout,*)' Squeezing coefficient for collection of frazil rn_Cfrazb = ', rn_Cfrazb 725 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 597 726 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 598 WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst 599 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub 600 WRITE(numout,*)' coefficient for ice-lead partition of snowfall betas = ', betas 601 WRITE(numout,*)' extinction radiation parameter in sea ice (1.0) kappa_i = ', kappa_i 602 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nconv_i_thd = ', nconv_i_thd 603 WRITE(numout,*)' maximal err. on T for heat diffusion computation maxer_i_thd = ', maxer_i_thd 604 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice thcon_i_swi = ', thcon_i_swi 727 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 728 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 729 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif 730 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif 731 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon 605 732 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 733 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 734 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice 606 735 ENDIF 607 736 !
Note: See TracChangeset
for help on using the changeset viewer.
