Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
- Timestamp:
- 2014-12-15T17:42:49+01:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4871 r4990 12 12 !! 3.4 ! 2011-01 (A Porter) dynamical allocation 13 13 !! - ! 2012-10 (C. Rousset) add lim_diahsb 14 !! 3.6 ! 2014-07 (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface 14 15 !!---------------------------------------------------------------------- 15 16 #if defined key_lim3 … … 59 60 USE prtctl ! Print control 60 61 USE lib_fortran ! 61 USE cpl_oasis3, ONLY : lk_cpl62 62 63 63 #if defined key_bdy … … 80 80 !!---------------------------------------------------------------------- 81 81 CONTAINS 82 83 FUNCTION fice_cell_ave ( ptab)84 !!--------------------------------------------------------------------------85 !! * Compute average over categories, for grid cell (ice covered and free ocean)86 !!--------------------------------------------------------------------------87 REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave88 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab89 INTEGER :: jl ! Dummy loop index90 91 fice_cell_ave (:,:) = 0.0_wp92 93 DO jl = 1, jpl94 fice_cell_ave (:,:) = fice_cell_ave (:,:) &95 & + a_i (:,:,jl) * ptab (:,:,jl)96 END DO97 98 END FUNCTION fice_cell_ave99 100 FUNCTION fice_ice_ave ( ptab)101 !!--------------------------------------------------------------------------102 !! * Compute average over categories, for ice covered part of grid cell103 !!--------------------------------------------------------------------------104 REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave105 REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab106 107 fice_ice_ave (:,:) = 0.0_wp108 WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)109 110 END FUNCTION fice_ice_ave111 82 112 83 !!====================================================================== … … 133 104 !!--------------------------------------------------------------------- 134 105 INTEGER, INTENT(in) :: kt ! ocean time step 135 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE )106 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 136 107 !! 137 INTEGER :: j i, jj, jl, jk! dummy loop index108 INTEGER :: jl ! dummy loop index 138 109 REAL(wp) :: zcoef ! local scalar 139 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice_os, zalb_ice_cs ! albedo of the ice under overcast/clear sky 140 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean albedo of ice (for coupled) 141 142 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all ! Mean albedo over all categories 143 REAL(wp), POINTER, DIMENSION(:,:) :: ztem_ice_all ! Mean temperature over all categories 144 145 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_ice_all ! Mean solar heat flux over all categories 146 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_ice_all ! Mean non solar heat flux over all categories 147 REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_ice_all ! Mean latent heat flux over all categories 148 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all ! Mean d(qns)/dT over all categories 149 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all ! Mean d(qla)/dT over all categories 150 REAL(wp) :: ztmelts ! clem 2014: for HC diags 151 REAL(wp) :: epsi20 = 1.e-20 ! 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) 152 112 !!---------------------------------------------------------------------- 153 113 154 !- O.M. : why do we allocate all these arrays even when MOD( kt-1, nn_fsbc ) /= 0 ?????155 156 114 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 157 158 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice )159 160 IF( lk_cpl ) THEN161 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) &162 & CALL wrk_alloc( jpi, jpj, ztem_ice_all , zalb_ice_all , z_qsr_ice_all, z_qns_ice_all, &163 & z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all)164 ENDIF165 115 166 116 IF( kt == nit000 ) THEN … … 183 133 ! !----------------! 184 134 ! 185 u_oce(:,:) = ssu_m(:,:) ! mean surface ocean current at ice velocity point 186 v_oce(:,:) = ssv_m(:,:) ! (C-grid dynamics : U- & V-points as the ocean) 187 188 ! masked sea surface freezing temperature [Kelvin] 189 t_bo(:,:) = ( tfreez( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) 190 191 CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os ) ! ... ice albedo 192 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) ! (C-grid dynamics : U- & V-points as the ocean) 137 ! 138 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) ! masked sea surface freezing temperature [Kelvin] 139 ! ! (set to rt0 over land) 140 ! ! Ice albedo 141 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 142 143 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 144 145 SELECT CASE( kblk ) 146 CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations 147 148 ! albedo depends on cloud fraction because of non-linear spectral effects 149 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 150 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 151 ! (zalb_ice) is computed within the bulk routine 152 153 END SELECT 154 155 ! ! Mask sea ice surface temperature 193 156 DO jl = 1, jpl 194 157 t_su(:,:,jl) = t_su(:,:,jl) + rt0 * ( 1. - tmask(:,:,1) ) 195 158 END DO 196 197 IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 198 199 IF( lk_cpl ) THEN 200 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 201 ! 202 ! Compute mean albedo and temperature 203 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 204 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 205 ! 206 ENDIF 207 ENDIF 208 ! Bulk formulea - provides the following fields: 159 160 ! Bulk formulae - provides the following fields: 209 161 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 210 162 ! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2] … … 215 167 ! 216 168 SELECT CASE( kblk ) 217 CASE( 3) ! CLIO bulk formulation218 CALL blk_ice_clio( t_su , zalb_ ice_cs, zalb_ice_os,&169 CASE( jp_clio ) ! CLIO bulk formulation 170 CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , & 219 171 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 220 172 & qla_ice , dqns_ice , dqla_ice , & … … 222 174 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 223 175 ! 224 CASE( 4 ) ! CORE bulk formulation 225 ! MV 2014 226 ! We must account for cloud fraction in the computation of the albedo 227 ! The present ref just uses the clear sky value 228 ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 229 ! CORE has no cloud fraction, hence we must prescribe it 230 ! Mean summer cloud fraction computed from CLIO = 0.81 231 zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 232 ! Following line, we replace zalb_ice_cs by simply zalb_ice 176 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 177 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 178 179 CASE( jp_core ) ! CORE bulk formulation 233 180 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , & 234 181 & utau_ice , vtau_ice , qns_ice , qsr_ice , & … … 236 183 & tprecip , sprecip , & 237 184 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 185 ! 186 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 187 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 238 188 ! 239 CASE ( 5 ) 240 zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 189 CASE ( jp_cpl ) 241 190 242 191 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 243 192 244 CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=tn_ice ) 245 246 ! Latent heat flux is forced to 0 in coupled : 247 ! it is included in qns (non-solar heat flux) 248 qla_ice (:,:,:) = 0.0e0_wp 249 dqla_ice (:,:,:) = 0.0e0_wp 193 ! MV -> seb 194 ! CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su ) 195 196 ! IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 197 ! & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 198 ! ! Latent heat flux is forced to 0 in coupled : 199 ! ! it is included in qns (non-solar heat flux) 200 ! qla_ice (:,:,:) = 0._wp 201 ! dqla_ice (:,:,:) = 0._wp 202 ! END MV -> seb 250 203 ! 251 204 END SELECT 252 253 ! Average over all categories 254 IF( lk_cpl ) THEN 255 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 256 257 z_qns_ice_all (:,:) = fice_ice_ave ( qns_ice (:,:,:) ) 258 z_qsr_ice_all (:,:) = fice_ice_ave ( qsr_ice (:,:,:) ) 259 z_dqns_ice_all (:,:) = fice_ice_ave ( dqns_ice (:,:,:) ) 260 z_qla_ice_all (:,:) = fice_ice_ave ( qla_ice (:,:,:) ) 261 z_dqla_ice_all (:,:) = fice_ice_ave ( dqla_ice (:,:,:) ) 262 263 DO jl = 1, jpl 264 dqns_ice (:,:,jl) = z_dqns_ice_all (:,:) 265 dqla_ice (:,:,jl) = z_dqla_ice_all (:,:) 266 END DO 267 ! 268 IF ( ln_iceflx_ave ) THEN 269 DO jl = 1, jpl 270 qns_ice (:,:,jl) = z_qns_ice_all (:,:) 271 qsr_ice (:,:,jl) = z_qsr_ice_all (:,:) 272 qla_ice (:,:,jl) = z_qla_ice_all (:,:) 273 END DO 274 END IF 275 ! 276 IF ( ln_iceflx_linear ) THEN 277 DO jl = 1, jpl 278 qns_ice (:,:,jl) = z_qns_ice_all(:,:) + z_dqns_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 279 qla_ice (:,:,jl) = z_qla_ice_all(:,:) + z_dqla_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 280 qsr_ice (:,:,jl) = (1.0e0_wp-zalb_ice(:,:,jl)) / (1.0e0_wp-zalb_ice_all(:,:)) * z_qsr_ice_all(:,:) 281 END DO 282 END IF 283 END IF 284 ENDIF 205 285 206 ! !----------------------! 286 207 ! ! LIM-3 time-stepping ! … … 300 221 v_ice_b(:,:) = v_ice(:,:) 301 222 302 ! trends !!gm is it truly necessary ???303 d_a_i_thd (:,:,:) = 0._wp ; d_a_i_trp (:,:,:) = 0._wp304 d_v_i_thd (:,:,:) = 0._wp ; d_v_i_trp (:,:,:) = 0._wp305 d_e_i_thd (:,:,:,:) = 0._wp ; d_e_i_trp (:,:,:,:) = 0._wp306 d_v_s_thd (:,:,:) = 0._wp ; d_v_s_trp (:,:,:) = 0._wp307 d_e_s_thd (:,:,:,:) = 0._wp ; d_e_s_trp (:,:,:,:) = 0._wp308 d_smv_i_thd(:,:,:) = 0._wp ; d_smv_i_trp(:,:,:) = 0._wp309 d_oa_i_thd (:,:,:) = 0._wp ; d_oa_i_trp (:,:,:) = 0._wp310 d_u_ice_dyn(:,:) = 0._wp ; d_v_ice_dyn(:,:) = 0._wp311 312 223 ! salt, heat and mass fluxes 313 224 sfx (:,:) = 0._wp ; … … 333 244 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 334 245 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 335 336 !337 fhld (:,:) = 0._wp338 fmmflx(:,:) = 0._wp339 ! part of solar radiation transmitted through the ice340 ftr_ice(:,:,:) = 0._wp341 342 ! diags343 diag_trp_vi (:,:) = 0._wp ; diag_trp_vs(:,:) = 0._wp ; diag_trp_ei(:,:) = 0._wp ; diag_trp_es(:,:) = 0._wp344 diag_heat_dhc(:,:) = 0._wp345 346 ! dynamical invariants347 delta_i(:,:) = 0._wp ; divu_i(:,:) = 0._wp ; shear_i(:,:) = 0._wp348 246 349 247 CALL lim_rst_opn( kt ) ! Open Ice restart file … … 389 287 pfrld(:,:) = 1._wp - at_i(:,:) 390 288 phicif(:,:) = vt_i(:,:) 289 290 ! MV -> seb 291 SELECT CASE( kblk ) 292 CASE ( jp_cpl ) 293 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 294 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 295 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 296 ! Latent heat flux is forced to 0 in coupled : 297 ! it is included in qns (non-solar heat flux) 298 qla_ice (:,:,:) = 0._wp 299 dqla_ice (:,:,:) = 0._wp 300 END SELECT 301 ! END MV -> seb 391 302 ! 392 303 CALL lim_var_bv ! bulk brine volume (diag) … … 420 331 IF( ln_nicep ) CALL lim_ctl( kt ) ! alerts in case of model crash 421 332 ! 333 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 334 ! 422 335 ENDIF ! End sea-ice time step only 423 336 … … 429 342 ! ! otherwise the atm.-ocean stresses are used everywhere 430 343 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 431 432 344 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 433 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 434 435 IF( lk_cpl ) THEN 436 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 437 & CALL wrk_dealloc( jpi, jpj, ztem_ice_all , zalb_ice_all , z_qsr_ice_all, z_qns_ice_all, & 438 & z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 439 ENDIF 345 440 346 ! 441 347 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 442 348 ! 443 349 END SUBROUTINE sbc_ice_lim 444 445 350 351 352 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 353 & pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 354 !!--------------------------------------------------------------------- 355 !! *** ROUTINE sbc_ice_lim *** 356 !! 357 !! ** Purpose : update the ice surface boundary condition by averaging and / or 358 !! redistributing fluxes on ice categories 359 !! 360 !! ** Method : average then redistribute 361 !! 362 !! ** Action : 363 !!--------------------------------------------------------------------- 364 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 365 ! =1 average and redistribute ; =2 redistribute 366 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 367 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo 368 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqns_ice ! non solar flux 369 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux 370 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity 371 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqla_ice ! latent heat flux 372 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdql_ice ! latent heat flux sensitivity 373 ! 374 INTEGER :: jl ! dummy loop index 375 ! 376 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m ! Mean albedo over all categories 377 REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m ! Mean temperature over all categories 378 ! 379 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories 380 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories 381 REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m ! Mean latent heat flux over all categories 382 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories 383 REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m ! Mean d(qla)/dT over all categories 384 !!---------------------------------------------------------------------- 385 386 IF( nn_timing == 1 ) CALL timing_start('ice_lim_flx') 387 ! 388 ! 389 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 390 CASE( 0 , 1 ) 391 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 392 ! 393 z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 394 z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 395 z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 396 z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) ) 397 z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) ) 398 DO jl = 1, jpl 399 pdqn_ice(:,:,jl) = z_dqn_m(:,:) 400 pdql_ice(:,:,jl) = z_dql_m(:,:) 401 END DO 402 ! 403 DO jl = 1, jpl 404 pqns_ice(:,:,jl) = z_qns_m(:,:) 405 pqsr_ice(:,:,jl) = z_qsr_m(:,:) 406 pqla_ice(:,:,jl) = z_qla_m(:,:) 407 END DO 408 ! 409 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 410 END SELECT 411 412 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 413 CASE( 1 , 2 ) 414 CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m ) 415 ! 416 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 417 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 418 DO jl = 1, jpl 419 pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 420 pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 421 pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 422 END DO 423 ! 424 CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m ) 425 END SELECT 426 ! 427 IF( nn_timing == 1 ) CALL timing_stop('ice_lim_flx') 428 ! 429 END SUBROUTINE ice_lim_flx 430 431 446 432 SUBROUTINE lim_ctl( kt ) 447 433 !!----------------------------------------------------------------------- … … 675 661 !! n : number of the option 676 662 !!------------------------------------------------------------------- 677 INTEGER , INTENT(in) :: kt ! ocean time step663 INTEGER , INTENT(in) :: kt ! ocean time step 678 664 INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices 679 665 CHARACTER(len=*), INTENT(in) :: cd1 ! … … 853 839 END DO 854 840 END DO 855 841 ! 856 842 END SUBROUTINE lim_prt_state 843 844 845 FUNCTION fice_cell_ave ( ptab ) 846 !!-------------------------------------------------------------------------- 847 !! * Compute average over categories, for grid cell (ice covered and free ocean) 848 !!-------------------------------------------------------------------------- 849 REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 850 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 851 INTEGER :: jl ! Dummy loop index 852 853 fice_cell_ave (:,:) = 0.0_wp 854 855 DO jl = 1, jpl 856 fice_cell_ave (:,:) = fice_cell_ave (:,:) & 857 & + a_i (:,:,jl) * ptab (:,:,jl) 858 END DO 859 860 END FUNCTION fice_cell_ave 861 862 863 FUNCTION fice_ice_ave ( ptab ) 864 !!-------------------------------------------------------------------------- 865 !! * Compute average over categories, for ice covered part of grid cell 866 !!-------------------------------------------------------------------------- 867 REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 868 REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 869 870 fice_ice_ave (:,:) = 0.0_wp 871 WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 872 873 END FUNCTION fice_ice_ave 874 857 875 858 876 #else
Note: See TracChangeset
for help on using the changeset viewer.
