- Timestamp:
- 2015-08-26T16:14:53+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/DEV_r5107_dynvor_updates/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r5256 r5709 101 101 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 102 102 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 103 REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice 103 104 !!---------------------------------------------------------------------- 104 105 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )106 105 107 106 IF( kt == nit000 ) THEN … … 124 123 &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 125 124 # endif 125 126 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 127 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 128 126 129 ! Bulk Formulea ! 127 130 !----------------! … … 132 135 DO ji = 2, jpi ! NO vector opt. possible 133 136 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) & 134 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)137 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 135 138 v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) & 136 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)139 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 137 140 END DO 138 141 END DO … … 158 161 159 162 SELECT CASE( ksbc ) 160 CASE( jp_core , jp_ cpl ) ! CORE and COUPLED bulk formulations163 CASE( jp_core , jp_purecpl ) ! CORE and COUPLED bulk formulations 161 164 162 165 ! albedo depends on cloud fraction because of non-linear spectral effects … … 182 185 SELECT CASE( ksbc ) 183 186 CASE( jp_clio ) ! CLIO bulk formulation 184 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 185 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 186 & qla_ice , dqns_ice , dqla_ice , & 187 & tprecip , sprecip , & 188 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 187 ! CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 188 ! & utau_ice , vtau_ice , qns_ice , qsr_ice, & 189 ! & qla_ice , dqns_ice , dqla_ice , & 190 ! & tprecip , sprecip , & 191 ! & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 192 CALL blk_ice_clio_tau 193 CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 189 194 190 195 CASE( jp_core ) ! CORE bulk formulation 191 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , & 192 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 193 & qla_ice , dqns_ice , dqla_ice , & 194 & tprecip , sprecip , & 195 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 196 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 197 198 CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 196 CALL blk_ice_core_tau 197 CALL blk_ice_core_flx( zsist, zalb_ice ) 198 199 CASE( jp_purecpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 199 200 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 200 201 END SELECT 202 203 IF( ln_mixcpl) THEN 204 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 205 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 206 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 207 ENDIF 201 208 202 209 CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point … … 228 235 END IF 229 236 ! ! Ice surface fluxes in coupled mode 230 IF( ksbc == jp_cpl ) THEN237 IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations 231 238 a_i(:,:,1)=fr_i 232 239 CALL sbc_cpl_ice_flx( frld, & 233 240 ! optional arguments, used only in 'mixed oce-ice' case 234 & palbi = zalb_ice, psst = sst_m, pist =zsist )241 & palbi=zalb_ice, psst=sst_m, pist=zsist ) 235 242 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 236 243 ENDIF 237 244 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 238 245 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes 239 #if defined key_top240 IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2241 #endif242 246 243 247 IF( .NOT. lk_mpp )THEN … … 253 257 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 254 258 # endif 259 ! 260 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 261 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 255 262 ! 256 263 ENDIF ! End sea-ice time step only … … 264 271 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 265 272 ! 266 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )267 !268 273 END SUBROUTINE sbc_ice_lim_2 269 274
Note: See TracChangeset
for help on using the changeset viewer.