Changeset 9977 for NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_zdf_bl99.F90

Timestamp:

2018-07-20T10:24:45+02:00 (6 years ago)

Author:

davestorkey

Message:

UKMO/dev_r9888_proto_GO8_package branch: merge in changes from trunk to rev 9922.

File:

• NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_zdf_bl99.F90 (modified) (9 diffs)

NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_zdf_bl99.F90

@@ -178 +178 @@
       !-------------
       ! --- Transmission/absorption of solar radiation in the ice --- !
-      zradtr_s(1:npti,0) = qsr_ice_tr_1d(1:npti)
+      zradtr_s(1:npti,0) = qtr_ice_top_1d(1:npti)
       DO jk = 1, nlay_s
          DO ji = 1, npti
@@ -188 +188 @@
       END DO
       !
-      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qsr_ice_tr_1d(1:npti) * ( 1._wp - isnow(1:npti) )
+      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) )
       DO jk = 1, nlay_i 
          DO ji = 1, npti
@@ -198 +198 @@
       END DO
       !
-      ftr_ice_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice
+      qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice
       !
       iconv    = 0          ! number of iterations
@@ -330 +330 @@
 
             DO ji = 1, npti
-               zfnet(ji) = qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar
+               zfnet(ji) = qsr_ice_1d(ji) - qtr_ice_top_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar
             END DO
             !
@@ -728 +728 @@
       !-----------------------------
       !
-      ! --- update conduction fluxes
-      !
+      ! --- calculate conduction fluxes (positive downward)
+
       DO ji = 1, npti
          !                                ! surface ice conduction flux
-         fc_su(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) )
+         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
-         fc_bo_i(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
       
@@ -750 +750 @@
          !
          DO ji = 1, npti
-            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( fc_su(ji)      - qcn_ice_1d(ji) ) * a_i_1d(ji) 
+            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
          !
@@ -770 +770 @@
                
                IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
-                  zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji)    - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji)
+                  zhfx_err = ( qns_ice_1d(ji)     + qsr_ice_1d(ji)     - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
+                     &       + zdq * r1_rdtice ) * a_i_1d(ji)
                ELSE                          ! case T_su = 0degC
-                  zhfx_err = ( fc_su(ji)      + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji)
+                  zhfx_err = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
+                     &       + zdq * r1_rdtice ) * a_i_1d(ji)
                ENDIF
                
             ELSEIF( k_jules == np_jules_ACTIVE ) THEN
             
-               zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji)
+               zhfx_err    = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
+                  &          + zdq * r1_rdtice ) * a_i_1d(ji)
             
             ENDIF
@@ -787 +790 @@
             hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji)
             !
-         END DO
-         !
-         ! --- SIMIP diagnostics
-         !
-         DO ji = 1, npti
-            !--- Conduction fluxes (positive downwards)
-            diag_fc_bo_1d(ji) = diag_fc_bo_1d(ji) + fc_bo_i(ji) * a_i_1d(ji) / at_i_1d(ji)
-            diag_fc_su_1d(ji) = diag_fc_su_1d(ji) + fc_su  (ji) * a_i_1d(ji) / at_i_1d(ji)
-   
-            !--- Snow-ice interfacial temperature (diagnostic SIMIP)
-            zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji)
-            IF( h_s_1d(ji) >= zhs_min ) THEN
-               t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   &
-                  &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac )
-            ELSE
-               t_si_1d(ji) = t_su_1d(ji)
-            ENDIF
          END DO
          !
@@ -827 +813 @@
       IF( k_jules == np_jules_EMULE ) THEN
          ! Restore temperatures to their initial values
-         t_s_1d    (1:npti,:) = ztsold(1:npti,:)
-         t_i_1d    (1:npti,:) = ztiold(1:npti,:)
-         qcn_ice_1d(1:npti)   = fc_su (1:npti)
+         t_s_1d    (1:npti,:) = ztsold        (1:npti,:)
+         t_i_1d    (1:npti,:) = ztiold        (1:npti,:)
+         qcn_ice_1d(1:npti)   = qcn_ice_top_1d(1:npti)
       ENDIF
       !
+      ! --- SIMIP diagnostics
+      !
+      DO ji = 1, npti         
+         !--- Snow-ice interfacial temperature (diagnostic SIMIP)
+         zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji)
+         IF( h_s_1d(ji) >= zhs_min ) THEN
+            t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   &
+               &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac )
+         ELSE
+            t_si_1d(ji) = t_su_1d(ji)
+         ENDIF
+      END DO
+      !
    END SUBROUTINE ice_thd_zdf_BL99
-
 
 #else