Changeset 5075 for branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
- Timestamp:
- 2015-02-11T11:50:34+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4621 r5075 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) 98 103 !!---------------------------------------------------------------------- 99 104 100 CALL wrk_alloc( jpi,jpj,1, zalb_ ice_os, zalb_ice_cs, zsist )105 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 101 106 102 107 IF( kt == nit000 ) THEN … … 126 131 DO jj = 2, jpj 127 132 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) 133 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) 135 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) 130 137 END DO 131 138 END DO … … 134 141 ! 135 142 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(:,:) 143 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 144 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 138 145 ! 139 146 END SELECT 140 147 141 148 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 142 tfu(:,:) = tfreez( sss_m ) + rt0149 tfu(:,:) = eos_fzp( sss_m ) + rt0 143 150 144 151 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 145 152 146 ! ... ice albedo (clear sky and overcast sky) 153 ! Ice albedo 154 147 155 CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 148 156 reshape( hsnif, (/jpi,jpj,1/) ), & 149 zalb_ice_cs, zalb_ice_os ) 157 zalb_cs, zalb_os ) 158 159 SELECT CASE( ksbc ) 160 CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations 161 162 ! albedo depends on cloud fraction because of non-linear spectral effects 163 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 164 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 165 ! (zalb_ice) is computed within the bulk routine 166 167 END SELECT 150 168 151 169 ! ... Sea-ice surface boundary conditions output from bulk formulae : … … 163 181 ! 164 182 SELECT CASE( ksbc ) 165 CASE( 3) ! CLIO bulk formulation166 CALL blk_ice_clio( zsist, zalb_ ice_cs, zalb_ice_os,&183 CASE( jp_clio ) ! CLIO bulk formulation 184 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 167 185 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 168 186 & qla_ice , dqns_ice , dqla_ice , & … … 170 188 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 171 189 172 CASE( 4) ! CORE bulk formulation173 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice _cs, &190 CASE( jp_core ) ! CORE bulk formulation 191 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , & 174 192 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 175 193 & qla_ice , dqns_ice , dqla_ice , & 176 194 & tprecip , sprecip , & 177 195 & 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)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) 181 199 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 182 200 END SELECT … … 205 223 CALL lim_trp_2 ( kt ) ! Ice transport ( Advection/diffusion ) 206 224 IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping 225 #if defined key_bdy 226 CALL bdy_ice_lim( kt ) ! bdy ice thermo 227 #endif 207 228 END IF 208 #if defined key_coupled209 229 ! ! Ice surface fluxes in coupled mode 210 IF( ksbc == 5) THEN230 IF( ksbc == jp_cpl ) THEN 211 231 a_i(:,:,1)=fr_i 212 232 CALL sbc_cpl_ice_flx( frld, & 213 233 ! optional arguments, used only in 'mixed oce-ice' case 214 & palbi = zalb_ice _cs, psst = sst_m, pist = zsist )234 & palbi = zalb_ice, psst = sst_m, pist = zsist ) 215 235 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 216 236 ENDIF 217 #endif218 237 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 219 238 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes … … 245 264 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 246 265 ! 247 CALL wrk_dealloc( jpi,jpj,1, zalb_ ice_os, zalb_ice_cs, zsist )266 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 248 267 ! 249 268 END SUBROUTINE sbc_ice_lim_2
Note: See TracChangeset
for help on using the changeset viewer.