Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
- Timestamp:
- 2014-12-15T17:42:49+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4769 r4990 97 97 !! 98 98 INTEGER :: ji, jj ! dummy loop indices 99 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os ! albedo of the ice under overcast sky 100 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs ! albedo of ice under clear sky 101 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) 102 103 !!---------------------------------------------------------------------- 103 104 104 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 ) 105 106 106 107 IF( kt == nit000 ) THEN … … 130 131 DO jj = 2, jpj 131 132 DO ji = 2, jpi ! NO vector opt. possible 132 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj) 133 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) 134 137 END DO 135 138 END DO … … 138 141 ! 139 142 CASE( 'C' ) !== C-grid ice dynamics : U & V-points (same as ocean) 140 u_oce(:,:) = ssu_m(:,:) ! mean surface ocean current at ice velocity point141 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) 142 145 ! 143 146 END SELECT 144 147 145 148 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 146 tfu(:,:) = tfreez( sss_m ) + rt0149 tfu(:,:) = eos_fzp( sss_m ) + rt0 147 150 148 151 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 149 152 150 ! ... ice albedo (clear sky and overcast sky) 153 ! Ice albedo 154 151 155 CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 152 156 reshape( hsnif, (/jpi,jpj,1/) ), & 153 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 154 168 155 169 ! ... Sea-ice surface boundary conditions output from bulk formulae : … … 167 181 ! 168 182 SELECT CASE( ksbc ) 169 CASE( 3) ! CLIO bulk formulation170 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 , & 171 185 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 172 186 & qla_ice , dqns_ice , dqla_ice , & … … 174 188 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 175 189 176 CASE( 4) ! CORE bulk formulation177 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 , & 178 192 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 179 193 & qla_ice , dqns_ice , dqla_ice , & 180 194 & tprecip , sprecip , & 181 195 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 182 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice _cs, qsr_ice_mean, jpl )183 184 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) 185 199 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 186 200 END SELECT … … 213 227 #endif 214 228 END IF 215 #if defined key_coupled216 229 ! ! Ice surface fluxes in coupled mode 217 IF( ksbc == 5) THEN230 IF( ksbc == jp_cpl ) THEN 218 231 a_i(:,:,1)=fr_i 219 232 CALL sbc_cpl_ice_flx( frld, & 220 233 ! optional arguments, used only in 'mixed oce-ice' case 221 & palbi = zalb_ice _cs, psst = sst_m, pist = zsist )234 & palbi = zalb_ice, psst = sst_m, pist = zsist ) 222 235 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 223 236 ENDIF 224 #endif225 237 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 226 238 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes … … 252 264 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 253 265 ! 254 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 ) 255 267 ! 256 268 END SUBROUTINE sbc_ice_lim_2
Note: See TracChangeset
for help on using the changeset viewer.