Changeset 4672 for branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.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.F90 (modified) (3 diffs)

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

@@ -91 +91 @@
       REAL(wp) :: zinda, zindb, zareamin 
       REAL(wp) :: zfric_u, zqld, zqfr
-      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx, zqfx
-      REAL(wp)                        :: zhfx_err, ztest
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       !!-------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limthd')
-
-      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx, zqfx )
-   
-      ! init debug
-      zdq(:) = 0._wp ; zq_ini(:) = 0._wp ; zhfx(:) = 0._wp ; zqfx(:) = 0._wp      
 
       ! conservation test
@@ -333 +326 @@
             ! 4.3) Thermodynamic processes
             !--------------------------------
-            ! --- diag error on heat diffusion - PART 1 --- !
-            DO ji = 1, nbpb
-               zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  &
-                  &           SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
-            END DO
 
             !---------------------------------!
             ! Ice/Snow Temperature profile    !
             !---------------------------------!
-            CALL lim_thd_dif( 1, nbpb, jl )
-
-            ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
-            CALL lim_thd_enmelt( 1, nbpb )
-
-            DO ji = 1, nbpb
-              ! --- diag error on heat diffusion - PART 2 --- !
-               zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  &
-                  &                              SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) )
-               zhfx_err       = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - ftr_ice_1d(ji) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 
-               hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji)
-               ! --- correction of qns_ice and surface conduction flux --- !
-               qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 
-               fc_su     (ji) = fc_su     (ji) - zhfx_err 
-               ! --- Heat flux at the ice surface in W.m-2 --- !
-               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-               hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) )
-            END DO
+            CALL lim_thd_dif( 1, nbpb )
 
             !---------------------------------!
             ! Ice/Snow thicnkess              !
             !---------------------------------!
-            ! --- diag error on heat remapping - PART 1 --- !
-            DO ji = 1, nbpb
-               zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + &
-                  &           SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
-            END DO
-
-            CALL lim_thd_dh( 1, nbpb, jl )    
+            CALL lim_thd_dh( 1, nbpb )    
 
             ! --- Ice enthalpy remapping --- !
-            CALL lim_thd_ent( 1, nbpb, jl, q_i_b(1:nbpb,:) ) 
-            !                                
-            ! --- diag error on heat remapping - PART 2 --- !
-            DO ji = 1, nbpb
-               zdq(ji)        = - ( zq_ini(ji) + dq_i(ji) + dq_s(ji) )   &
-                  &             + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  &
-                  &                 SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) )
-               hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + zdq(ji) * a_i_b(ji) * r1_rdtice
-            END DO
-
+            CALL lim_thd_ent( 1, nbpb, q_i_b(1:nbpb,:) ) 
+                                            
             !---------------------------------!
             ! --- Ice salinity --- !
@@ -528 +485 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
       !
-      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx, zqfx )
-
       IF( nn_timing == 1 )  CALL timing_stop('limthd')
-   END SUBROUTINE lim_thd
-
- 
-   SUBROUTINE lim_thd_enmelt( kideb, kiut )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_thd_enmelt *** 
-      !!                 
-      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature
-      !!
-      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
-      !!
-      INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts, zindb  ! local scalar 
-      !!-------------------------------------------------------------------
-      !
-      DO jk = 1, nlay_i             ! Sea ice energy of melting
-         DO ji = kideb, kiut
-            ztmelts      = - tmut  * s_i_b(ji,jk) + rtt 
-            zindb        = MAX( 0._wp , SIGN( 1._wp , -(t_i_b(ji,jk) - rtt) - epsi10 ) )
-            q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) )                                             &
-               &                   + lfus * ( 1.0 - zindb * ( ztmelts-rtt ) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) )   &
-               &                   - rcp  *                 ( ztmelts-rtt )  ) 
-         END DO
-      END DO
-      DO jk = 1, nlay_s             ! Snow energy of melting
-         DO ji = kideb, kiut
-            q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus )
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_thd_enmelt
+   END SUBROUTINE lim_thd 
 
    SUBROUTINE lim_thd_temp( kideb, kiut )