- Timestamp:
- 2015-04-24T14:08:11+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5206 r5236 22 22 !! blk_oce_core : computes momentum, heat and freshwater fluxes over ocean 23 23 !! blk_ice_core : computes momentum, heat and freshwater fluxes over ice 24 !! blk_bio_meanqsr : compute daily mean short wave radiation over the ocean25 !! blk_ice_meanqsr : compute daily mean short wave radiation over the ice26 24 !! turb_core_2z : Computes turbulent transfert coefficients 27 25 !! cd_neutral_10m : Estimate of the neutral drag coefficient at 10m … … 52 50 PUBLIC sbc_blk_core ! routine called in sbcmod module 53 51 PUBLIC blk_ice_core ! routine called in sbc_ice_lim module 54 PUBLIC blk_ice_meanqsr ! routine called in sbc_ice_lim module55 52 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 56 53 … … 195 192 ! ! compute the surface ocean fluxes using CORE bulk formulea 196 193 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 197 198 IF( l_trcdm2dc ) CALL blk_bio_meanqsr ! diurnal cycle : daily mean short waves flux for biogeochemistery199 194 200 195 #if defined key_cice … … 301 296 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 302 297 ENDIF 298 303 299 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 304 300 ! ----------------------------------------------------------------------------- ! … … 610 606 ! 611 607 END SUBROUTINE blk_ice_core 612 613 614 SUBROUTINE blk_bio_meanqsr615 !!---------------------------------------------------------------------616 !! *** ROUTINE blk_bio_meanqsr617 !!618 !! ** Purpose : provide daily qsr_mean for PISCES when619 !! analytic diurnal cycle is applied in physic620 !!621 !! ** Method : add part where there is no ice622 !!623 !!---------------------------------------------------------------------624 IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr')625 !626 qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1)627 !628 IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr')629 !630 END SUBROUTINE blk_bio_meanqsr631 632 633 SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim )634 !!---------------------------------------------------------------------635 !!636 !! ** Purpose : provide the daily qsr_mean over sea_ice for PISCES when637 !! analytic diurnal cycle is applied in physic638 !!639 !! ** Method : compute qsr640 !!641 !!---------------------------------------------------------------------642 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%]643 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr_mean ! solar heat flux over ice (T-point) [W/m2]644 INTEGER , INTENT(in ) :: pdim ! number of ice categories645 !646 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays)647 INTEGER :: ji, jj, jl ! dummy loop indices648 REAL(wp) :: zztmp ! temporary variable649 !!---------------------------------------------------------------------650 IF( nn_timing == 1 ) CALL timing_start('blk_ice_meanqsr')651 !652 ijpl = pdim ! number of ice categories653 zztmp = 1. / ( 1. - albo )654 ! ! ========================== !655 DO jl = 1, ijpl ! Loop over ice categories !656 ! ! ========================== !657 DO jj = 1 , jpj658 DO ji = 1, jpi659 p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)660 END DO661 END DO662 END DO663 !664 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_meanqsr')665 !666 END SUBROUTINE blk_ice_meanqsr667 668 608 669 609 SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU, &
Note: See TracChangeset
for help on using the changeset viewer.