- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r4306 r6225 29 29 USE sbc_ice ! surface boundary condition: ice 30 30 USE sbc_oce ! surface boundary condition: ocean 31 USE sbccpl 32 USE cpl_oasis3, ONLY : lk_cpl 31 USE sbccpl ! surface boundary condition: coupled interface 33 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 34 33 USE albedo ! albedo parameters 34 ! 35 35 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 36 36 USE lib_mpp ! MPP library 37 37 USE wrk_nemo ! work arrays 38 38 USE in_out_manager ! I/O manager 39 USE diaar5, ONLY : lk_diaar540 39 USE iom ! I/O library 41 40 USE prtctl ! Print control … … 45 44 PRIVATE 46 45 47 PUBLIC lim_sbc_init_2 ! called by ice_init_2 48 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 49 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 50 PUBLIC lim_bio_meanqsr_2 ! called by sbc_ice_lim_2 46 PUBLIC lim_sbc_init_2 ! called by ice_init_2 47 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 48 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 51 49 52 50 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 55 53 REAL(wp) :: rone = 1._wp ! - - 56 54 ! 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! fix SSS and ice salinity used in levitating case 0 58 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 59 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] … … 61 59 !! * Substitutions 62 60 # include "vectopt_loop_substitute.h90" 63 # include "domzgr_substitute.h90"64 61 !!---------------------------------------------------------------------- 65 62 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) … … 97 94 !! - emp : freshwater budget: mass flux 98 95 !! - sfx : freshwater budget: salt flux due to Freezing/Melting 99 !! - utau : sea surface i-stress (ocean referential)100 !! - vtau : sea surface j-stress (ocean referential)101 96 !! - fr_i : ice fraction 102 97 !! - tn_ice : sea-ice surface temperature 103 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)98 !! - alb_ice : sea-ice albedo (ln_cpl=T) 104 99 !! 105 100 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 107 102 !!--------------------------------------------------------------------- 108 103 INTEGER, INTENT(in) :: kt ! number of iteration 109 ! !104 ! 110 105 INTEGER :: ji, jj ! dummy loop indices 111 106 INTEGER :: ii0, ii1, ij0, ij1 ! local integers … … 119 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 120 115 !!--------------------------------------------------------------------- 121 116 ! 122 117 CALL wrk_alloc( jpi, jpj, zqnsoce ) 123 118 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 124 125 SELECT CASE( nn_ice_embd ) 126 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only127 CASE( 1, 2 ) ; zswitch = 0! (1) levitating sea-ice: salt and volume exchange but no pressure effect128 129 END SELECT !119 ! 120 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 121 CASE( 0 ) ; zswitch = 1 ! (0) old levitating sea-ice : salt exchange only 122 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 123 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 124 END SELECT 130 125 131 126 !------------------------------------------! … … 183 178 184 179 ! computation the solar flux at ocean surface 185 #if defined key_coupled 186 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )187 #else 188 zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)189 #endif 180 IF( ln_cpl ) THEN 181 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 182 ELSE 183 zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 184 ENDIF 190 185 ! computation the non solar heat flux at ocean surface 191 186 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads … … 206 201 ! 207 202 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 208 #if defined key_coupled209 203 ! ! coupled mode: 210 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 211 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 212 #else 213 ! ! forced mode: 214 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 215 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 216 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 217 #endif 204 IF( ln_cpl ) THEN 205 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 206 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 207 ELSE 208 ! ! forced mode: 209 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 210 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 211 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 212 ENDIF 218 213 ! 219 214 ! mass flux at the ocean/ice interface (sea ice fraction) … … 245 240 ENDIF 246 241 247 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) 248 CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 249 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 250 251 IF( lk_diaar5 ) THEN ! AR5 diagnostics 252 CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 253 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 254 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 255 ENDIF 242 IF( iom_use('hflx_ice_cea' ) ) CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) 243 IF( iom_use('qns_io_cea' ) ) CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 244 IF( iom_use('qsr_io_cea' ) ) CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 245 246 IF( iom_use('isnwmlt_cea' ) ) CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 247 IF( iom_use('fsal_virt_cea') ) CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 248 IF( iom_use('fsal_real_cea') ) CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 256 249 257 250 !-----------------------------------------------! … … 259 252 !-----------------------------------------------! 260 253 261 #if defined key_coupled 262 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature263 ht_i(:,:,1) = hicif(:,:)264 ht_s(:,:,1) = hsnif(:,:)265 a_i(:,:,1) = fr_i(:,:)266 ! ! Computation of snow/ice and ocean albedo267 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb )268 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys)269 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo270 #endif 254 IF( ln_cpl) THEN 255 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 256 ht_i(:,:,1) = hicif(:,:) 257 ht_s(:,:,1) = hsnif(:,:) 258 a_i(:,:,1) = fr_i(:,:) 259 ! ! Computation of snow/ice and ocean albedo 260 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 261 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 262 IF( iom_use('icealb_cea' ) ) CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 263 ENDIF 271 264 272 265 IF(ln_ctl) THEN ! control print 273 266 CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ') 274 267 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ') 275 CALL prt_ctl(tab2d_1=utau , clinfo1=' lim_sbc: utau : ', mask1=umask, &276 & tab2d_2=vtau , clinfo2=' vtau : ' , mask2=vmask )277 268 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice : ') 278 269 ENDIF … … 312 303 INTEGER , INTENT(in) :: kt ! ocean time-step index 313 304 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 314 ! !305 ! 315 306 INTEGER :: ji, jj ! dummy loop indices 316 307 REAL(wp) :: zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt ! local scalar … … 328 319 ! 329 320 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 330 !CDIR NOVERRCHK 321 ! 331 322 DO jj = 1, jpj !* modulus of ice-ocean relative velocity at I-point 332 !CDIR NOVERRCHK333 323 DO ji = 1, jpi 334 324 zu_i = u_ice(ji,jj) - u_oce(ji,jj) ! ice-ocean relative velocity at I-point … … 337 327 END DO 338 328 END DO 339 !CDIR NOVERRCHK340 329 DO jj = 1, jpjm1 !* update the modulus of stress at ocean surface (T-point) 341 !CDIR NOVERRCHK342 330 DO ji = 1, jpim1 ! NO vector opt. 343 331 ! ! modulus of U_ice-U_oce at T-point … … 392 380 ! 393 381 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 394 !CDIR NOVERRCHK 382 ! 395 383 DO jj = 2, jpjm1 !* modulus of the ice-ocean velocity at T-point 396 !CDIR NOVERRCHK397 384 DO ji = fs_2, fs_jpim1 398 385 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! 2*(U_ice-U_oce) at T-point … … 438 425 END SUBROUTINE lim_sbc_tau_2 439 426 440 SUBROUTINE lim_bio_meanqsr_2441 !!---------------------------------------------------------------------442 !! *** ROUTINE lim_bio_meanqsr443 !!444 !! ** Purpose : provide daily qsr_mean for PISCES when445 !! analytic diurnal cycle is applied in physic446 !!447 !! ** Method : add part under ice448 !!449 !!---------------------------------------------------------------------450 451 qsr_mean(:,:) = pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_daymean(:,:)452 453 END SUBROUTINE lim_bio_meanqsr_2454 427 455 428 SUBROUTINE lim_sbc_init_2 … … 462 435 !! ** input : Namelist namicedia 463 436 !!------------------------------------------------------------------- 464 !465 INTEGER :: jk ! local integer437 INTEGER :: jk ! local integer 438 !!------------------------------------------------------------------- 466 439 ! 467 440 IF(lwp) WRITE(numout,*) … … 497 470 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 498 471 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 499 do jk = 1,jpkm1 ! adjust initial vertical scale factors 500 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 501 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 502 end do 503 fse3t_a(:,:,:) = fse3t_b(:,:,:) 504 ! Reconstruction of all vertical scale factors at now and before time steps 505 ! ============================================================================= 506 ! Horizontal scale factor interpolations 507 ! -------------------------------------- 508 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 509 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 510 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 511 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 512 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 513 ! Vertical scale factor interpolations 514 ! ------------------------------------ 515 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 516 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 517 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 518 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 519 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 520 ! t- and w- points depth 521 ! ---------------------- 522 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 523 fsdepw_n(:,:,1) = 0.0_wp 524 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 525 DO jk = 2, jpk 526 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 527 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 528 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 529 END DO 472 !!gm I really don't like this staff here... Find a way to put that elsewhere or differently 473 !!gm 474 IF( .NOT.ln_linssh ) THEN 475 476 do jk = 1,jpkm1 ! adjust initial vertical scale factors 477 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 478 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 479 end do 480 e3t_a(:,:,:) = e3t_b(:,:,:) 481 ! Reconstruction of all vertical scale factors at now and before time steps 482 ! ! Horizontal scale factor interpolations 483 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 484 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 485 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 486 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 487 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 488 ! ! Vertical scale factor interpolations 489 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 490 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 491 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 492 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 493 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 494 ! ! t- and w- points depth 495 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 496 gdepw_n(:,:,1) = 0.0_wp 497 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 498 DO jk = 2, jpk 499 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 500 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 501 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 502 END DO 503 ENDIF 504 !!gm end 530 505 ENDIF 531 506 !
Note: See TracChangeset
for help on using the changeset viewer.