Changeset 7646 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r6416 r7646 34 34 USE traqsr ! add penetration of solar flux in the calculation of heat budget 35 35 USE domvvl ! Variable volume 36 USE limctl ! 37 USE limcons ! 36 USE limctl ! 37 USE limcons ! 38 USE bdy_oce , ONLY: ln_bdy 38 39 ! 39 40 USE in_out_manager ! I/O manager … … 42 43 USE lib_mpp ! MPP library 43 44 USE wrk_nemo ! work arrays 44 USE prtctl ! Print control45 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 46 46 … … 48 48 PRIVATE 49 49 50 PUBLIC lim_sbc_init ! called by sbc ice_lim50 PUBLIC lim_sbc_init ! called by sbc_lim_init 51 51 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 52 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 94 94 !! - fr_i : ice fraction 95 95 !! - tn_ice : sea-ice surface temperature 96 !! - alb_ice : sea-ice albedo ( only useful incoupled mode)96 !! - alb_ice : sea-ice albedo (recomputed only for coupled mode) 97 97 !! 98 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 109 109 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace 110 110 !!--------------------------------------------------------------------- 111 ! 112 ! make calls for heat fluxes before it is modified 113 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 114 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 115 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 116 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 117 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 118 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 119 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 120 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 121 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 122 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 123 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 124 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) ! emp over ocean (taking into account the snow blown away from the ice) 125 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) ! emp over ice (taking into account the snow blown away from the ice) 126 111 112 ! --- case we bypass ice thermodynamics --- ! 113 IF( .NOT. ln_limthd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere 114 hfx_in (:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 115 hfx_out (:,:) = pfrld(:,:) * qns_oce(:,:) + qemp_oce(:,:) 116 ftr_ice (:,:,:) = 0._wp 117 emp_ice (:,:) = 0._wp 118 qemp_ice (:,:) = 0._wp 119 qevap_ice(:,:,:) = 0._wp 120 ENDIF 121 127 122 ! albedo output 128 123 CALL wrk_alloc( jpi,jpj, zalb ) 129 124 130 125 zalb(:,:) = 0._wp 131 WHERE ( SUM( a_i_b, dim=3 )<= epsi06 ) ; zalb(:,:) = 0.066_wp132 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )126 WHERE ( at_i_b <= epsi06 ) ; zalb(:,:) = 0.066_wp 127 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 133 128 END WHERE 134 129 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 135 130 136 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ))131 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b ) 137 132 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 138 133 … … 180 175 ! mass flux from ice/ocean 181 176 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 182 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 177 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 183 178 184 179 ! mass flux at the ocean/ice interface 185 180 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) ! F/M mass flux save at least for biogeochemical model 186 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 181 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 187 182 END DO 188 183 END DO … … 192 187 !------------------------------------------! 193 188 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 194 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 189 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 195 190 196 191 !-------------------------------------------------------------! … … 221 216 222 217 ! conservation test 223 IF( ln_limdia hsb )CALL lim_cons_final( 'limsbc' )218 IF( ln_limdiachk .AND. .NOT. ln_bdy) CALL lim_cons_final( 'limsbc' ) 224 219 225 220 ! control prints 226 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 227 ! 228 IF(ln_ctl) THEN 229 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) 230 CALL prt_ctl( tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ' ) 231 CALL prt_ctl( tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ' ) 232 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 233 ENDIF 234 ! 221 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 222 IF( ln_ctl ) CALL lim_prt3D( 'limsbc' ) 223 235 224 END SUBROUTINE lim_sbc_flx 236 225 … … 266 255 INTEGER :: ji, jj ! dummy loop indices 267 256 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar 268 REAL(wp) :: zat_v, zvtau_ice, zv_t 257 REAL(wp) :: zat_v, zvtau_ice, zv_t, zrhoco ! - - 269 258 !!--------------------------------------------------------------------- 259 zrhoco = rau0 * rn_cio 270 260 ! 271 261 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) … … 278 268 zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) 279 269 ! ! update the ocean stress modulus 280 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt281 tmod_io(ji,jj) = rhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point270 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 271 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 282 272 END DO 283 273 END DO 284 CALL lbc_lnk ( taum, 'T', 1. ) ; CALL lbc_lnk(tmod_io, 'T', 1. )274 CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 285 275 ! 286 276 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step … … 303 293 END DO 304 294 END DO 305 CALL lbc_lnk( utau, 'U', -1. ) ; CALL lbc_lnk( vtau, 'V', -1. ) ! lateral boundary condition 306 ! 307 IF(ln_ctl) CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau : ', mask1=umask, & 308 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 295 CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. ) ! lateral boundary condition 296 ! 309 297 ! 310 298 END SUBROUTINE lim_sbc_tau … … 333 321 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 334 322 sice_0(:,:) = sice 335 ! 336 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 337 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 338 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 339 soce_0(:,:) = 4._wp 340 sice_0(:,:) = 2._wp 341 END WHERE 342 ENDIF 323 ! ! decrease ocean & ice reference salinities in the Baltic Sea area 324 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 325 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 326 soce_0(:,:) = 4._wp 327 sice_0(:,:) = 2._wp 328 END WHERE 343 329 ! 344 330 IF( .NOT. ln_rstart ) THEN … … 348 334 snwice_mass_b(:,:) = snwice_mass(:,:) 349 335 ELSE 350 snwice_mass (:,:) = 0. 0_wp! no mass exchanges351 snwice_mass_b(:,:) = 0. 0_wp! no mass exchanges336 snwice_mass (:,:) = 0._wp ! no mass exchanges 337 snwice_mass_b(:,:) = 0._wp ! no mass exchanges 352 338 ENDIF 353 339 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area … … 355 341 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 356 342 357 !!gm I really don't like this st aff here... Find a way to put that elsewhere or differently343 !!gm I really don't like this stuff here... Find a way to put that elsewhere or differently 358 344 !!gm 359 345 IF( .NOT.ln_linssh ) THEN
Note: See TracChangeset
for help on using the changeset viewer.