Changeset 15663
- Timestamp:
- 2022-01-19T19:50:16+01:00 (2 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src
- Files:
-
- 4 edited
-
ICE/ice.F90 (modified) (3 diffs)
-
ICE/icethd_dh.F90 (modified) (1 diff)
-
OCE/SBC/sbc_ice.F90 (modified) (1 diff)
-
OCE/SBC/sbccpl.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/ICE/ice.F90
r15658 r15663 423 423 ! 424 424 !!---------------------------------------------------------------------- 425 !! * Only for atmospheric coupling 426 !!---------------------------------------------------------------------- 427 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 428 ! 429 !!---------------------------------------------------------------------- 425 430 !! NEMO/ICE 4.0 , NEMO Consortium (2018) 426 431 !! $Id$ … … 435 440 INTEGER :: ice_alloc 436 441 ! 437 INTEGER :: ierr(1 6), ii442 INTEGER :: ierr(17), ii 438 443 !!----------------------------------------------------------------- 439 444 ierr(:) = 0 … … 519 524 ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) ) 520 525 526 ! * For atmospheric coupling 527 ii = ii + 1 528 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(ii) ) 529 521 530 ice_alloc = MAXVAL( ierr(:) ) 522 531 IF( ice_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/ICE/icethd_dh.F90
r14075 r15663 251 251 END DO 252 252 253 ! Snow sublimation 254 !----------------- 255 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 253 ! Snow sublimation and deposition 254 !-------------------------------- 255 ! when evap_ice_1d > 0 (upwards) snow sublimates and snow thickness decreases 256 ! when evap_ice_1d < 0 (downwards) deposition occurs and snow thickness increases 256 257 ! comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean) 257 258 zdeltah(1:npti,:) = 0._wp 258 259 DO ji = 1, npti 259 IF( evap_ice_1d(ji) > 0._wp ) THEN 260 ! 261 zdh_s_sub (ji) = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rdt_ice ) 262 zevap_rema(ji) = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhos ! remaining evap in kg.m-2 (used for ice melting later on) 263 zdeltah (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 264 265 hfx_sub_1d (ji) = hfx_sub_1d(ji) + & ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow) 266 & ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) ) & 267 & * a_i_1d(ji) * r1_rdtice 268 wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice ! Mass flux by sublimation 269 270 ! new snow thickness 271 h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_sub(ji) ) 272 ! update precipitations after sublimation and correct sublimation 273 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 274 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 275 ! 276 ELSE 277 ! 278 zdh_s_sub (ji) = 0._wp 279 zevap_rema(ji) = 0._wp 280 ! 281 ENDIF 260 ! 261 zdh_s_sub (ji) = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rdt_ice ) 262 zevap_rema(ji) = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhos ! remaining evap in kg.m-2 (used for ice melting later on) 263 zdeltah (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 264 265 hfx_sub_1d (ji) = hfx_sub_1d(ji) + & ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow) 266 & ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) ) & 267 & * a_i_1d(ji) * r1_rdtice 268 wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice ! Mass flux by sublimation 269 270 ! new snow thickness 271 h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_sub(ji) ) 272 ! update precipitations after sublimation and correct sublimation 273 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 274 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 275 ! 282 276 END DO 283 277 -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbc_ice.F90
r14075 r15663 95 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 96 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i, h_s 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Sea ice fraction on categories at the last coupling point 97 98 98 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbccpl.F90
r15662 r15663 199 199 TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, & 200 200 sn_rcv_wdrag, sn_rcv_wfreq 201 ! Transmitted solar 202 TYPE(FLD_C) :: sn_rcv_qtr 201 203 ! ! Other namelist parameters 202 204 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 212 214 213 215 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 214 #if defined key_si3 || defined key_cice215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time216 #endif217 216 218 217 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 234 233 !! *** FUNCTION sbc_cpl_alloc *** 235 234 !!---------------------------------------------------------------------- 236 INTEGER :: ierr( 5)235 INTEGER :: ierr(4) 237 236 !!---------------------------------------------------------------------- 238 237 ierr(:) = 0 … … 244 243 #endif 245 244 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 246 #if defined key_si3 || defined key_cice 247 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 248 #endif 249 ! 250 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 245 ! 246 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 251 247 252 248 sbc_cpl_alloc = MAXVAL( ierr ) … … 281 277 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 282 278 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_tauwoc, & 279 & sn_rcv_qtr , & 283 280 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 284 281 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & … … 334 331 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' 335 332 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 333 WRITE(numout,*)' transmitted solar = ', TRIM(sn_rcv_qtr%cldes ), ' (', TRIM(sn_rcv_qtr%clcat ), ')' 336 334 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 337 335 WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' … … 637 635 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 638 636 ENDIF 637 ! ! ------------------------- ! 638 ! ! transmitted solar ! 639 ! ! ------------------------- ! 640 srcv(jpr_qtr )%clname = 'OQtr' 641 IF( TRIM(sn_rcv_qtr%cldes) == 'coupled' ) THEN 642 IF ( TRIM( sn_rcv_qtr%clcat ) == 'yes' ) THEN 643 srcv(jpr_qtr)%nct = nn_cats_cpl 644 ELSE 645 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtr%clcat should always be set to yes currently' ) 646 ENDIF 647 srcv(jpr_qtr)%laction = .TRUE. 648 ENDIF 649 639 650 ! ! ------------------------- ! 640 651 ! ! ice skin temperature ! … … 1885 1896 ziceld(:,:) = 1._wp - picefr(:,:) 1886 1897 zcptn (:,:) = rcp * sst_m(:,:) 1898 1899 #if defined key_si3 1900 ! ! ========================= ! 1901 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! 1902 ! ! ========================= ! 1903 CASE ('coupled') 1904 IF (ln_scale_ice_flux) THEN 1905 WHERE( a_i(:,:,:) > 1.e-10_wp ) 1906 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1907 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1908 ELSEWHERE 1909 qml_ice(:,:,:) = 0.0_wp 1910 qcn_ice(:,:,:) = 0.0_wp 1911 END WHERE 1912 ELSE 1913 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 1914 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 1915 ENDIF 1916 END SELECT 1917 #endif 1918 1887 1919 ! 1888 1920 ! ! ========================= ! … … 2058 2090 ! ! ========================= ! 2059 2091 CASE( 'oce only' ) ! the required field is directly provided 2060 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 2061 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 2062 ! here so the only flux is the ocean only one. 2063 zqns_ice(:,:,:) = 0._wp 2092 2093 ! Get the sea ice non solar heat flux from conductive and melting fluxes 2094 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 2095 zqns_ice(:,:,:) = qml_ice(:,:,:) + qcn_ice(:,:,:) 2096 ELSE 2097 zqns_ice(:,:,:) = 0._wp 2098 ENDIF 2099 2100 ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE 2101 ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) 2102 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) 2103 2064 2104 CASE( 'conservative' ) ! the required fields are directly provided 2065 2105 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 2126 2166 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 2127 2167 DO jl = 1, jpl 2128 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account 2168 ! zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account 2169 2170 ! How much enthalpy is stored in sublimating snow and ice. At this stage we don't know if it is snow or ice that is 2171 ! sublimating so we will use the combined snow and ice layer temperature t1_ice. 2172 zqevap_ice(:,:,jl) = -zevap_ice(:,:,jl) * ( ( rt0 - t1_ice(:,:,jl) ) * rcpi + rLfus ) 2173 2129 2174 END DO 2130 2175 … … 2201 2246 CASE( 'oce only' ) 2202 2247 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 2203 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 2204 ! here so the only flux is the ocean only one. 2248 2249 ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice 2250 ! further down. Therefore start zqsr_ice off at zero. 2205 2251 zqsr_ice(:,:,:) = 0._wp 2206 2252 CASE( 'conservative' ) … … 2256 2302 ENDIF 2257 2303 2258 #if defined key_si32259 ! --- solar flux over ocean --- !2260 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax2261 zqsr_oce = 0._wp2262 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)2263 2264 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)2265 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF2266 #endif2267 2268 IF( ln_mixcpl ) THEN2269 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2270 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)2271 DO jl = 1, jpl2272 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)2273 END DO2274 ELSE2275 qsr_tot(:,: ) = zqsr_tot(:,: )2276 qsr_ice(:,:,:) = zqsr_ice(:,:,:)2277 ENDIF2278 2279 ! ! ========================= !2280 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !2281 ! ! ========================= !2282 CASE ('coupled')2283 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN2284 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)2285 ELSE2286 ! Set all category values equal for the moment2287 DO jl=1,jpl2288 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)2289 ENDDO2290 ENDIF2291 CASE( 'none' )2292 zdqns_ice(:,:,:) = 0._wp2293 END SELECT2294 2295 IF( ln_mixcpl ) THEN2296 DO jl=1,jpl2297 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)2298 ENDDO2299 ELSE2300 dqns_ice(:,:,:) = zdqns_ice(:,:,:)2301 ENDIF2302 2303 2304 #if defined key_si3 2304 ! ! ========================= !2305 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !2306 ! ! ========================= !2307 CASE ('coupled')2308 IF (ln_scale_ice_flux) THEN2309 WHERE( a_i(:,:,:) > 1.e-10_wp )2310 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2311 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2312 ELSEWHERE2313 qml_ice(:,:,:) = 0.0_wp2314 qcn_ice(:,:,:) = 0.0_wp2315 END WHERE2316 ELSE2317 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)2318 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)2319 ENDIF2320 END SELECT2321 2305 ! ! ========================= ! 2322 2306 ! ! Transmitted Qsr ! [W/m2] … … 2350 2334 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2351 2335 ! 2352 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2353 ! for now just assume zero (fully opaque ice) 2354 zqtr_ice_top(:,:,:) = 0._wp 2336 SELECT CASE( TRIM( sn_rcv_qtr%cldes ) ) 2337 ! 2338 ! ! ===> here we receive the qtr_ice_top array from the coupler 2339 CASE ('coupled') 2340 IF (ln_scale_ice_flux) THEN 2341 WHERE( a_i(:,:,:) > 0.0_wp ) zqtr_ice_top(:,:,:) = frcv(jpr_qtr)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2342 WHERE( a_i(:,:,:) <= 0.0_wp ) zqtr_ice_top(:,:,:) = 0.0_wp 2343 ELSE 2344 zqtr_ice_top(:,:,:) = frcv(jpr_qtr)%z3(:,:,:) 2345 ENDIF 2346 2347 ! Add retrieved transmitted solar radiation onto the ice and total solar radiation 2348 zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) 2349 zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) 2350 2351 ! if we are not getting this data from the coupler then assume zero (fully opaque ice) 2352 CASE ('none') 2353 zqtr_ice_top(:,:,:) = 0._wp 2354 END SELECT 2355 2355 2356 ! 2356 2357 ENDIF … … 2363 2364 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2364 2365 ENDIF 2366 2367 ! --- solar flux over ocean --- ! 2368 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 2369 zqsr_oce = 0._wp 2370 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 2371 2372 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 2373 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 2374 #endif 2375 2376 IF( ln_mixcpl ) THEN 2377 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2378 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 2379 DO jl = 1, jpl 2380 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 2381 END DO 2382 ELSE 2383 qsr_tot(:,: ) = zqsr_tot(:,: ) 2384 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 2385 ENDIF 2386 2387 ! ! ========================= ! 2388 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 2389 ! ! ========================= ! 2390 CASE ('coupled') 2391 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2392 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2393 ELSE 2394 ! Set all category values equal for the moment 2395 DO jl=1,jpl 2396 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 2397 ENDDO 2398 ENDIF 2399 CASE( 'none' ) 2400 zdqns_ice(:,:,:) = 0._wp 2401 END SELECT 2402 2403 IF( ln_mixcpl ) THEN 2404 DO jl=1,jpl 2405 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 2406 ENDDO 2407 ELSE 2408 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 2409 ENDIF 2410 2411 #if defined key_si3 2365 2412 ! ! ================== ! 2366 2413 ! ! ice skin temp. ! … … 2408 2455 ! 2409 2456 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 2410 info = OASIS_idle2411 2457 2412 2458 zfr_l(:,:) = 1.- fr_i(:,:)
Note: See TracChangeset
for help on using the changeset viewer.
