Changeset 4672 for branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

Timestamp:

2014-06-17T17:06:59+02:00 (10 years ago)

Author:

clem

Message:

 

File:

• branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90 (modified) (4 diffs)

branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

@@ -36 +36 @@
    PRIVATE
 
-   PUBLIC   lim_thd_ent         ! called by lim_thd
+   PUBLIC   lim_thd_ent         ! called by limthd and limthd_lac
 
    REAL(wp) :: epsi20 = 1.e-20   ! constant values
@@ -48 +48 @@
 CONTAINS
  
-   SUBROUTINE lim_thd_ent( kideb, kiut, jl, qnew )
+   SUBROUTINE lim_thd_ent( kideb, kiut, qnew )
       !!-------------------------------------------------------------------
       !!               ***   ROUTINE lim_thd_ent  ***
@@ -74 +74 @@
       !!-------------------------------------------------------------------
       INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
-      INTEGER , INTENT(in) ::   jl            ! Thickness cateogry number
 
-      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (remapped)
+      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (J.m-3, remapped)
 
-      INTEGER  :: ji,ii,ij   !  dummy loop indices
+      INTEGER  :: ji         !  dummy loop indices
       INTEGER  :: jk0, jk1   !  old/new layer indices
-      REAL(wp) :: ztmelts    ! temperature of melting
-      REAL(wp) :: zswitch, zaaa, zbbb, zccc, zdiscrim ! converting enthalpy to temperature
+      REAL(wp) :: zswitch
       !
       REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
@@ -139 +137 @@
       DO jk1 = 1, nlay_i
          DO ji = kideb, kiut
-            zswitch      =  1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 
+            zswitch      = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 
             qnew(ji,jk1) = zswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 )
          ENDDO
       ENDDO
+
+      ! --- diag error on heat remapping --- !
+      ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac), 
+      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
+      DO ji = kideb, kiut
+         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_b(ji) * r1_rdtice *  &
+            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 
+      END DO
+      
       !
       CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )