Changeset 4024 for branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC

Timestamp:

2013-09-11T15:58:45+02:00 (11 years ago)

Author:

cbricaud

Message:

correction for branch dev_r3856_MERCATOR3_QSRMEAN24H

Location:

branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC/SBC

Files:

• sbcblk_core.F90 (modified) (3 diffs)
• sbcice_lim_2.F90 (modified) (3 diffs)

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

@@ -48 +48 @@
    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
 
@@ -186 +187 @@
       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
 
+      !                                            ! 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 defined key_top
       IF( ltrcdm2dc )CALL blk_bio_meanqsr
 #endif
-
-      !                                            ! 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 defined key_cice
@@ -449 +450 @@
 
    END SUBROUTINE blk_bio_meanqsr
- 
+
+   SUBROUTINE blk_ice_meanqsr(palb,p_qsr_mean,pdim)
+      !!---------------------------------------------------------------------
+      !!
+      !!
+      !!---------------------------------------------------------------------
+      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
+      !!---------------------------------------------------------------------
+
+      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)
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE blk_ice_meanqsr  
    
    SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   &

branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

@@ -176 +176 @@
                &                      tprecip    , sprecip    ,                         &
                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+            IF( ltrcdm2dc_ice ) & 
+            CALL blk_ice_meanqsr(zalb_ice_cs,qsr_ice_mean,jpl  )
+
          CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
@@ -216 +219 @@
                            CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
                            CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
+#if defined key_top
+        IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2
+#endif
 
          IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   &
@@ -238 +244 @@
       IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
       !
-#if defined key_top
-      IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2
-#endif
-      !
       CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
       !