Changeset 4306 for branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

Timestamp:

2013-11-21T15:59:57+01:00 (11 years ago)

Author:

cetlod

Message:

dev_MERGE_2013 : merge in the solar mean flux branch from MERCATOR, see ticket #1187

File:

• branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (3 diffs)

branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

@@ -49 +49 @@
    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
 
@@ -189 +190 @@
       !                                            ! 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
@@ -438 +442 @@
       !
    END SUBROUTINE blk_oce_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 blk_ice_core(  pst   , pui   , pvi   , palb ,   &