- Timestamp:
- 2017-09-01T15:49:35+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90
r8426 r8486 2 2 !!====================================================================== 3 3 !! *** MODULE iceupdate *** 4 !! 4 !! Sea-ice : computation of the flux at the sea ice/ocean interface 5 5 !!====================================================================== 6 6 !! History : - ! 2006-07 (M. Vancoppelle) LIM3 original code … … 27 27 USE phycst ! physical constants 28 28 USE dom_oce ! ocean domain 29 USE ice ! LIM sea-ice variables 30 USE sbc_ice , ONLY : emp_oce, qns_oce, qsr_oce, qemp_oce, emp_ice, qsr_ice, qemp_ice, qevap_ice, alb_ice, tn_ice, cldf_ice, & 29 USE ice ! sea-ice: variables 30 !!gm It should be probably better to pass these variable in argument of the routine, 31 !!gm rather than having this long list in USE. This will also highlight what is updated, and what is just use. 32 USE sbc_ice , ONLY : emp_oce, qns_oce, qsr_oce , qemp_oce , & 33 & emp_ice, qsr_ice, qemp_ice, qevap_ice, alb_ice, tn_ice, cldf_ice, & 31 34 & snwice_mass, snwice_mass_b, snwice_fmass 32 35 USE sbc_oce , ONLY : nn_fsbc, ln_ice_embd, sfx, fr_i, qsr_tot, qns, qsr, fmmflx, emp, taum, utau, vtau 36 !!gm end 33 37 USE sbccpl ! Surface boundary condition: coupled interface 34 38 USE icealb ! albedo parameters 35 39 USE traqsr ! add penetration of solar flux in the calculation of heat budget 36 40 USE domvvl ! Variable volume 37 USE icectl ! 38 USE bdy_oce , ONLY: ln_bdy41 USE icectl ! ??? 42 USE bdy_oce , ONLY : ln_bdy 39 43 ! 40 44 USE in_out_manager ! I/O manager … … 59 63 # include "vectopt_loop_substitute.h90" 60 64 !!---------------------------------------------------------------------- 61 !! NEMO/ LIM3 4.0 , UCL - NEMO Consortium (2011)65 !! NEMO/ICE 4.0 , NEMO Consortium (2017) 62 66 !! $Id: iceupdate.F90 8411 2017-08-07 16:09:12Z clem $ 63 67 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 72 76 & sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=ice_update_alloc) 73 77 ! 74 IF( lk_mpp ) CALL mpp_sum( ice_update_alloc )78 IF( lk_mpp ) CALL mpp_sum( ice_update_alloc ) 75 79 IF( ice_update_alloc /= 0 ) CALL ctl_warn('ice_update_alloc: failed to allocate arrays') 76 80 END FUNCTION ice_update_alloc … … 138 142 zqsr = zqsr - a_i_b(ji,jj,jl) * ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 139 143 END DO 144 !!gm why not like almost everywhere else : 145 !!gm zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - ftr_ice(ji,jj,:) ) 140 146 141 147 ! Total heat flux reaching the ocean = hfx_out (W.m-2) … … 170 176 ! mass flux from ice/ocean 171 177 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 172 178 & + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 173 179 174 180 IF ( ln_pnd_fw ) wfx_ice(ji,jj) = wfx_ice(ji,jj) + wfx_pnd(ji,jj) … … 189 195 ! Mass of snow and ice per unit area 190 196 !---------------------------------------- 191 ! save mass from the previous ice time step 192 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) 193 ! new mass per unit area 197 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step 198 ! ! new mass per unit area 194 199 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 195 ! time evolution of snow+ice mass200 ! ! time evolution of snow+ice mass 196 201 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 197 202 … … 209 214 !------------------------------------------------------------------------! 210 215 CALL ice_alb( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 211 212 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 213 214 ! conservation test 215 IF( ln_limdiachk .AND. .NOT. ln_bdy) CALL ice_cons_final( 'iceupdate' ) 216 217 ! control prints 216 ! 217 alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 218 219 ! ! conservation test 220 IF( ln_limdiachk .AND. .NOT. ln_bdy) CALL ice_cons_final( 'iceupdate' ) 221 ! ! control prints 218 222 IF( ln_limctl ) CALL ice_prt( kt, iiceprt, jiceprt, 3, ' - Final state ice_update - ' ) 219 IF( ln_ctl )CALL ice_prt3D( 'iceupdate' )220 221 IF( nn_timing == 1 ) CALL timing_stop('ice_update_flx')222 223 IF( ln_ctl ) CALL ice_prt3D( 'iceupdate' ) 224 ! 225 IF( nn_timing == 1 ) CALL timing_stop('ice_update_flx') 226 ! 223 227 END SUBROUTINE ice_update_flx 224 228 225 229 226 SUBROUTINE ice_update_tau( kt 230 SUBROUTINE ice_update_tau( kt, pu_oce, pv_oce ) 227 231 !!------------------------------------------------------------------- 228 232 !! *** ROUTINE ice_update_tau *** … … 312 316 !! *** ROUTINE ice_update_init *** 313 317 !! 314 !! ** Purpose : Preparation of the file ice_evolu for the output of 315 !! the temporal evolution of key variables 318 !! ** Purpose : ??? 316 319 !! 317 !! ** input : Namelist namicedia318 320 !!------------------------------------------------------------------- 319 321 INTEGER :: ji, jj, jk ! dummy loop indices … … 322 324 ! 323 325 IF(lwp) WRITE(numout,*) 324 IF(lwp) WRITE(numout,*) 'ice_update_init : LIM-3 sea-ice - surface boundary condition'326 IF(lwp) WRITE(numout,*) 'ice_update_init : sea-ice ????' 325 327 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~ ' 326 328 … … 328 330 IF( ice_update_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ice_update_init : unable to allocate standard arrays' ) 329 331 ! 330 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case332 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating case 0 (i.e. virtual salt flux) 331 333 sice_0(:,:) = sice 332 ! ! decrease ocean & ice reference salinities in the Baltic Sea area 333 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 334 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & ! reduced values in the Baltic Sea area 334 335 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 335 336 soce_0(:,:) = 4._wp … … 337 338 END WHERE 338 339 ! 339 IF( .NOT. ln_rstart ) THEN340 IF( .NOT.ln_rstart ) THEN ! set 340 341 ! 341 342 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) ! snow+ice mass … … 350 351 IF( .NOT.ln_linssh ) THEN 351 352 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 352 e3t_n(:,:,jk) = e3t_0(:,:,jk) *( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)))353 e3t_b(:,:,jk) = e3t_0(:,:,jk) *( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)))353 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:)*tmask(:,:,1) / (ht_0(:,:) + 1._wp - tmask(:,:,1) ) ) 354 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshb(:,:)*tmask(:,:,1) / (ht_0(:,:) + 1._wp - tmask(:,:,1) ) ) 354 355 END DO 355 356 e3t_a(:,:,:) = e3t_b(:,:,:) 357 !!gm we are in no-restart case, so sshn=sshb ==>> faster calculation: 358 !! REAL(wp) :: ze3t ! local scalar 359 !! REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace 360 !! 361 !! WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:) 362 !! ELSEWHERE ; z2d(:,:) = 1._wp 363 !! END WHERE 364 !! DO jk = 1,jpkm1 ! adjust initial vertical scale factors 365 !! ze3t = e3t_0(:,:,jk) * z2d(:,:) 366 !! e3t_n(:,:,jk) = ze3t 367 !! e3t_b(:,:,jk) = ze3t 368 !! e3t_a(:,:,jk) = ze3t 369 !! END DO 370 !!gm but since it is only done at the initialisation.... just the following can be acceptable: 371 ! DO jk = 1,jpkm1 ! adjust initial vertical scale factors 372 ! e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:)*tmask(:,:,1) / (ht_0(:,:) + 1._wp - tmask(:,:,1)) ) 373 ! END DO 374 ! e3t_b(:,:,:) = e3t_n(:,:,:) 375 ! e3t_a(:,:,:) = e3t_n(:,:,:) 376 !!gm end 356 377 ! Reconstruction of all vertical scale factors at now and before time-steps 357 378 ! ========================================================================= … … 377 398 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 378 399 DO jk = 2, jpk 379 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk )400 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk ) 380 401 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 381 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn 402 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 382 403 END DO 383 404 ENDIF … … 387 408 END SUBROUTINE ice_update_init 388 409 410 #else 411 !!---------------------------------------------------------------------- 412 !! Default option Dummy module NO LIM3 sea-ice model 413 !!---------------------------------------------------------------------- 389 414 #endif 390 415
Note: See TracChangeset
for help on using the changeset viewer.
