Changeset 5385 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

Timestamp:

2015-06-09T15:50:42+02:00 (9 years ago)

Author:

cetlod

Message:

merge 2015/dev_r5204_CNRS_PISCES_dcy branch into the trunk, see ticket #1532

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (5 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

@@ -22 +22 @@
    !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean
    !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice
-   !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean
-   !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice
    !!   turb_core_2z    : Computes turbulent transfert coefficients
    !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m
@@ -52 +50 @@
    PUBLIC   sbc_blk_core         ! routine called in sbcmod module
    PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module
-   PUBLIC   blk_ice_meanqsr      ! routine called in sbc_ice_lim module
    PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module
 
@@ -195 +192 @@
       !                                            ! compute the surface ocean fluxes using CORE bulk formulea
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
-
-      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery
-      IF( ltrcdm2dc )   CALL blk_bio_meanqsr
 
 #if defined key_cice
@@ -302 +296 @@
       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
       ENDIF
+
       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
       ! ----------------------------------------------------------------------------- !
@@ -611 +606 @@
       !
    END SUBROUTINE blk_ice_core
-
-
-   SUBROUTINE blk_bio_meanqsr
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_bio_meanqsr
-      !!                     
-      !! ** Purpose :   provide daily qsr_mean for PISCES when
-      !!                analytic diurnal cycle is applied in physic
-      !!                
-      !! ** Method  :   add part where there is no ice
-      !! 
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr')
-      !
-      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1)
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr')
-      !
-   END SUBROUTINE blk_bio_meanqsr
- 
- 
-   SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim )
-      !!---------------------------------------------------------------------
-      !!
-      !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when
-      !!                analytic diurnal cycle is applied in physic
-      !!
-      !! ** Method  :   compute qsr
-      !! 
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2]
-      INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories
-      !
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
-      INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      REAL(wp) ::   zztmp         ! temporary variable
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr')
-      !
-      ijpl  = pdim                            ! number of ice categories
-      zztmp = 1. / ( 1. - albo )
-      !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
-         !                                  ! ========================== !
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)
-            END DO
-         END DO
-      END DO
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr')
-      !
-   END SUBROUTINE blk_ice_meanqsr  
-
 
    SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    &