Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

Timestamp:

2016-01-08T10:35:19+01:00 (8 years ago)

Author:

jamesharle

Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:

• branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 (modified) (10 diffs)

branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

@@ -54 +54 @@
 # endif
 
+#if defined key_bdy 
+   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine)
+#endif
+
    IMPLICIT NONE
    PRIVATE
@@ -60 +64 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -93 +96 @@
       !!
       INTEGER  ::   ji, jj   ! dummy loop indices
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K)
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K)
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice 
       !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
 
       IF( kt == nit000 ) THEN
@@ -119 +122 @@
          &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
 # endif
+
+         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
+
          !  Bulk Formulea !
          !----------------!
@@ -126 +133 @@
             DO jj = 2, jpj
                DO ji = 2, jpi   ! NO vector opt. possible
-                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
-                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) &
+                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
+                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) &
+                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
                END DO
             END DO
@@ -134 +143 @@
             !
          CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
-            u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
-            v_oce(:,:) = ssv_m(:,:)
+            u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
+            v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
             !
          END SELECT
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         tfu(:,:) = tfreez( sss_m ) +  rt0 
+         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
+         tfu(:,:) = tfu(:,:) + rt0
 
          zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
 
-         ! ... ice albedo (clear sky and overcast sky)
+         ! Ice albedo
+
          CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
                                  reshape( hsnif, (/jpi,jpj,1/) ), &
-                          zalb_ice_cs, zalb_ice_os )
+                          zalb_cs, zalb_os )
+
+         SELECT CASE( ksbc )
+         CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations
+
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
+            ! (zalb_ice) is computed within the bulk routine
+
+         END SELECT
 
          ! ... Sea-ice surface boundary conditions output from bulk formulae :
@@ -163 +184 @@
          !
          SELECT CASE( ksbc )
-         CASE( 3 )           ! CLIO bulk formulation
-            CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         &
-               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
-               &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
-
-         CASE( 4 )           ! CORE bulk formulation
-            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            &
-               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
-               &                      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)
+         CASE( jp_clio )           ! CLIO bulk formulation
+!           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            &
+!              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
+!              &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
+!              &                      tprecip    , sprecip    ,                         &
+!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+            CALL blk_ice_clio_tau
+            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice )
+
+         CASE( jp_core )           ! CORE bulk formulation
+            CALL blk_ice_core_tau
+            CALL blk_ice_core_flx( zsist, zalb_ice )
+
+         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
          END SELECT
+         
+         IF( ln_mixcpl) THEN
+            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+         ENDIF
 
          CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point
@@ -205 +230 @@
                            CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
            IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping 
+#if defined key_bdy
+                           CALL bdy_ice_lim( kt ) ! bdy ice thermo
+#endif
          END IF
-#if defined key_coupled
          !                                             ! Ice surface fluxes in coupled mode 
-         IF( ksbc == 5 )   THEN
+         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations
             a_i(:,:,1)=fr_i
             CALL sbc_cpl_ice_flx( frld,                                              &
             !                                optional arguments, used only in 'mixed oce-ice' case
-            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist )
+            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist )
             sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
          ENDIF
-#endif
                            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(  .NOT. lk_mpp )THEN
@@ -234 +257 @@
          IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
 # endif
+         !
+         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
          !
       ENDIF                                    ! End sea-ice time step only
@@ -245 +271 @@
       IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
       !
-      CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
-      !
    END SUBROUTINE sbc_ice_lim_2