Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4621 r5965 53 53 USE agrif_lim2_update 54 54 # endif 55 56 #if defined key_bdy 57 USE bdyice_lim ! unstructured open boundary data (bdy_ice_lim routine) 58 #endif 55 59 56 60 IMPLICIT NONE … … 93 97 !! 94 98 INTEGER :: ji, jj ! dummy loop indices 95 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os ! albedo of the ice under overcast sky 96 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs ! albedo of ice under clear sky 97 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! surface ice temperature (K) 99 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os ! ice albedo under overcast sky 100 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs ! ice albedo under clear sky 101 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 102 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 103 REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice 98 104 !!---------------------------------------------------------------------- 99 100 CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )101 105 102 106 IF( kt == nit000 ) THEN … … 119 123 &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 120 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 121 129 ! Bulk Formulea ! 122 130 !----------------! … … 126 134 DO jj = 2, jpj 127 135 DO ji = 2, jpi ! NO vector opt. possible 128 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj) 129 v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj) 136 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) & 137 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 138 v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) & 139 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 130 140 END DO 131 141 END DO … … 134 144 ! 135 145 CASE( 'C' ) !== C-grid ice dynamics : U & V-points (same as ocean) 136 u_oce(:,:) = ssu_m(:,:) ! mean surface ocean current at ice velocity point137 v_oce(:,:) = ssv_m(:,:) 146 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 147 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 138 148 ! 139 149 END SELECT 140 150 141 151 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 142 tfu(:,:) = tfreez( sss_m ) + rt0152 tfu(:,:) = eos_fzp( sss_m ) + rt0 143 153 144 154 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 145 155 146 ! ... ice albedo (clear sky and overcast sky) 156 ! Ice albedo 157 147 158 CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 148 159 reshape( hsnif, (/jpi,jpj,1/) ), & 149 zalb_ice_cs, zalb_ice_os ) 160 zalb_cs, zalb_os ) 161 162 SELECT CASE( ksbc ) 163 CASE( jp_core , jp_purecpl ) ! CORE and COUPLED bulk formulations 164 165 ! albedo depends on cloud fraction because of non-linear spectral effects 166 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 167 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 168 ! (zalb_ice) is computed within the bulk routine 169 170 END SELECT 150 171 151 172 ! ... Sea-ice surface boundary conditions output from bulk formulae : … … 163 184 ! 164 185 SELECT CASE( ksbc ) 165 CASE( 3 ) ! CLIO bulk formulation 166 CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os, & 167 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 168 & qla_ice , dqns_ice , dqla_ice , & 169 & tprecip , sprecip , & 170 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 171 172 CASE( 4 ) ! CORE bulk formulation 173 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice_cs, & 174 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 175 & qla_ice , dqns_ice , dqla_ice , & 176 & tprecip , sprecip , & 177 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 178 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice_cs, qsr_ice_mean, jpl ) 179 180 CASE( 5 ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 186 CASE( jp_clio ) ! CLIO bulk formulation 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 ) 194 195 CASE( jp_core ) ! CORE bulk formulation 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) 181 200 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 182 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 183 208 184 209 CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point … … 205 230 CALL lim_trp_2 ( kt ) ! Ice transport ( Advection/diffusion ) 206 231 IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping 232 #if defined key_bdy 233 CALL bdy_ice_lim( kt ) ! bdy ice thermo 234 #endif 207 235 END IF 208 #if defined key_coupled209 236 ! ! Ice surface fluxes in coupled mode 210 IF( ksbc == 5 ) THEN237 IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations 211 238 a_i(:,:,1)=fr_i 212 239 CALL sbc_cpl_ice_flx( frld, & 213 240 ! optional arguments, used only in 'mixed oce-ice' case 214 & palbi = zalb_ice_cs, psst = sst_m, pist =zsist )241 & palbi=zalb_ice, psst=sst_m, pist=zsist ) 215 242 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 216 243 ENDIF 217 #endif218 244 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 219 245 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes 220 #if defined key_top221 IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2222 #endif223 246 224 247 IF( .NOT. lk_mpp )THEN … … 234 257 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 235 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 ) 236 262 ! 237 263 ENDIF ! End sea-ice time step only … … 245 271 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 246 272 ! 247 CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )248 !249 273 END SUBROUTINE sbc_ice_lim_2 250 274
Note: See TracChangeset
for help on using the changeset viewer.