Changeset 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
- Timestamp:
- 2015-08-12T17:46:45+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4990 r5682 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 … … 147 150 148 151 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 149 tfu(:,:) = eos_fzp( sss_m ) + rt0 152 CALL eos_fzp( sss_m(:,:), tfu(:,:) ) 153 tfu(:,:) = tfu(:,:) + rt0 150 154 151 155 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) … … 158 162 159 163 SELECT CASE( ksbc ) 160 CASE( jp_core , jp_ cpl ) ! CORE and COUPLED bulk formulations164 CASE( jp_core , jp_purecpl ) ! CORE and COUPLED bulk formulations 161 165 162 166 ! albedo depends on cloud fraction because of non-linear spectral effects … … 182 186 SELECT CASE( ksbc ) 183 187 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 ) 188 ! CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 189 ! & utau_ice , vtau_ice , qns_ice , qsr_ice, & 190 ! & qla_ice , dqns_ice , dqla_ice , & 191 ! & tprecip , sprecip , & 192 ! & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 193 CALL blk_ice_clio_tau 194 CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 189 195 190 196 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) 197 CALL blk_ice_core_tau 198 CALL blk_ice_core_flx( zsist, zalb_ice ) 199 200 CASE( jp_purecpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 199 201 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 200 202 END SELECT 203 204 IF( ln_mixcpl) THEN 205 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 206 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 207 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 208 ENDIF 201 209 202 210 CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point … … 228 236 END IF 229 237 ! ! Ice surface fluxes in coupled mode 230 IF( ksbc == jp_cpl ) THEN238 IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations 231 239 a_i(:,:,1)=fr_i 232 240 CALL sbc_cpl_ice_flx( frld, & 233 241 ! optional arguments, used only in 'mixed oce-ice' case 234 & palbi = zalb_ice, psst = sst_m, pist =zsist )242 & palbi=zalb_ice, psst=sst_m, pist=zsist ) 235 243 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 236 244 ENDIF 237 245 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 238 246 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 247 243 248 IF( .NOT. lk_mpp )THEN … … 253 258 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 254 259 # endif 260 ! 261 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 262 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 255 263 ! 256 264 ENDIF ! End sea-ice time step only … … 264 272 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 265 273 ! 266 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )267 !268 274 END SUBROUTINE sbc_ice_lim_2 269 275
Note: See TracChangeset
for help on using the changeset viewer.