- Timestamp:
- 2015-07-21T13:25:36+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5146 r5621 30 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 31 USE sbccpl 32 USE oce , ONLY : fraqsr_1lev,sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 33 USE albedo ! albedo parameters 34 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 42 42 USE domvvl ! Variable volume 43 43 USE limctl 44 USE limcons 44 45 45 46 IMPLICIT NONE … … 93 94 !! - fr_i : ice fraction 94 95 !! - tn_ice : sea-ice surface temperature 95 !! - alb_ice : sea-ice albedo ( lk_cpl=T)96 !! - alb_ice : sea-ice albedo (only useful in coupled mode) 96 97 !! 97 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 100 101 !! The ref should be Rousset et al., 2015 101 102 !!--------------------------------------------------------------------- 102 INTEGER, INTENT(in) :: kt ! number of iteration 103 INTEGER :: ji, jj, jl, jk ! dummy loop indices 104 REAL(wp) :: zemp ! local scalars 105 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 106 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 103 INTEGER, INTENT(in) :: kt ! number of iteration 104 INTEGER :: ji, jj, jl, jk ! dummy loop indices 105 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 106 REAL(wp) :: zqsr ! New solar flux received by the ocean 107 107 ! 108 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace … … 110 110 111 111 ! make calls for heat fluxes before it is modified 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 113 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 114 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 115 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 116 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 117 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 118 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 113 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 114 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 115 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 116 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 117 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 118 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 119 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 120 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 121 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 119 122 120 123 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) … … 125 128 ! heat flux at the ocean surface ! 126 129 !------------------------------------------! 127 ! Solar heat flux reaching the ocean = z fcm1(W.m-2)130 ! Solar heat flux reaching the ocean = zqsr (W.m-2) 128 131 !--------------------------------------------------- 129 IF( lk_cpl ) THEN 130 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 131 zfcm1 = qsr_tot(ji,jj) 132 DO jl = 1, jpl 133 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 134 END DO 135 ELSE 136 !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 137 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 138 DO jl = 1, jpl 139 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 140 END DO 141 ENDIF 132 zqsr = qsr_tot(ji,jj) 133 DO jl = 1, jpl 134 zqsr = zqsr - a_i_b(ji,jj,jl) * ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 135 END DO 142 136 143 137 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 144 138 !--------------------------------------------------- 145 z f_mass= hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)146 hfx_out(ji,jj) = hfx_out(ji,jj) + z f_mass + zfcm1139 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 140 hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 147 141 148 142 ! Add the residual from heat diffusion equation (W.m-2) … … 152 146 ! New qsr and qns used to compute the oceanic heat flux at the next time step 153 147 !--------------------------------------------------- 154 qsr(ji,jj) = z fcm1155 qns(ji,jj) = hfx_out(ji,jj) - z fcm1148 qsr(ji,jj) = zqsr 149 qns(ji,jj) = hfx_out(ji,jj) - zqsr 156 150 157 151 !------------------------------------------! … … 166 160 ! Even if i see Ice melting as a FW and SALT flux 167 161 ! 168 ! computing freshwater exchanges at the ice/ocean interface169 IF( lk_cpl ) THEN170 zemp = emp_tot(ji,jj) & ! net mass flux over grid cell171 & - emp_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! minus the mass flux intercepted by sea ice172 & + sprecip(ji,jj) * ( pfrld(ji,jj) - pfrld(ji,jj)**rn_betas ) !173 ELSE174 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction175 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean176 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**rn_betas ) ! except solid precip intercepted by sea-ice177 ENDIF178 179 162 ! mass flux from ice/ocean 180 163 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & … … 182 165 183 166 ! mass flux at the ocean/ice interface 184 fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice! F/M mass flux save at least for biogeochemical model185 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)! mass flux + F/M mass flux (always ice/ocean mass exchange)167 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 168 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 186 169 187 170 END DO … … 212 195 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 213 196 214 !------------------------------------------------! 215 ! Snow/ice albedo (only if sent to coupler) ! 216 !------------------------------------------------! 217 IF( lk_cpl ) THEN ! coupled case 218 219 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 220 221 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 222 223 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 224 225 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 226 227 ENDIF 228 229 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) ! control print 197 !------------------------------------------------------------------------! 198 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 199 !------------------------------------------------------------------------! 200 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 201 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 202 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 203 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 204 205 ! conservation test 206 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 207 208 ! control prints 209 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 230 210 231 211 IF(ln_ctl) THEN … … 341 321 sice_0(:,:) = 2._wp 342 322 END WHERE 343 ENDIF344 345 IF( .NOT. ln_rstart ) THEN346 fraqsr_1lev(:,:) = 1._wp347 323 ENDIF 348 324 !
Note: See TracChangeset
for help on using the changeset viewer.
