Changeset 11916 for NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icethd_zdf_bl99.F90

Timestamp:

2019-11-15T16:44:47+01:00 (4 years ago)

Author:

dancopsey

Message:

Merged in all the changes in NEMO4.0_fix_cpl_oce_only (up to revison 11832)

File:

• NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icethd_zdf_bl99.F90 (modified) (4 diffs)

NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icethd_zdf_bl99.F90

@@ -31 +31 @@
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
-   !! $Id$
+   !! $Id: icethd_zdf_bl99.F90 10926 2019-05-03 12:32:10Z clem $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -89 +89 @@
       REAL(wp) ::   zg1       =  2._wp        !
       REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat
-      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13)
+      REAL(wp) ::   zbeta     =  0.13_wp     ! for thermal conductivity (could be 0.13)
       REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow
       REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity
@@ -769 +769 @@
       !
       ! --- calculate conduction fluxes (positive downward)
-
+      !     bottom ice conduction flux
       DO ji = 1, npti
-         !                                ! surface ice conduction flux
-         qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0)      * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  &
-            &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0)      * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) )
-         !                                ! bottom ice conduction flux
-         qcn_ice_bot_1d(ji) =                          - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) )
+         qcn_ice_bot_1d(ji) =  - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) )
       END DO
-      
+      !     surface ice conduction flux
+      IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN
+         !
+         DO ji = 1, npti
+            qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  &
+               &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) )
+         END DO
+         !
+      ELSEIF( k_cnd == np_cnd_ON ) THEN
+         !
+         DO ji = 1, npti
+            qcn_ice_top_1d(ji) = qcn_ice_1d(ji)
+            !
+            t_su_1d(ji) = (  qcn_ice_top_1d(ji) &            ! calculate surface temperature
+               &           +           isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) &
+               &           + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) &
+               &          ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 )
+            t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp )  ! cap t_su
+         END DO
+         !
+      ENDIF
       !
       ! --- Diagnose the heat loss due to changing non-solar / conduction flux --- !
@@ -785 +801 @@
          DO ji = 1, npti
             hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji) 
-         END DO
-         !
-      ELSEIF( k_cnd == np_cnd_ON ) THEN
-         !
-         DO ji = 1, npti
-            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qcn_ice_top_1d(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji) 
          END DO
          !