Changeset 4902 for branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

Timestamp:

2014-11-27T17:13:38+01:00 (9 years ago)

Author:

cetlod

Message:

2014/dev_CNRS_2014 : Merge in the trunk changes between 4728 and 4879, see ticket #1415

File:

• branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 (modified) (7 diffs)

branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

@@ -22 +22 @@
    USE phycst         ! physical constants
    USE dom_oce        ! ocean space and time domain variables
-   USE oce     , ONLY : fraqsr_1lev
+   USE oce     , ONLY : fraqsr_1lev 
    USE ice            ! LIM: sea-ice variables
    USE par_ice        ! LIM: sea-ice parameters
@@ -153 +153 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * old_a_i(ji,jj,jl)
-                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * old_a_i(ji,jj,jl)
+                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
+                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
                END DO
             END DO
@@ -282 +282 @@
             !-------------------------
 
-            CALL tab_2d_1d( nbpb, at_i_b     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, a_i_b      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ht_i_b     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ht_s_b     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, t_su_b     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sm_i_b     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+
+            CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
             DO jk = 1, nlay_s
-               CALL tab_2d_1d( nbpb, t_s_b(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, q_s_b(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
             END DO
             DO jk = 1, nlay_i
-               CALL tab_2d_1d( nbpb, t_i_b(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, q_i_b(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, s_i_b(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
             END DO
 
@@ -310 +310 @@
             ENDIF
             CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
             CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
             CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
@@ -361 +361 @@
 
             ! --- Ice enthalpy remapping --- !
-            CALL lim_thd_ent( 1, nbpb, q_i_b(1:nbpb,:) ) 
+            CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 
                                             
             !---------------------------------!
@@ -377 +377 @@
             !--------------------------------
 
-               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_b    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_b    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_b    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_b     (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_b    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_b    (1:nbpb)   , jpi, jpj )
+               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
+               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
+               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
+               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
+               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
+               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
             DO jk = 1, nlay_s
-               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b     (1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
             END DO
             DO jk = 1, nlay_i
-               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
             END DO
                CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
@@ -532 +532 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            ztmelts       =  -tmut * s_i_b(ji,jk) + rtt
+            ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt
             ! Conversion q(S,T) -> T (second order equation)
             zaaa          =  cpic
-            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus
+            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus
             zccc          =  lfus * ( ztmelts - rtt )
             zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) )
-            t_i_b(ji,jk)  =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
+            t_i_1d(ji,jk)  =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
             
             ! mask temperature
-            zswitch      =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) ) 
-            t_i_b(ji,jk) =  zswitch * t_i_b(ji,jk) + ( 1._wp - zswitch ) * rtt
+            zswitch      =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
+            t_i_1d(ji,jk) =  zswitch * t_i_1d(ji,jk) + ( 1._wp - zswitch ) * rtt
          END DO 
       END DO