- Timestamp:
- 2013-10-22T14:07:21+02:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4042 r4099 32 32 USE sbcblk_core ! Surface boundary condition: CORE bulk 33 33 USE sbcblk_clio ! Surface boundary condition: CLIO bulk 34 USE sbccpl ! Surface boundary condition: coupled interface 34 35 USE albedo ! ocean & ice albedo 35 36 … … 42 43 USE limitd_me ! Mechanics on ice thickness distribution 43 44 USE limsbc ! sea surface boundary condition 44 USE limdia ! Ice diagnostics45 45 USE limdiahsb ! Ice budget diagnostics 46 46 USE limwri ! Ice outputs … … 77 77 !!---------------------------------------------------------------------- 78 78 CONTAINS 79 80 FUNCTION fice_cell_ave ( ptab) 81 !!-------------------------------------------------------------------------- 82 !! * Compute average over categories, for grid cell (ice covered and free ocean) 83 !!-------------------------------------------------------------------------- 84 REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 85 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 86 INTEGER :: jl ! Dummy loop index 87 88 fice_cell_ave (:,:) = 0.0_wp 89 90 DO jl = 1, jpl 91 fice_cell_ave (:,:) = fice_cell_ave (:,:) & 92 & + a_i (:,:,jl) * ptab (:,:,jl) 93 END DO 94 95 END FUNCTION fice_cell_ave 96 97 FUNCTION fice_ice_ave ( ptab) 98 !!-------------------------------------------------------------------------- 99 !! * Compute average over categories, for ice covered part of grid cell 100 !!-------------------------------------------------------------------------- 101 REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 102 REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 103 104 fice_ice_ave (:,:) = 0.0_wp 105 WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 106 107 END FUNCTION fice_ice_ave 108 109 !!====================================================================== 79 110 80 111 SUBROUTINE sbc_ice_lim( kt, kblk ) … … 104 135 REAL(wp) :: zcoef ! local scalar 105 136 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice_os, zalb_ice_cs ! albedo of the ice under overcast/clear sky 137 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean albedo of ice (for coupled) 138 139 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all ! Mean albedo over all categories 140 REAL(wp), POINTER, DIMENSION(:,:) :: ztem_ice_all ! Mean temperature over all categories 141 142 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_ice_all ! Mean solar heat flux over all categories 143 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_ice_all ! Mean non solar heat flux over all categories 144 REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_ice_all ! Mean latent heat flux over all categories 145 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all ! Mean d(qns)/dT over all categories 146 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all ! Mean d(qla)/dT over all categories 106 147 !!---------------------------------------------------------------------- 107 148 149 !- O.M. : why do we allocate all these arrays even when MOD( kt-1, nn_fsbc ) /= 0 ????? 150 108 151 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 109 152 110 153 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 154 155 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 156 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 157 END IF 158 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 159 CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 160 ENDIF 161 111 162 112 163 IF( kt == nit000 ) THEN … … 139 190 t_su(:,:,jl) = t_su(:,:,jl) + rt0 * ( 1. - tmask(:,:,1) ) 140 191 END DO 192 193 IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 194 195 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 196 ! 197 ! Compute mean albedo and temperature 198 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 199 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 200 ! 201 ENDIF 141 202 ! Bulk formulea - provides the following fields: 142 203 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] … … 161 222 & tprecip , sprecip , & 162 223 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 224 ! 225 CASE ( 5 ) 226 zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 227 228 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 229 230 CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=tn_ice ) 231 232 ! Latent heat flux is forced to 0 in coupled : 233 ! it is included in qns (non-solar heat flux) 234 qla_ice (:,:,:) = 0.0e0_wp 235 dqla_ice (:,:,:) = 0.0e0_wp 236 ! 163 237 END SELECT 238 239 ! Average over all categories 240 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 241 242 z_qns_ice_all (:,:) = fice_ice_ave ( qns_ice (:,:,:) ) 243 z_qsr_ice_all (:,:) = fice_ice_ave ( qsr_ice (:,:,:) ) 244 z_dqns_ice_all (:,:) = fice_ice_ave ( dqns_ice (:,:,:) ) 245 z_qla_ice_all (:,:) = fice_ice_ave ( qla_ice (:,:,:) ) 246 z_dqla_ice_all (:,:) = fice_ice_ave ( dqla_ice (:,:,:) ) 247 248 DO jl = 1, jpl 249 dqns_ice (:,:,jl) = z_dqns_ice_all (:,:) 250 dqla_ice (:,:,jl) = z_dqla_ice_all (:,:) 251 END DO 252 ! 253 IF ( ln_iceflx_ave ) THEN 254 DO jl = 1, jpl 255 qns_ice (:,:,jl) = z_qns_ice_all (:,:) 256 qsr_ice (:,:,jl) = z_qsr_ice_all (:,:) 257 qla_ice (:,:,jl) = z_qla_ice_all (:,:) 258 END DO 259 END IF 260 ! 261 IF ( ln_iceflx_linear ) THEN 262 DO jl = 1, jpl 263 qns_ice (:,:,jl) = z_qns_ice_all(:,:) + z_dqns_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 264 qla_ice (:,:,jl) = z_qla_ice_all(:,:) + z_dqla_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 265 qsr_ice (:,:,jl) = (1.0e0_wp-zalb_ice(:,:,jl)) / (1.0e0_wp-zalb_ice_all(:,:)) * z_qsr_ice_all(:,:) 266 END DO 267 END IF 268 END IF 164 269 165 270 ! !----------------------! … … 264 369 ! 265 370 ! ! Diagnostics and outputs 266 IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp ) & 267 & CALL lim_dia 268 IF (ln_limdiahsb) CALL lim_diahsb 371 IF (ln_limdiaout) CALL lim_diahsb 372 !clem # if ! defined key_iomput 269 373 CALL lim_wri( 1 ) ! Ice outputs 374 !clem # endif 270 375 IF( kt == nit000 ) CALL iom_close( numrir ) ! clem: close input ice restart file 271 376 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file … … 287 392 ! 288 393 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 394 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 395 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 396 END IF 397 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 398 CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 399 ENDIF 289 400 ! 290 401 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
Note: See TracChangeset
for help on using the changeset viewer.
